Prime factors buddies

PowerShell v3+, 450 bytes

param($n)function f{param($a)for($i=2;$a-gt1){if(!($a%$i)){$i;$a/=$i}else{$i++}}}
$y=([email protected]((f $n)-split'(.)'-ne''|sort))|?{$_-eq(f $_)}
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)
[email protected]();$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}


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


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.


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

CJam, 26 23 bytes


Try it online


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.

05AB1E, 17 bytes




Ò                  # 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!