21
\$\begingroup\$

Given an integer N > 1, output all other numbers which prime decompositions have the same digits as the prime decomposition of N.

For example, if N = 117, then the output must be [279, 939, 993, 3313, 3331], because

117 = 3 × 3 × 13

therefore, the available digits are 1, 3, 3 and 3 and we have

279  = 3 × 3 × 31
939  = 3 × 313
993  = 3 × 331
3313 = 3313
3331 = 3331

Those are the only other possible numbers, because other combination of these digits yield non-prime integers, which can't be the result of prime factorization.

If N is any of 117, 279, 939, 993, 3313 or 3331, then the output will contain the five other numbers: they are prime factors buddies.

You cannot use leading zeroes to get primes, e.g. for N = 107, its only buddy is 701 (017 is not considered).

Input and Outputs

  • The input and output buddies must be taken and returned in the decimal base.

  • N will always be strictly greater than 1.

  • The output can be formatted rather freely, as long as it only contains the buddies and separators/list syntactic elements.

  • The ordering of the output is unimportant.

  • You may take the input through STDIN, as a function argument or anything similar.

  • You may print the output to STDOUT, return it from a function, or anything similar.

Test cases

Your program should solve any of the test cases below in less than a minute.

N        Buddies
2        []
4        []
8        []
15       [53]
16       []
23       [6]
42       [74, 146, 161]
126      [222, 438, 483, 674, 746, 851, 1466, 1631, 1679]
204      [364,548,692,762,782,852,868,1268,1626,2474,2654,2921,2951,3266,3446,3791,4274,4742,5426,5462,6233,6434,6542,7037,8561,14426,14642,15491,15833,22547]

Scoring

This is , so the shortest answer in bytes wins.

\$\endgroup\$

10 Answers 10

4
\$\begingroup\$

Jelly, 14 bytes

ÆfVṢṚḌ
ÇÇ€=ÇTḟ

Execution time could be halved with DF instead of V, but it still completes the combined test cases in under thirty seconds.

Try it online! or verify all test cases.

How it works

ÆfVṢṚḌ   Helper link. Argument: k (integer)

Æf       Decompose k into an array of primes with product k.
  V      Eval. Eval casts a 1D array to string first, so this computes the integer
         that results of concatenating all primes in the factorization.
   Ṣ     Sort. Sort casts a number to the array of its decimal digits.
    Ṛ    Reverse. This yields the decimal digits in descending order.
     Ḍ   Undecimal; convert the digit array from base 10 to integer.


ÇÇ€=ÇTḟ  Main link. Argument: n (integer)

Ç        Call the helper link with argument n.
         This yields an upper bound (u) for all prime factorization buddies since
         the product of a list of integers cannot exceed the concatenated integers.
 ǀ      Apply the helper link to each k in [1, ..., u].
    Ç    Call the helper link (again) with argument n.
   =     Compare each result to the left with the result to the right.
     T   Truth; yield all 1-based indices of elements of [1, ..., u] (which match
         the corresponding integers) for which = returned 1.
      ḟ  Filter; remove n from the indices.
\$\endgroup\$
  • \$\begingroup\$ I think that Ç€=$ would be a bit faster than Ç€=Ç, given the time constraint. \$\endgroup\$ – Erik the Outgolfer Jul 18 '17 at 13:58
  • \$\begingroup\$ Thanks, but for input 117, your improvement means the helper link will be called 3331 times instead of 3332 times, so the speed-up isn't measurable. Anyway, the newer (faster) TIO doesn't even need 20 seconds for the combined test cases. \$\endgroup\$ – Dennis Jul 18 '17 at 16:13
16
\$\begingroup\$

PowerShell v3+, 450 bytes

param($n)function f{param($a)for($i=2;$a-gt1){if(!($a%$i)){$i;$a/=$i}else{$i++}}}
$y=($x=@((f $n)-split'(.)'-ne''|sort))|?{$_-eq(f $_)}
$a,$b=$x
$a=,$a
while($b){$z,$b=$b;$a=$a+($a+$y|%{$c="$_";0..$c.Length|%{-join($c[0..$_]+$z+$c[++$_..$c.Length])};"$z$c";"$c$z"})|select -u}
$x=-join($x|sort -des)
$l=@();$a|?{$_-eq(f $_)}|%{$j=$_;for($i=0;$i-le$x;$i+=$j){if(0-notin($l|%{$i%$_})){if(-join((f $i)-split'(.)'|sort -des)-eq$x){$i}}}$l+=$j}|?{$_-ne$n}

Finally!

PowerShell doesn't have any built-ins for primality checking, factorization, or permutations, so this is completely rolled by hand. I worked through a bunch of optimization tricks to try and reduce the time complexity down to something that will fit in the challenge restrictions, and I'm happy to say that I finally succeeded --

PS C:\Tools\Scripts\golfing> Measure-Command {.\prime-factors-buddies.ps1 204}

Days              : 0
Hours             : 0
Minutes           : 0
Seconds           : 27
Milliseconds      : 114
Ticks             : 271149810
TotalDays         : 0.000313830798611111
TotalHours        : 0.00753193916666667
TotalMinutes      : 0.45191635
TotalSeconds      : 27.114981
TotalMilliseconds : 27114.981

Explanation

There's a lot going on here, so I'll try to break it down.

The first line takes input $n and defines a function, f. This function uses accumulative trial division to come up with a list of the prime factors. It's pretty speedy for small inputs, but obviously bogs down if the input is large. Thankfully all the test cases are small, so this is sufficient.

The next line gets the factors of $n, -splits them on every digit ignoring any empty results (this is needed due to how PowerShell does regex matching and how it moves the pointer through the input and is kinda annoying for golfing purposes), then sorts the results in ascending order. We store that array of digits into $x, and use that as the input to a |?{...} filter to pull out only those that are themselves prime. Those prime digits are stored into $y for use later.

We then split $x into two components. The first (i.e., smallest) digit is stored into $a, while the rest are passed into $b. If $x only has one digit, then $b will be empty/null. We then need to re-cast $a as an array, so we use the comma operator quick-like to do so.

Next, we need to construct all possible permutations of the digits. This is necessary so our division tests later skip a bunch of numbers and make things faster overall.

So long as there's element left in $b, we peel off the first digit into $z and leave the remaining in $b. Then, we need to accumulate into $a the result of some string slicing and dicing. We take $a+$y as array concatenation, and for each element we construct a new string $c, then loop through $c's .length and insert $z into every position, including prepending $z$c and appending $c$z, then selecting only the -unique elements. That's again array-concatenated with $a and re-stored back into $a. Yes, this does wind up having goofy things happen, like you can get 3333 for input 117, which isn't actually a permutation, but this is much shorter than attempting to explicitly filter them out, ensures that we get every permutation, and is only very marginally slower.

So, now $a has an array of all possible (and then some) permutations of the factor's digits. We need to re-set $x to be our upper-bound of possible results by |sorting the digits in -descending order and -joining them back together. Obviously, no output value can be larger than this number.

We set our helper array $l to be an array of values that we've previously seen. Next, we're pulling out every value from $a (i.e., those permutations) that are prime, and enter a loop that is the biggest time sink of the whole program...

Every iteration, we're looping from 0 to our upper bound $x, incrementing by the current element $j. So long as the $i value we're considering is not a multiple of a previous value (that's the 0-notin($l|%{$i%$_}) section), it's a potential candidate for output. If we take the factors of $i, sort them, and they -equal $x, then add the value to the pipeline. At the end of the loop, we add our current element $j into our $l array for use next time, as we've already considered all those values.

Finally, we tack on |?{$_-ne$n} to pull out those that are not the input element. They're all left on the pipeline and output is implicit.

Examples

PS C:\Tools\Scripts\golfing> 2,4,8,15,16,23,42,117,126,204|%{"$_ --> "+(.\prime-factors-buddies $_)}
2 --> 
4 --> 
8 --> 
15 --> 53
16 --> 
23 --> 6
42 --> 74 146 161
117 --> 279 939 993 3313 3331
126 --> 222 438 674 746 1466 483 851 1679 1631
204 --> 782 2921 3266 6233 3791 15833 2951 7037 364 868 8561 15491 22547 852 762 1626 692 548 1268 2654 3446 2474 5462 4742 5426 4274 14426 6542 6434 14642
\$\endgroup\$
  • \$\begingroup\$ That's the most dollars I've ever seen! \$\endgroup\$ – Fatalize Sep 23 '16 at 15:51
  • 1
    \$\begingroup\$ @Fatalize That's only 64 out of 450, which is surprisingly a little on the low side percentage-wise (14.22%) for PowerShell answers. \$\endgroup\$ – AdmBorkBork Sep 23 '16 at 15:53
8
\$\begingroup\$

CJam, 26 23 bytes

{_mfs$:XW%i){mfs$X=},^}

Try it online

Explanation

Concatenating two numbers always gives a bigger result than multiplying them. So the largest number we possibly need to consider is the largest number we can form from the digits of the input's prime factorisation, which is just all digits sorted in descending order. For the given numbers this upper bound is easily small enough that we can exhaustively check every number in range for whether it's a prime factor buddy:

_mf    e# Duplicate input N and get a list of its prime factors.
s$     e# Convert the list to a (flattened) string and sort it.
:X     e# Store this in X for later.
W%     e# Reverse it. This is now a string repesentation of the largest 
       e# possible output M.
i)     e# Convert to integer and increment.
{      e# Get a list of all integers i in [0 1 ... M] for which the following
       e# block gives a truthy result.
  mf   e#   Get list of prime factors of i.
  s$   e#   Get a sorted list of the digits appearing in the factorisation.
  X=   e#   Check for equality with X.
},
^      e# Symmetric set difference: removes N from the output list.
\$\endgroup\$
6
\$\begingroup\$

05AB1E, 17 bytes

Code:

ÒJ{©RƒNÒJ{®QN¹Ê*–

Explanation:

Ò                  # Get the factorization with duplicates, e.g. [3, 3, 13]
 J                 # Join the array, e.g. 3313
  {©               # Sort and store in ©, e.g. 1333
    R              # Reverse the number, e.g. 3331. This is the upperbound for the range
     ƒ             # For N in range(0, a + 1), do...
      NÒ           # Push the factorization with duplicates for N
        J          # Join the array
         {         # Sort the string
          ®Q       # Check if equal to the string saved in ©
            N¹Ê    # Check if not equal to the input
               *   # Multiply, acts as a logical AND
                –  # If 1, print N

Uses the CP-1252 encoding. Try it online!

\$\endgroup\$
4
\$\begingroup\$

Pyth, 17

LSjkPb-fqyTyQSs_y

Test suite.

Uses the same observation as from Martin's post.

Expansion:

LSjkPb        ##  Define a function y(b) to get the sorted string of digits
              ##  of the prime factors of b
    Pb        ##  prime factors
  jk          ##  join to a string with no separator
 S            ##  Sort

-fqyTyQSs_yQQ ##  Auto-fill variables
         _yQ  ##  get reversed value of y(input)
       Ss     ##  convert that string to a list [1 ... y(input)]
 fqyTyQ       ##  keep numbers T from the list that satisfy y(T)==y(input)
-           Q ##  remove the input from the result
\$\endgroup\$
3
\$\begingroup\$

JavaScript (ES6), 163 158 bytes

Edit: It has been clarified that a prime such as 23 should return [6] rather an empty result set. Saved 5 bytes by removing a now useless rule that was -- on purpose -- preventing that from happening.

The last test case is commented so that this snippet runs fast enough, although it should complete in less than one minute just as well.

let f =

n=>[...Array(+(l=(p=n=>{for(i=2,m=n,s='';i<=m;n%i?i++:(s+=i,n/=i));return s.split``.sort().reverse().join``})(n))+1)].map((_,i)=>i).filter(i=>i&&i-n&&p(i)==l)

console.log(JSON.stringify(f(2)));
console.log(JSON.stringify(f(4)));
console.log(JSON.stringify(f(8)));
console.log(JSON.stringify(f(15)));
console.log(JSON.stringify(f(16)));
console.log(JSON.stringify(f(23)));
console.log(JSON.stringify(f(42)));
console.log(JSON.stringify(f(126)));
//console.log(JSON.stringify(f(204)));

\$\endgroup\$
1
\$\begingroup\$

PHP 486 bytes

could probably be shorter with an algorithm that´s not so by the book.
(but I like the current byte count)

function p($n){for($i=1;$i++<$n;)if($n%$i<1&&($n-$i?p($i)==$i:!$r))for($x=$n;$x%$i<1;$x/=$i)$r.=$i;return $r;}function e($s){if(!$n=strlen($s))yield$s;else foreach(e(substr($s,1))as$p)for($i=$n;$i--;)yield substr($p,0,$i).$s[0].substr($p,$i);}foreach(e(p($n=$argv[1]))as$p)for($m=1<<strlen($p)-1;$m--;){$q="";foreach(str_split($p)as$i=>$c)$q.=$c.($m>>$i&1?"*":"");foreach(split("\*",$q)as$x)if(0===strpos($x,48)|p($x)!=$x)continue 2;eval("\$r[$q]=$q;");}unset($r[$n]);echo join(",",$r);

breakdown

// find and concatenate prime factors
function p($n)
{
    for($i=1;$i++<$n;)  // loop $i from 2 to $n
        if($n%$i<1      // if $n/$i has no remainder
            &&($n-$i    // and ...
                ?p($i)==$i  // $n!=$i: $i is a prime
                :!$r        // $n==$i: result so far is empty ($n is prime)
            )
        )
            for($x=$n;      // set $x to $n
                $x%$i<1;    // while $x/$i has no remainder
                $x/=$i)     // 2. divide $x by $i
                $r.=$i;     // 1. append $i to result
    return $r;
}

// create all permutations of digits
function e($s)
{
    if(!$n=strlen($s))yield$s;else  // if $s is empty, yield it, else:
    foreach(e(substr($s,1))as$p)    // for all permutations of the number w/o first digit
        for($i=$n;$i--;)            // run $i through all positions around the other digits
            // insert removed digit at that position and yield
            yield substr($p,0,$i).$s[0].substr($p,$i);
}

// for each permutation
foreach(e(p($n=$argv[1]))as$p)
    // create all products from these digits: binary loop through between the digits
    for($m=1<<strlen($p)-1;$m--;)
    {
        // and insert "*" for set bits
        $q="";
        foreach(str_split($p)as$i=>$c)$q.=$c.($m>>$i&1?"*":"");
        // test all numbers in the expression
        foreach(split("\*",$q)as$x)
            if(
                0===strpos($x,48)   // if number has a leading zero
                |p($x)!=$x          // or is not prime
            )continue 2; // try next $m
        // evaluate expression and add to results (use key to avoid array_unique)
        eval("\$r[$q]=$q;");
    }

// remove input from results
unset($r[$n]);

// output
#sort($r);
echo join(",",$r);
\$\endgroup\$
1
\$\begingroup\$

Actually, 27 bytes

This uses the same algorithm that Martin, Adnan, FryAmTheEggman, and Dennis have been using. Golfing suggestions welcome. Try it online!

`w"i$n"£MΣSR≈`╗╜ƒ;╝R`╜ƒ╛=`░

Ungolfing

          Implicit input n.
`...`╗    Define a function and store it in register 0. Call the function f(x).
  w         Get the prime factorization of x.
  "..."£M   Begin another function and map over the [prime, exponent] lists of w.
    i         Flatten the list. Stack: prime, exponent.
    $n        Push str(prime) to the stack, exponent times.
               The purpose of this function is to get w's prime factors to multiplicity.
  Σ         sum() the result of the map.
             On a list of strings, this has the same effect as "".join()
  SR≈       Sort that string, reverse it and convert to int.
╜ƒ        Now push the function stored in register 0 and call it immediately.
           This gives the upper bound for any possible prime factor buddy.
;╝        Duplicate this upper bound and save a copy to register 1.
R         Push the range [0..u]
`...`░    Filter the range for values where the following function returns a truthy.
           Variable k.
  ╜ƒ        Push the function in register 0 and call it on k.
  ╛=        Check if f(k) == f(n).
          Implicit return every value that is a prime factor buddy with n, including n.
\$\endgroup\$
1
\$\begingroup\$

Powershell, 147 bytes (CodeGolf version)

param($n)filter d{-join($(for($i=2;$_-ge$i*$i){if($_%$i){$i++}else{"$i"
$_/=$i}}if($_-1){"$_"})|% t*y|sort -d)}2..($s=$n|d)|?{$_-$n-and$s-eq($_|d)}

Note: The script solve last test cases less than 3 minutes on my local notebook. See "performance" solution below.

Less golfed test script:

$g = {

param($n)
filter d{                       # in the filter, Powershell automatically declares the parameter as $_
    -join($(                    # this function returns a string with all digits of all prime divisors in descending order
        for($i=2;$_-ge$i*$i){   # find all prime divisors
            if($_%$i){
                $i++
            }else{
                "$i"            # push a divisor to a pipe as a string
                $_/=$i
            }
        }
        if($_-1){
            "$_"                # push a last divisor to pipe if it is not 1
        }
    )|% t*y|sort -d)            # t*y is a shortcut to toCharArray method. It's very slow.
}
2..($s=$n|d)|?{                 # for each number from 2 to number with all digits of all prime divisors in descending order
    $_-$n-and$s-eq($_|d)        # leave only those who have the 'all digits of all prime divisors in descending order' are the same
}

}

@(
    ,(2   ,'')
    ,(4   ,'')
    ,(6   ,23)
    ,(8   ,'')
    ,(15  ,53)
    ,(16  ,'')
    ,(23  ,6)
    ,(42  ,74, 146, 161)
    ,(107 ,701)
    ,(117 ,279, 939, 993, 3313, 3331)
    ,(126 ,222, 438, 483, 674, 746, 851, 1466, 1631, 1679)
    ,(204 ,364,548,692,762,782,852,868,1268,1626,2474,2654,2921,2951,3266,3446,3791,4274,4742,5426,5462,6233,6434,6542,7037,8561,14426,14642,15491,15833,22547)
) | % {
    $n,$expected = $_

    $sw = Measure-Command {
        $result = &$g $n
    }

    $equals=$false-notin(($result|%{$_-in$expected})+($expected|?{$_-is[int]}|%{$_-in$result}))
    "$sw : $equals : $n ---> $result"
}

Output:

00:00:00.0346911 : True : 2 --->
00:00:00.0662627 : True : 4 --->
00:00:00.1164648 : True : 6 ---> 23
00:00:00.6376735 : True : 8 --->
00:00:00.1591527 : True : 15 ---> 53
00:00:03.8886378 : True : 16 --->
00:00:00.0441986 : True : 23 ---> 6
00:00:01.1316642 : True : 42 ---> 74 146 161
00:00:01.0393848 : True : 107 ---> 701
00:00:05.2977238 : True : 117 ---> 279 939 993 3313 3331
00:00:12.1244363 : True : 126 ---> 222 438 483 674 746 851 1466 1631 1679
00:02:50.1292786 : True : 204 ---> 364 548 692 762 782 852 868 1268 1626 2474 2654 2921 2951 3266 3446 3791 4274 4742 5426 5462 6233 6434 6542 7037 8561 14426 14642 15491 15833 22547

Powershell, 215 bytes ("Performance" version)

param($n)$p=@{}
filter d{$k=$_*($_-le3e3)
($p.$k=-join($(for($i=2;!$p.$_-and$_-ge$i*$i){if($_%$i){$i++}else{"$i"
$_/=$i}}if($_-1){($p.$_,"$_")[!$p.$_]})-split'(.)'-ne''|sort -d))}2..($s=$n|d)|?{$_-$n-and$s-eq($_|d)}

Note: I believe the performance requirements are in conflict with the GodeGolf principle. But since there was a rule Your program should solve any of the test cases below in less than a minute, I made two changes to satisfy the rule:

  • -split'(.)'-ne'' instead the short code |% t*y;
  • a hashtable for cashing strings.

Each change reduces evaluation time by half. Please do not think that I have used all the features to improve performance. Just those were enough to satisfy the rule.

Less golfed test script:

$g = {

param($n)
$p=@{}                          # hashtable for 'all digits of all prime divisors in descending order'
filter d{                       # this function returns a string with all digits of all prime divisors in descending order
    $k=$_*($_-le3e3)            # hashtable key: a large hashtable is not effective, therefore a key for numbers great then 3000 is 0
                                # and string '-le3e3' funny
    ($p.$k=-join($(             # store the value to hashtable
        for($i=2;!$p.$_-and$_-ge$i*$i){
            if($_%$i){$i++}else{"$i";$_/=$i}
        }
        if($_-1){
            ($p.$_,"$_")[!$p.$_] # get a string with 'all digits of all prime divisors in descending order' from hashtable if it found
        }
    )-split'(.)'-ne''|sort -d)) # split each digit. The "-split'(.)-ne''" code is faster then '|% t*y' but longer.
}
2..($s=$n|d)|?{                 # for each number from 2 to number with all digits of all prime divisors in descending order
    $_-$n-and$s-eq($_|d)        # leave only those who have the 'all digits of all prime divisors in descending order' are the same
}

}

@(
    ,(2   ,'')
    ,(4   ,'')
    ,(6   ,23)
    ,(8   ,'')
    ,(15  ,53)
    ,(16  ,'')
    ,(23  ,6)
    ,(42  ,74, 146, 161)
    ,(107 ,701)
    ,(117 ,279, 939, 993, 3313, 3331)
    ,(126 ,222, 438, 483, 674, 746, 851, 1466, 1631, 1679)
    ,(204 ,364,548,692,762,782,852,868,1268,1626,2474,2654,2921,2951,3266,3446,3791,4274,4742,5426,5462,6233,6434,6542,7037,8561,14426,14642,15491,15833,22547)
) | % {
    $n,$expected = $_

    $sw = Measure-Command {
        $result = &$g $n
    }

    $equals=$false-notin(($result|%{$_-in$expected})+($expected|?{$_-is[int]}|%{$_-in$result}))
    "$sw : $equals : $n ---> $result"
}

Output:

00:00:00.0183237 : True : 2 --->
00:00:00.0058198 : True : 4 --->
00:00:00.0181185 : True : 6 ---> 23
00:00:00.4389282 : True : 8 --->
00:00:00.0132624 : True : 15 ---> 53
00:00:04.4952714 : True : 16 --->
00:00:00.0128230 : True : 23 ---> 6
00:00:01.4112716 : True : 42 ---> 74 146 161
00:00:01.3676701 : True : 107 ---> 701
00:00:07.1192912 : True : 117 ---> 279 939 993 3313 3331
00:00:07.6578543 : True : 126 ---> 222 438 483 674 746 851 1466 1631 1679
00:00:50.5501853 : True : 204 ---> 364 548 692 762 782 852 868 1268 1626 2474 2654 2921 2951 3266 3446 3791 4274 4742 5426 5462 6233 6434 6542 7037 8561 14426 14642 15491 15833 22547
\$\endgroup\$
1
\$\begingroup\$

Japt, 18 bytes

k –
Ôn õ f@¥Xk ¬ñ

Try it

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.