Sociable sequences

Question

Sociable numbers are a generalisation of both perfect and amicable numbers. They are numbers whose proper divisor sums form cycles beginning and ending at the same number. A number is \$n\$-sociable if the cycle it forms has \$n\$ unique elements. For example, perfect numbers are \1ドル\$-sociable (\6ドル\to6\to\cdots\$) and amicable numbers are \2ドル\$-sociable (\220ドル\to284\to220\to\cdots\$).

Note that the entire cycle must begin and end with the same number. \25ドル\$ for example is not a \1ドル\$-sociable number as it's cycle is \25ドル \to 6 \to 6 \to \cdots\$, which, despite containing a period \1ドル\$ cycle, does not begin and end with that cycle.

The proper divisor sum of an integer \$x\$ is the sum of the positive integers that divide \$x\$, not including \$x\$ itself. For example, the proper divisor sum of \24ドル\$ is \1ドル + 2 +たす 3 +たす 4 +たす 6 +たす 8 +たす 12 =わ 36\$

There are currently \51ドル\$ known \1ドル\$-sociable numbers, \1225736919ドル\$ known \2ドル\$-sociable pairs, no known \3ドル\$-sociable sequences, \5398ドル\$ known \4ドル\$-sociable sequences and so on.

You may choose whether to:

• Take a positive integer \$n\$, and a positive integer \$m\$ and output the \$m\$th \$n\$-sociable sequence
• Take a positive integer \$n\$, and a positive integer \$m\$ and output the first \$m\$ \$n\$-sociable sequences
• Take a positive integer \$n\$ and output all \$n\$-sociable sequences

If you choose either of the last 2, each sequence must have internal separators (e.g. 220, 284 for \$n = 2\$) and distinct, external separators between sequences (e.g. [220, 284], [1184, 1210] for \$n = 2\$). For either of the first 2, the sequences should be ordered lexicographically.

You can choose whether to include "duplicate" sequences, i.e. the sequences that are the same as others, just beginning with a different number, such as including both 220, 284 and 284, 220. Please state in your answer if you do this.

The Catalan-Dickson conjecture states that every sequence formed by repeatedly taking the proper divisor sum eventually converges. Your answer may assume this conjecture to be true (meaning that you are allowed to iterate through each integer, testing if it is \$n\$-sociable by calculating if it belongs to an \$n\$-cycle, even though such approaches would fail for e.g. \276ドル\$ if the conjecture is false).

You may also assume that for a given \$n\$, there exists an infinite number of \$n\$-sociable sequences.

This is code-golf so the shortest code in bytes wins

Test cases

n -> n-sociable sequences
1 -> 6, 28, 496, 8128, ...
2 -> [220, 284], [284, 220], [1184, 1210], [1210, 1184], [2620, 2924], [2924, 2620], [5020, 5564], [5564, 5020], [6232, 6368], [6368, 6232], ...
4 -> [1264460, 1547860, 1727636, 1305184], ...
5 -> [12496, 14288, 15472, 14536, 14264], [14264, 12496, 14288, 15472, 14536], ...
6 -> [21548919483, 23625285957, 24825443643, 26762383557, 25958284443, 23816997477], ...
8 -> [1095447416, 1259477224, 1156962296, 1330251784, 1221976136, 1127671864, 1245926216, 1213138984], ...
9 -> [805984760, 1268997640, 1803863720, 2308845400, 3059220620, 3367978564, 2525983930, 2301481286, 1611969514], ...

• Jonah: Do you know if the Catalan-Dickson conjecture is an active area of research? Is it one of those problems like Collatz where we're nowhere near being able to solve it?
• caird coinheringaahing: @Jonah Doing a quick search for papers that mention it doesn't yield a massive amount, so it doesn't look like it's a particularly prominent area of research if it is active. WA's page on it is woefully short as well

Answer 1

Brachylog, 18 bytes

Generates the sequences with duplicates.

;X{≠tNfk+}a(At~hAk

Try it online!

How it works

;X{≠tNfk+}a(At~hAk implicit input n
;X [n, something]
 { }a( starting with [something], generate a list
 by applying {...} n times:
 ≠ all elements are different
 t the last element
 N is a natural number
 f and its factors
 k without itself
 + summed
 -> [220, 284, 220]
 A is A
 t A's tail
 ~h is the head
 A of A
 k output A without the last element

Answer 2

Ruby, (削除) 86 (削除ここまで) (削除) 84 (削除ここまで) 78 bytes

->n{1.step{|x,*a|x==(n.times{a|=[x=(1...x).sum{|i|x%i>0?0:i}]};a[n-1])&&p(a)}}

Try it online!

Prints the sequence for a given \$n\$ infinitely.

6 bytes saved by G B.

• G B: 78 bytes: tio.run/…
• Kirill L.: @GB, nice, thanks!
• pxeger: -1 using Ruby 2.7 unnamed arguments - won't work on TIO because it doesn't have 2.7, but here's a link anyway: Try it online!
• Kirill L.: @pxeger, yes, I know, but it's so frustrating to keep track of several versions, where one is shorter, but the other works on TIO. Too bad, TIO isn't actively updated anymore...

Answer 3

Wolfram Language (Mathematica), 69 bytes

Takes a positive integer n and outputs all n-sociable sequences

Do[NestList[Tr@Divisors@#-#&,d,#]/.{a__,d}/;0!=a:>Print@{a},{d,∞}]&

Try it online!

-20 bytes thanks to @att

• att: 68 bytes
• ZaMoC: @att nice! I prefer {a} for a clean result....

Answer 4

JavaScript (V8), (削除) 106 97 (削除ここまで) 96 bytes

Saved 1 byte thanks to @tsh

A function that takes \$n\$ and prints the sequence forever, including duplicates.

n=>{for(k=0;a=[];)(g=j=>{for(s=d=0;++d<j;s+=j%d?0:d);a.push(s)<n?s-k&&g(s):s-k||print(a)})(++k)}

Try it online!

Commented

n => { // n = input
 for( // main infinite loop:
 k = 0; // start with k = 0
 a = []; // a[] = sequence of proper divisor sums
 ) ( //
 g = j => { // g is a recursive function that takes an integer j,
 // fills the sequence a[] and prints it if valid
 for( // loop:
 s = // s is the proper divisor sum
 d = 0; // d is the current divisor
 ++d < j; // increment d; stop when it's equal to j
 s += j % d ? 0 : d // add d to s if d is a divisor of j
 ); // end of loop
 a.push(s) // push s into a[]
 < n ? // if there are less than n elements:
 s - k && g(s) // if s != k, do a recursive call with j = s
 : // else:
 s - k || print(a) // if s = k, print a[]
 } // end of g
 )(++k) // initial call to g with j = k incremented
} // end of loop / end of function

• tsh: maybe move initial of a to for loop condition?
• Arnauld: @tsh Ah, yes. Nice one!

Answer 5

Haskell, (削除) 126 (削除ここまで) 115 bytes

import Data.List
f m=[init r|r@(h:t)<-[scanl(\a x->sum[d|d<-[1..a-1],a`mod`d<1])y[1..m]|y<-[1..]],h==r!!m,t==nub t]

Try it online!

• saved 10 thanks to @benrg

• AZTECCO: @user thanks! I think ? check for k not in list but we have to check if all elements are different
• benrg: import Data.List and using t==nub t in place of u t saves 10 bytes, I think.

Answer 6

J, ^{75 73} 67 bytes

(>:@][[echo@}:^:((~.-:}:)*{.={:)@]1&((,i.@{:(1#.[#~0=|){:)@]))^:_&1

Try it online!

Prints infinitely.

Note: TIO has +3 in the byte count because I changed infinite _ iteration to 9999 times.

Answer 7

Husk, 18 bytes

m1fo=0S1ドルN
Ut¡ȯΣhḊ

Outputs all n-sociable sequences (including duplicates beginning with different numbers).

Don't try it online!: Assumes Catalan-Dixon conjecture: calculates cycle for every integer befpre choosing which ones to output. So, the example on TIO stalls.
Try this for a (6-byte longer) version that restricts calculations up to a cycle-length of 10 (↑10), and only outputs sequences arising from integers up to 500 (ḣ500 instead of N).

Explanation:

Ut¡ȯΣhḊ # helper function 1:
 # calculate cycle for input integer x
U # longest unique prefix of list
 t # (without first element)
 ¡ȯ # from repeatedly applying 3 functions:
 Σ # sum of 
 Ḋ # divisors
 h # without the last one
 # to the input argument
 
m1fo=0S1ドルN # main program:
m1 # apply helper function 1 to each of
 N # all integers x
 fo # filtered to include only those for which 
 S1ドル # the position of x in 
 # the results of applying helper function 1 to x
 =0 # is equal to the input argument

Answer 8

Charcoal, 53 bytes

Nθ≔0ζFN«≔⟦⟧υW−θ⊕⌕υζ«≦⊕ζ≔ζη≔⟦⟧υFθ«≔↨Φη∧μ¬%ημ1η⊞υη»»»Iυ

Try it online! Link is to verbose version of code. Takes n and m as inputs and outputs the mth sequence, in order of last element of the cycle, including duplicate sequences. Very slow so in practice you need n<3. Explanation:

Nθ

Input n.

≔0ζ

Start at zero.

FN«

Repeat m times.

≔⟦⟧υ

Clear any previous calculation.

W−θ⊕⌕υζ«

Repeat until a perfect n-cycle is found.

≦⊕ζ

Increment the test number.

≔ζη

Make a copy of the number.

≔⟦⟧υ

Start building a list of divisor sums.

Fθ«

Repeat n times.

≔↨Φη∧μ¬%ημ1η

Calculate the next divisor sum.

⊞υη

Save it to the list.

»»»Iυ

Output the collected divisor sums, including the copy of the original counter as the last element of this list.

• caird coinheringaahing: The output should be the m'th sequence, not the m'th number (so 2 3 would output 1184, 1210 etc.)
• Neil: @ChartZBelatedly Can I output the mth sequence in order of the last term of the sequence rather than the first?
• caird coinheringaahing: yeah, that's fine
• Neil: @ChartZBelatedly Great, I've already got a variable with that in, so the byte count doesn't change.

Answer 9

Scala, (削除) 114 (削除ここまで) (削除) 109 (削除ここまで) 119 bytes

+10 bytes to fix a mistake, indirectly pointed out by AZTECCO.

n=>for(k<-Stream from 2;s=Seq.iterate(k,n+1)(x=>1.to(x-1).filter(x%_<1).sum).tail.distinct if s.indexOf(k)>n-2)yield s

Try it in Scastie!

An infinite Stream that can also be treated as a function that returns the mth sequence. Uses tail instead of init like the previous one, so the sequences are [284, 220], [220, 284], [1210, 1184] (first element removed).

Using >n-2, as in Arnauld's answer, instead of ==n-1, saves a byte.

n =>
 for(
 k <- Stream from 2 //For every integer k ≥ 2
 s = Seq.iterate(k, n + 1)( //Build first n+1 terms of the sequence by repeatedly applying:
 x => //Function for proper divisor sum
 1.to(x - 1) //Range of possible proper divisors
 .filter(x % _ < 1) //Keep only divisors
 .sum //Sum them
 ).tail //Drop the first element (always k)
 if s.indexOf(k) > n - 2 //Make sure k appears at the end of the cycle (and only there)
 ) yield s //Yield the sequence (without k at the start)

Answer 10

JavaScript (V8), 104 bytes

n=>{for(i=1;s=++i;)for(o=[];o.push(v=s)<=n;new Set(o).size-n|s-i||print(o))for(j=s=0;++j<v;s+=v%j?0:j);}

Try it online!

Answer 11

R, 105 bytes

function(n)repeat{y=v=T=T+1;w=n;while({z=1:y;y=sum(z[!y%%z])-y}!=T&(w=w-1)&y)v=c(v,y);if(!w&y==T)show(v)}

Try it online!

Outputs n-sociable sequences indefinitely.

Answer 12

05AB1E, 18 bytes

∞εIFDÑ ̈O})}ʒćQJ}€ ̈

Outputs the infinite sequence including "duplicates".

Try it online.

If we're allowed to output every inner list one size to large (i.e. [6,6] instead of [6] for \$n=1\$; [220,284,220] instead of [220,284] for \$n=2\$, etc.) we could omit the last three bytes:
try it online.

Explanation:

∞ # Push the infinite positive sequence: [1,2,3,...]
 ε # Map each to:
 IF # Loop the input amount of times:
 D # Duplicate the current integer
 Ñ # Get its divisors (including itself)
 ̈ # Remove the last item (itself)
 O # Take the sum of those divisors
 }) # After the loop: wrap all values into a list
 }ʒ # After the map: filter the list of lists by:
 ć # Extract head; pop and push remainder-list and first item separated
 Q # Check for each value in the remainder-list if it's equal to this head
 J # Join those checks together to a string
 # (only 1 is truthy in 05AB1E, including something like "00001";
 # so in the filter we basically check if the first item is equal to the last
 # item and NONE of the other items)
 }€ # After the filter: map over each remaining inner list
 ̈ # And remove the final duplicated item