Data commit

This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions

View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Summarize_and_say_sequence

View file

@ -0,0 +1,60 @@
There are several ways to generate a self-referential sequence. One very common one (the [[Look-and-say sequence]]) is to start with a positive integer, then generate the next term by concatenating enumerated groups of adjacent alike digits:
0, 10, 1110, 3110, 132110, 1113122110, 311311222110 ...
The terms generated grow in length geometrically and never converge.
Another way to generate a self-referential sequence is to summarize the previous term.
Count how many of each alike digit there is, then concatenate the sum and digit for each of the sorted enumerated digits. Note that the first five terms are the same as for the previous sequence.
0, 10, 1110, 3110, 132110, 13123110, 23124110 ...
Sort the digits largest to smallest. Do not include counts of digits that do not appear in the previous term.
Depending on the seed value, series generated this way always either converge to a stable value or to a short cyclical pattern. (For our purposes, I'll use converge to mean an element matches a previously seen element.) The sequence shown, with a seed value of 0, converges to a stable value of 1433223110 after 11 iterations. The seed value that converges most quickly is 22. It goes stable after the first element. (The next element is 22, which has been seen before.)
;Task:
Find all the positive integer seed values under 1000000, for the above convergent self-referential sequence, that takes the largest number of iterations before converging. Then print out the number of iterations and the sequence they return. Note that different permutations of the digits of the seed will yield the same sequence. For this task, assume leading zeros are not permitted.
<pre>Seed Value(s): 9009 9090 9900
Iterations: 21
Sequence: (same for all three seeds except for first element)
9009
2920
192210
19222110
19323110
1923123110
1923224110
191413323110
191433125110
19151423125110
19251413226110
1916151413325110
1916251423127110
191716151413326110
191726151423128110
19181716151413327110
19182716151423129110
29181716151413328110
19281716151423228110
19281716151413427110
19182716152413228110
</pre>
;Related tasks:
* &nbsp; [[Fours is the number of letters in the ...]]
* &nbsp; [[Look-and-say sequence]]
* &nbsp; [[Number names]]
* &nbsp; [[Self-describing numbers]]
* &nbsp; [[Spelling of ordinal numbers]]
{{Template:Strings}}
;Also see:
* &nbsp; [[oeis:A036058|The On-Line Encyclopedia of Integer Sequences]].
<br><br>

View file

@ -0,0 +1,26 @@
[String] result
V longest = 0
F make_sequence(n) -> N
DefaultDict[Char, Int] map
L(c) n
map[c]++
V z =
L(k) sorted(map.keys(), reverse' 1B)
z = Char(code' map[k] + 0.code)
z = k
I :longest <= z.len
:longest = z.len
I z !C :result
:result [+]= z
make_sequence(z)
L(test) [9900, 9090, 9009]
result.clear()
longest = 0
make_sequence(test)
print([#.] Iterations: #..format(test, result.len + 1))
print(result.join("\n"))
print("\n")

View file

@ -0,0 +1,62 @@
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;
procedure SelfRef is
subtype Seed is Natural range 0 .. 1_000_000;
subtype Num is Natural range 0 .. 10;
type NumList is array (0 .. 10) of Num;
package IO is new Ada.Text_IO.Integer_IO (Natural);
package DVect is new Ada.Containers.Vectors (Positive, NumList);
function Init (innum : Seed) return NumList is
list : NumList := (others => 0);
number : Seed := innum; d : Num;
begin
loop
d := Num (number mod 10);
list (d) := list (d) + 1;
number := number / 10; exit when number = 0;
end loop; return list;
end Init;
procedure Next (inoutlist : in out NumList) is
list : NumList := (others => 0);
begin
for i in list'Range loop
if inoutlist (i) /= 0 then
list (i) := list (i) + 1;
list (inoutlist (i)) := list (inoutlist (i)) + 1;
end if;
end loop; inoutlist := list;
end Next;
procedure Show (list : NumList) is begin
for i in reverse list'Range loop
if list (i) > 0 then
IO.Put (list (i), Width => 1); IO.Put (i, Width => 1);
end if;
end loop; New_Line;
end Show;
function Iterate (theseed : Seed; p : Boolean) return Natural is
list : NumList := Init (theseed);
vect : DVect.Vector;
begin
vect.Append (list);
loop
if p then Show (list); end if;
Next (list); exit when vect.Contains (list); vect.Append (list);
end loop;
return Integer (DVect.Length (vect)) + 1;
end Iterate;
mseed : Seed;
len, maxlen : Natural := 0;
begin
for i in Seed'Range loop
len := Iterate (i, False);
if len > maxlen then mseed := i; maxlen := len; end if;
end loop;
IO.Put (maxlen, Width => 1); Put_Line (" Iterations:");
IO.Put (mseed, Width => 1); New_Line;
len := Iterate (mseed, True);
end SelfRef;

View file

@ -0,0 +1,76 @@
text
next(text s)
{
integer c, e, l;
index v;
data d;
l = ~s;
while (l) {
v[-s[l -= 1]] += 1;
}
for (c, e in v) {
b_form(d, "%d%c", e, -c);
}
return d;
}
integer
depth(text s, integer i, record r)
{
integer d;
d = 0;
r_j_integer(d, r, s);
if (d <= 0) {
i += 1;
d += d ? i : -i;
r[s] = d;
i = depth(next(s), i, r);
d = r[s];
if (d <= 0) {
r[s] = d = i + 1;
}
}
return d;
}
integer
main(void)
{
integer d, e, i;
record r;
list l;
d = 0;
i = 1000000;
while (i) {
i -= 1;
e = depth(itoa(i), 0, r);
if (e == d) {
lb_p_integer(l, i);
} elif (d < e) {
d = e;
l_clear(l);
lb_p_integer(l, i);
}
}
o_("longest length is ", d, "\n");
while (l_o_integer(i, l, 0)) {
text s;
o_("\n", i, "\n");
e = d - 1;
s = itoa(i);
while (e) {
o_(s = next(s), "\n");
e -= 1;
}
}
return 0;
}

View file

@ -0,0 +1,33 @@
; The following directives and commands speed up execution:
#NoEnv
SetBatchlines -1
ListLines Off
Process, Priority,, high
iterations := 0, seed := "Seeds: "
Loop 1000000
If (newIterations := CountSubString(list := ListSequence(A_Index), "`n")) > iterations
iterations := newiterations
,final := "`nIterations: " iterations+1 "`nSequence:`n`n" A_Index "`n" list
,seed := A_Index " "
else if (newIterations = iterations)
seed .= A_Index " "
MsgBox % "Seeds: " . seed . final
ListSequence(seed){
While !InStr("`n" . out, "`n" (d:=Describe(seed)) "`n")
out .= d "`n", seed := d
return out
}
Describe(n){
Loop 10
If (t:=CountSubString(n, 10-A_Index))
out .= t . (10-A_Index)
return out
}
CountSubstring(fullstring, substring){
StringReplace, junk, fullstring, %substring%, , UseErrorLevel
return errorlevel
}

View file

@ -0,0 +1,41 @@
*FLOAT64
DIM list$(30)
maxiter% = 0
maxseed% = 0
FOR seed% = 0 TO 999999
list$(0) = STR$(seed%)
iter% = 0
REPEAT
list$(iter%+1) = FNseq(list$(iter%))
IF VALlist$(iter%+1) <= VALlist$(iter%) THEN
FOR try% = iter% TO 0 STEP -1
IF list$(iter%+1) = list$(try%) EXIT REPEAT
NEXT
ENDIF
iter% += 1
UNTIL FALSE
IF iter% >= maxiter% THEN
IF iter% > maxiter% CLS
maxiter% = iter%
maxseed% = seed%
PRINT "Seed " ;seed% " has "; iter% " iterations"
ENDIF
NEXT
PRINT '"Sequence:"
number$ = STR$(maxseed%)
FOR i% = 1 TO maxiter%
PRINT number$
number$ = FNseq(number$)
NEXT
END
DEF FNseq(n$)
LOCAL I%, o$, d%()
DIM d%(9)
FOR I% = 1 TO LEN(n$)
d%(ASCMID$(n$,I%)-&30) += 1
NEXT
FOR I% = 9 TO 0 STEP -1
IF d%(I%) o$ += STR$d%(I%) + STR$I%
NEXT
= o$

View file

@ -0,0 +1,72 @@
( ( self-referential
= seq N next
. ( next
= R S d f
. 0:?S
& whl
' (@(!arg:%@?d ?arg)&(.!d)+!S:?S)
& :?R
& whl
' ( !S:#?f*(.?d)+?S
& !f !d !R:?R
)
& str$!R
)
& 1:?N
& !arg:?seq
& whl
' ( next$!arg:?arg
& ~(!seq:? !arg ?)
& !arg !seq:?seq
& 1+!N:?N
)
& (!seq.!N)
)
& ( Perm
= permutations S p
. :?permutations
& ( perm
= prefix List original A Z p
. !arg:(?prefix.)
& str$!prefix:?p
& (!S:?+(.!p)+?|(.!p)+!S:?S)
| !arg:(0 ?.?)&
| !arg:(?prefix.?List:?original)
& whl
' ( @(!List:%?A ?Z)
& perm$(!prefix !A.!Z)
& str$(!Z !A):~!original:?List
)
)
& 0:?S
& perm$(.!arg)
& :?permutations
& whl
' ( !S:?*(.?p)+?S
& !p !permutations:?permutations
)
& !permutations
)
& -1:?i:?max
& :?seqs
& whl
' ( 1+!i:<1000000:?i
& ( @(!i:? %@?a >%@!a ?)
| self-referential$!i
: ( ?seq
. ( >!max:?max&:?seqs
| !max
)
& ( "Seed Value(s):" Perm$!i
. "Sequence: (same for all three seeds except for first element)
"
!seq
)
!seqs
: ?seqs
)
|
)
)
& out$("Iterations:" !max !seqs)
);

View file

@ -0,0 +1,43 @@
#include <iostream>
#include <string>
#include <map>
#include <vector>
#include <algorithm>
std::map<char, int> _map;
std::vector<std::string> _result;
size_t longest = 0;
void make_sequence( std::string n ) {
_map.clear();
for( std::string::iterator i = n.begin(); i != n.end(); i++ )
_map.insert( std::make_pair( *i, _map[*i]++ ) );
std::string z;
for( std::map<char, int>::reverse_iterator i = _map.rbegin(); i != _map.rend(); i++ ) {
char c = ( *i ).second + 48;
z.append( 1, c );
z.append( 1, i->first );
}
if( longest <= z.length() ) {
longest = z.length();
if( std::find( _result.begin(), _result.end(), z ) == _result.end() ) {
_result.push_back( z );
make_sequence( z );
}
}
}
int main( int argc, char* argv[] ) {
std::vector<std::string> tests;
tests.push_back( "9900" ); tests.push_back( "9090" ); tests.push_back( "9009" );
for( std::vector<std::string>::iterator i = tests.begin(); i != tests.end(); i++ ) {
make_sequence( *i );
std::cout << "[" << *i << "] Iterations: " << _result.size() + 1 << "\n";
for( std::vector<std::string>::iterator j = _result.begin(); j != _result.end(); j++ ) {
std::cout << *j << "\n";
}
std::cout << "\n\n";
}
return 0;
}

View file

@ -0,0 +1,123 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
typedef struct rec_t rec_t;
struct rec_t {
int depth;
rec_t * p[10];
};
rec_t root = {0, {0}};
#define USE_POOL_ALLOC
#ifdef USE_POOL_ALLOC /* not all that big a deal */
rec_t *tail = 0, *head = 0;
#define POOL_SIZE (1 << 20)
inline rec_t *new_rec()
{
if (head == tail) {
head = calloc(sizeof(rec_t), POOL_SIZE);
tail = head + POOL_SIZE;
}
return head++;
}
#else
#define new_rec() calloc(sizeof(rec_t), 1)
#endif
rec_t *find_rec(char *s)
{
int i;
rec_t *r = &root;
while (*s) {
i = *s++ - '0';
if (!r->p[i]) r->p[i] = new_rec();
r = r->p[i];
}
return r;
}
/* speed up number to string conversion */
char number[100][4];
void init()
{
int i;
for (i = 0; i < 100; i++)
sprintf(number[i], "%d", i);
}
void count(char *buf)
{
int i, c[10] = {0};
char *s;
for (s = buf; *s; c[*s++ - '0']++);
for (i = 9; i >= 0; i--) {
if (!c[i]) continue;
s = number[c[i]];
*buf++ = s[0];
if ((*buf = s[1])) buf++;
*buf++ = i + '0';
}
*buf = '\0';
}
int depth(char *in, int d)
{
rec_t *r = find_rec(in);
if (r->depth > 0)
return r->depth;
d++;
if (!r->depth) r->depth = -d;
else r->depth += d;
count(in);
d = depth(in, d);
if (r->depth <= 0) r->depth = d + 1;
return r->depth;
}
int main(void)
{
char a[100];
int i, d, best_len = 0, n_best = 0;
int best_ints[32];
rec_t *r;
init();
for (i = 0; i < 1000000; i++) {
sprintf(a, "%d", i);
d = depth(a, 0);
if (d < best_len) continue;
if (d > best_len) {
n_best = 0;
best_len = d;
}
if (d == best_len)
best_ints[n_best++] = i;
}
printf("longest length: %d\n", best_len);
for (i = 0; i < n_best; i++) {
printf("%d\n", best_ints[i]);
sprintf(a, "%d", best_ints[i]);
for (d = 0; d <= best_len; d++) {
r = find_rec(a);
printf("%3d: %s\n", r->depth, a);
count(a);
}
putchar('\n');
}
return 0;
}

View file

@ -0,0 +1,60 @@
summarize = proc (s: string) returns (string) signals (bad_format)
digit_count: array[int] := array[int]$fill(0,10,0)
for c: char in string$chars(s) do
d: int := int$parse(string$c2s(c)) resignal bad_format
digit_count[d] := digit_count[d] + 1
end
out: stream := stream$create_output()
for d: int in int$from_to_by(9,0,-1) do
if digit_count[d]>0 then
stream$puts(out, int$unparse(digit_count[d]))
stream$puts(out, int$unparse(d))
end
end
return(stream$get_contents(out))
end summarize
converge = proc (s: string) returns (int) signals (bad_format)
seen: array[string] := array[string]$[]
steps: int := 0
while true do
for str: string in array[string]$elements(seen) do
if str = s then return(steps) end
end
array[string]$addh(seen, s)
s := summarize(s)
steps := steps + 1
end
end converge
start_up = proc ()
po: stream := stream$primary_output()
seeds: array[int]
max: int := 0
for i: int in int$from_to(1, 999999) do
steps: int := converge(int$unparse(i))
if steps > max then
max := steps
seeds := array[int]$[i]
elseif steps = max then
array[int]$addh(seeds,i)
end
end
stream$puts(po, "Seed values: ")
for i: int in array[int]$elements(seeds) do
stream$puts(po, int$unparse(i) || " ")
end
stream$putl(po, "\nIterations: " || int$unparse(max))
stream$putl(po, "\nSequence: ")
s: string := int$unparse(array[int]$bottom(seeds))
for i: int in int$from_to(1, max) do
stream$putl(po, s)
s := summarize(s)
end
end start_up

View file

@ -0,0 +1,46 @@
(defmacro reduce-with
"simplifies form of reduce calls"
[bindings & body]
(assert (and (vector? bindings) (= 4 (count bindings))))
(let [[acc init, item sequence] bindings]
`(reduce (fn [~acc ~item] ~@body) ~init ~sequence)))
(defn digits
"maps e.g. 2345 => [2 3 4 5]"
[n] (->> n str seq (map #(- (int %) (int \0))) vec))
(defn dcount
"handles case (probably impossible in this range) of digit count > 9"
[ds] (let [c (count ds)] (if (< c 10) c (digits c))))
(defn summarize-prev
"produces the summary sequence for a digit sequence"
[ds]
(->> ds (sort >) (partition-by identity) (map (juxt dcount first)) flatten vec)
(defn convergent-sequence
"iterates summarize-prev until a duplicate is found; returns summary step sequence"
[ds]
(reduce-with [cur-seq [], ds (iterate summarize-prev ds)]
(if (some #{ds} cur-seq)
(reduced cur-seq)
(conj cur-seq ds))))
(defn candidate-seq
"only try an already sorted digit sequence, so we only try equivalent seeds once;
e.g. 23 => []; 32 => (convergent-sequence [3 2])"
[n]
(let [ds (digits n)]
(if (apply >= ds) (convergent-sequence ds) [])))
(defn find-longest
"the meat of the task; returns summary step sequence(s) of max length within the range"
[limit]
(reduce-with [max-seqs [[]], new-seq (map candidate-seq (range 1 limit))]
(let [cmp (compare (-> max-seqs first count) (count new-seq))]
(cond
(pos? cmp) max-seqs
(neg? cmp) [new-seq]
(zero? cmp) (conj max-seqs new-seq)))))
(def results (find-longest 1000000))

View file

@ -0,0 +1,19 @@
(defn perms
"produce all the permutations of a finite sequence"
[ds]
(if (empty? ds)
[]
(let [rotseq (for [n (range (count ds))] (concat (drop n ds) (take n ds)))]
(reduce-with [rs [], [[d & ds]] rotseq]
(concat rs (if (empty? ds) [[d]] (map #(cons d %) (perms ds))))))))
(doseq [result results]
(let [seed (first result)
seeds (->> seed perms (map vec) set sort (remove (comp zero? first)))]
(apply println "Seed value(s):" (map #(apply str %) seeds)))))
(println)
(println "Iterations:" (count result))
(println)
(println "Sequence:")
(doseq [ds result]
(println (apply str ds))))

View file

@ -0,0 +1,42 @@
sequence = (n) ->
cnts = {}
for c in n.toString()
d = parseInt(c)
incr cnts, d
seq = []
while true
s = ''
for i in [9..0]
s += "#{cnts[i]}#{i}" if cnts[i]
if s in seq
break
seq.push s
new_cnts = {}
for digit, cnt of cnts
incr new_cnts, cnt
incr new_cnts, digit
cnts = new_cnts
seq
incr = (h, k) ->
h[k] ?= 0
h[k] += 1
descending = (n) ->
return true if n < 10
tens = n / 10
return false if n % 10 > tens % 10
descending(tens)
max_len = 0
for i in [1..1000000]
if descending(i)
seq = sequence(i)
if seq.length > max_len
max_len = seq.length
max_seq = seq
max_i = i
console.log max_i, max_seq

View file

@ -0,0 +1,29 @@
(defun count-and-say (str)
(let* ((s (sort (map 'list #'identity str) #'char>))
(out (list (first s) 0)))
(loop for x in s do
(if (char= x (first out))
(incf (second out))
(setf out (nconc (list x 1) out))))
(format nil "~{~a~^~}" (nreverse out))))
(defun ref-seq-len (n &optional doprint)
(let ((s (format nil "~d" n)) hist)
(loop (push s hist)
(if doprint (format t "~a~%" s))
(setf s (count-and-say s))
(loop for item in hist
for i from 0 to 2 do
(if (string= s item) (return-from ref-seq-len (length hist)))))))
(defun find-longest (top)
(let (nums (len 0))
(dotimes (x top)
(let ((l (ref-seq-len x)))
(if (> l len) (setf len l nums nil))
(if (= l len) (push x nums))))
(list nums len)))
(let ((r (find-longest 1000000)))
(format t "Longest: ~a~%" r)
(ref-seq-len (first (first r)) t))

View file

@ -0,0 +1,22 @@
Longest: ((9900 9090 9009) 21)
9900
2920
192210
19222110
19323110
1923123110
1923224110
191413323110
191433125110
19151423125110
19251413226110
1916151413325110
1916251423127110
191716151413326110
191726151423128110
19181716151413327110
19182716151423129110
29181716151413328110
19281716151423228110
19281716151413427110
19182716152413228110

View file

@ -0,0 +1,39 @@
import std.stdio, std.algorithm, std.conv;
string[] selfReferentialSeq(string n, string[] seen=[]) nothrow {
__gshared static string[][string] cache;
if (n in cache)
return cache[n];
if (seen.canFind(n))
return [];
int[10] digit_count;
foreach (immutable d; n)
digit_count[d - '0']++;
string term;
foreach_reverse (immutable d; 0 .. 10)
if (digit_count[d] > 0)
term ~= text(digit_count[d], d);
return cache[n] = [n] ~ selfReferentialSeq(term, [n] ~ seen);
}
void main() {
enum int limit = 1_000_000;
int max_len;
int[] max_vals;
foreach (immutable n; 1 .. limit) {
const seq = n.text().selfReferentialSeq();
if (seq.length > max_len) {
max_len = seq.length;
max_vals = [n];
} else if (seq.length == max_len)
max_vals ~= n;
}
writeln("values: ", max_vals);
writeln("iterations: ", max_len);
writeln("sequence:");
foreach (const idx, const val; max_vals[0].text.selfReferentialSeq)
writefln("%2d %s", idx + 1, val);
}

View file

@ -0,0 +1,179 @@
import std.range, std.algorithm;
struct Permutations(bool doCopy=true, T) {
T[] items;
int r;
bool stopped;
int[] indices, cycles;
static if (!doCopy)
T[] result;
this(T)(T[] items, int r=-1) pure nothrow @safe {
this.items = items;
immutable int n = items.length;
if (r < 0)
r = n;
this.r = r;
immutable n_minus_r = n - r;
if (n_minus_r < 0) {
this.stopped = true;
} else {
this.stopped = false;
this.indices = n.iota.array;
//this.cycles = iota(n, n_minus_r, -1).array; // Not nothrow.
this.cycles = iota(n_minus_r + 1, n + 1).retro.array;
}
static if (!doCopy)
result = new T[r];
}
@property bool empty() const pure nothrow @safe @nogc {
return this.stopped;
}
static if (doCopy) {
@property T[] front() const pure nothrow @safe {
assert(!this.stopped);
auto result = new T[r];
foreach (immutable i, ref re; result)
re = items[indices[i]];
return result;
}
} else {
@property T[] front() pure nothrow @safe @nogc {
assert(!this.stopped);
foreach (immutable i, ref re; this.result)
re = items[indices[i]];
return this.result;
}
}
void popFront() pure nothrow /*@safe*/ @nogc {
assert(!this.stopped);
int i = r - 1;
while (i >= 0) {
immutable int j = cycles[i] - 1;
if (j > 0) {
cycles[i] = j;
indices[i].swap(indices[$ - j]);
return;
}
cycles[i] = indices.length - i;
immutable int n1 = indices.length - 1;
assert(n1 >= 0);
immutable int num = indices[i];
// copy isn't @safe.
indices[i + 1 .. n1 + 1].copy(indices[i .. n1]);
indices[n1] = num;
i--;
}
this.stopped = true;
}
}
Permutations!(doCopy, T) permutations(bool doCopy=true, T)
(T[] items, int r=-1)
pure nothrow @safe {
return Permutations!(doCopy, T)(items, r);
}
// ---------------------------------
import std.stdio, std.typecons, std.conv, std.algorithm, std.array,
std.exception, std.string;
enum maxIters = 1_000_000;
string A036058(in string ns) pure nothrow @safe {
return ns.representation.group.map!(t => t[1].text ~ char(t[0])).join;
}
int A036058_length(bool doPrint=false)(string numberString="0") {
int iterations = 1;
int queueIndex;
string[3] lastThree;
while (true) {
static if (doPrint)
writefln(" %2d %s", iterations, numberString);
numberString = numberString
.dup
.representation
.sort()
.release
.assumeUTF;
if (lastThree[].canFind(numberString))
break;
assert(iterations < maxIters);
lastThree[queueIndex] = numberString;
numberString = numberString.A036058;
iterations++;
queueIndex++;
queueIndex %= 3;
}
return iterations;
}
Tuple!(int,int[]) max_A036058_length(R)(R startRange = 11.iota) {
bool[string] alreadyDone;
auto max_len = tuple(-1, (int[]).init);
foreach (n; startRange) {
immutable sns = n
.to!(char[])
.representation
.sort()
.release
.assumeUTF;
if (sns !in alreadyDone) {
alreadyDone[sns] = true;
const size = sns.A036058_length;
if (size > max_len[0])
max_len = tuple(size, [n]);
else if (size == max_len[0])
max_len[1] ~= n;
}
}
return max_len;
}
void main() {
//const (lenMax, starts) = maxIters.iota.max_A036058_length;
const lenMax_starts = maxIters.iota.max_A036058_length;
immutable lenMax = lenMax_starts[0];
const starts = lenMax_starts[1];
// Expand:
int[] allStarts;
foreach (immutable n; starts) {
bool[string] set;
foreach (const k; permutations!false(n.to!(char[]), 4))
if (k[0] != '0')
set[k.idup] = true;
//allStarts ~= set.byKey.to!(int[]);
allStarts ~= set.byKey.map!(to!int).array;
}
allStarts = allStarts.sort().filter!(x => x < maxIters).array;
writefln("The longest length, followed by the number(s) with the
longest sequence length for starting sequence numbers below maxIters
are:
Iterations = %d and sequence-starts = %s.", lenMax, allStarts);
writeln("Note that only the first of any sequences with the same
digits is printed below. (The others will differ only in their first
term).");
foreach (immutable n; starts) {
writeln;
A036058_length!true(n.text);
}
}

View file

@ -0,0 +1,134 @@
import core.stdc.stdio, core.stdc.stdlib;
struct MemoryPool(T, int MAX_BLOCK_BYTES = 1 << 17) {
static assert(!is(T == class),
"MemoryPool is designed for native data.");
static assert(MAX_BLOCK_BYTES >= 1,
"MemoryPool: MAX_BLOCK_BYTES must be >= 1 bytes.");
static assert(MAX_BLOCK_BYTES >= T.sizeof,
"MemoryPool: MAX_BLOCK_BYTES must be" ~
" bigger than a T.");
static if (T.sizeof * 5 > MAX_BLOCK_BYTES)
pragma(msg, "MemoryPool: Block is very small.");
alias Block = T[MAX_BLOCK_BYTES / T.sizeof];
static __gshared Block*[] blocks;
static __gshared T* nextFree, lastFree;
static T* newItem() nothrow {
if (nextFree >= lastFree) {
blocks ~= cast(Block*)calloc(1, Block.sizeof);
if (blocks[$ - 1] == null)
exit(1);
nextFree = blocks[$ - 1].ptr;
lastFree = nextFree + Block.length;
}
return nextFree++;
}
// static void freeAll() nothrow {
// foreach (blockPtr; blocks)
// free(blockPtr);
// blocks.length = 0;
// nextFree = null;
// lastFree = null;
// }
}
struct Rec { // Tree node
int length;
Rec*[10] p;
}
__gshared int nNodes;
__gshared Rec* rec_root;
__gshared MemoryPool!Rec recPool;
Rec* findRec(char* s, Rec* root) nothrow {
int c;
Rec* next;
while (true) {
c = *s;
s++;
if (!c)
break;
c -= '0';
next = root.p[c];
if (!next) {
nNodes++;
next = recPool.newItem;
root.p[c] = next;
}
root = next;
}
return root;
}
void nextNum(char* s) nothrow @nogc {
int[10] cnt;
for (int i = 0; s[i]; i++)
cnt[s[i] - '0']++;
foreach_reverse (i; 0 .. 10) {
if (!cnt[i])
continue;
s += sprintf(s, "%d%c", cnt[i], i + '0');
}
}
int getLen(char* s, int depth) nothrow {
auto r = findRec(s, rec_root);
if (r.length > 0)
return r.length;
depth++;
if (!r.length)
r.length = -depth;
else
r.length += depth;
nextNum(s);
depth = 1 + getLen(s, depth);
if (r.length <= 0)
r.length = depth;
return r.length;
}
void main() nothrow {
enum MAXN = 1_000_000;
int[100] longest;
int nLongest, ml;
char[32] buf;
rec_root = recPool.newItem();
foreach (immutable i; 0 .. MAXN) {
sprintf(buf.ptr, "%d", i);
int l = getLen(buf.ptr, 0);
if (l < ml)
continue;
if (l > ml) {
nLongest = 0;
ml = l;
}
longest[nLongest] = i;
nLongest++;
}
printf("seq leng: %d\n\n", ml);
foreach (immutable i; 0 .. nLongest) {
sprintf(buf.ptr, "%d", longest[i]);
// print len+1 so we know repeating starts from when
foreach (immutable l; 0 .. ml + 1) {
printf("%2d: %s\n", getLen(buf.ptr, 0), buf.ptr);
nextNum(buf.ptr);
}
printf("\n");
}
printf("Allocated %d Rec tree nodes.\n", nNodes);
//recPool.freeAll;
}

View file

@ -0,0 +1,112 @@
(lib 'hash)
(lib 'list) ;; permutations
(define H (make-hash))
;; G R A P H
;; generate 'normalized' starter vectors D[i] = number of digits 'i' (0 <=i < 10)
;; reduce graph size : 9009, 9900 .. will be generated once : vector #(2 0 0 0 0 0 0 0 0 2)
(define (generate D dstart ndigits (sd 0))
(when (> ndigits 0)
(set! sd (vector-ref D dstart)) ;; save before recurse
(for ((i (in-range 0 (1+ ndigits))))
#:continue (and ( = i 0) (> dstart 0))
(vector-set! D dstart i)
(sequence D) ;; sequence length from D
(for ((j (in-range (1+ dstart) 10)))
(generate D j (- ndigits i))))
(vector-set! D dstart sd))) ;; restore
;; compute follower of D (at most 99 same digits)
(define (dnext D (dd 0))
(define N (make-vector 10))
(for ((d D) (i 10))
#:continue (zero? d)
(vector-set! N i (1+ (vector-ref N i)))
(if (< d 10)
(vector-set! N d (1+ (vector-ref N d))) ;; d < 9
(begin
(set! dd (modulo d 10))
(vector-set! N dd (1+ (vector-ref N dd)))
(set! dd (quotient d 10))
(vector-set! N dd (1+ (vector-ref N dd))))))
N)
;; update all nodes in same sequence
;; seq-length (next D) = 1 - seq-length(D)
(define (sequence D)
(define (dists D d)
(unless (hash-ref H D)
(hash-set H D d)
(dists (dnext D ) (1- d))))
(unless (hash-ref H D)
(dists D (sequence-length D))))
;; sequence length from D
;; stops on loop found (node N)
(define (sequence-length D )
(define (looper N looplg depth) ;; looper 2 : a b a
(when ( > depth 0)
(hash-set H N looplg)
(looper (dnext N) looplg (1- depth))))
(define followers (make-hash))
(define N (dnext D))
(define seqlg 0)
(define looplg 0)
(hash-set followers D 0)
(set! seqlg
(for ((lg (in-naturals 1 )))
#:break (hash-ref H N) => (+ lg (hash-ref H N)) ;; already known
#:break (hash-ref followers N) => lg ;; loop found
(hash-set followers N lg)
(set! N (dnext N))))
;; update nodes in loop : same seq-length
(when (hash-ref followers N) ;; loop found
(set! looplg ( - seqlg (hash-ref followers N)))
(looper N looplg looplg))
seqlg )
;; O U T P U T
;; backwards from D - normalized vector - to numbers (as strings)
(define (starters D)
(define (not-leading-zero list) (!zero? (first list)))
(map list->string
(filter not-leading-zero (make-set (permutations (for/fold (acc null) ((d D) (i 10))
#:continue (zero? d)
(append acc (for/list ((j d)) i))))))))
;; printing one node
(define (D-print D)
(set! D (reverse (vector->list D)))
(for/string ( (d D) (i (in-range 9 -1 -1)))
#:continue (zero? d)
(string-append d i)))
;; print graph contents
(define (print-sequence D)
(writeln 1 (starters D))
(writeln 2 (D-print D ))
(for ((i (in-range 1 (hash-ref H D))))
(writeln (+ i 2) (D-print (setv! D (dnext D))))))
;; TA S K
(define (task (n 6) (verbose #t))
(generate (make-vector 10) 0 n)
(define seqmax (apply max (hash-values H)))
(when verbose (for ((kv H))
#:continue (!= (rest kv ) seqmax)
(print-sequence (first kv))))
(writeln (expt 10 n) '--> 'max-sequence= (1+ seqmax) 'nodes= (length (hash-values H))))

View file

@ -0,0 +1,32 @@
(task 6)
1 (9009 9090 9900)
2 2920
3 192210
4 19222110
5 19323110
6 1923123110
7 1923224110
8 191413323110
9 191433125110
10 19151423125110
11 19251413226110
12 1916151413325110
13 1916251423127110
14 191716151413326110
15 191726151423128110
16 19181716151413327110
17 19182716151423129110
18 29181716151413328110
19 19281716151423228110
20 19281716151413427110
21 19182716152413228110
1000000 --> max-sequence= 21 nodes= 10926
(task 7 #f)
10000000 --> max-sequence= 21 nodes= 23432
(task 8 #f)
100000000 --> max-sequence= 21 nodes= 47359
(task 9 #f)
1000000000 --> max-sequence= 21 nodes= 97455
(task 10 #f)
10000000000 --> max-sequence= 21 nodes= 188493

View file

@ -0,0 +1,198 @@
class
SELF_REFERENTIAL_SEQUENCE
create
make
feature
make
local
i: INTEGER
length, max: INTEGER_64
do
create seed_value.make
create sequence.make (25)
create permuted_values.make
from
i := 1
until
i > 1000000
loop
length := check_length (i.out)
if length > max then
max := length
seed_value.wipe_out
seed_value.extend (i)
elseif length = max then
seed_value.extend (i)
end
sequence.wipe_out
i := next_ascending (i).to_integer
end
io.put_string ("Maximal length: " + max.out)
io.put_string ("%NSeed Value: %N")
across
seed_value as s
loop
permute (s.item.out, 1)
end
across
permuted_values as p
loop
io.put_string (p.item + "%N")
end
io.put_string ("Sequence:%N")
max := check_length (seed_value [1].out)
across
sequence as s
loop
io.put_string (s.item)
io.new_line
end
end
next_ascending (n: INTEGER_64): STRING
-- Next number with ascending digits after 'n'.
-- Numbers with trailing zeros are treated as ascending numbers.
local
st: STRING
first, should_be, zero: STRING
i: INTEGER
do
create Result.make_empty
create zero.make_empty
st := (n + 1).out
from
until
st.count < 2
loop
first := st.at (1).out
if st [2] ~ '0' then
from
i := 3
until
i > st.count
loop
zero.append ("0")
i := i + 1
end
Result.append (first + first + zero)
st := ""
else
should_be := st.at (2).out
if first > should_be then
should_be := first
end
st.remove_head (2)
st.prepend (should_be)
Result.append (first)
end
end
if st.count > 0 then
Result.append (st [st.count].out)
end
end
feature {NONE}
seed_value: SORTED_TWO_WAY_LIST [INTEGER]
permuted_values: SORTED_TWO_WAY_LIST [STRING]
sequence: ARRAYED_LIST [STRING]
permute (a: STRING; k: INTEGER)
-- All permutations of 'a'.
require
count_positive: a.count > 0
k_valid_index: k > 0
local
t: CHARACTER
b: STRING
found: BOOLEAN
do
across
permuted_values as p
loop
if p.item ~ a then
found := True
end
end
if k = a.count and a [1] /= '0' and not found then
create b.make_empty
b.deep_copy (a)
permuted_values.extend (b)
else
across
k |..| a.count as c
loop
t := a [k]
a [k] := a [c.item]
a [c.item] := t
permute (a, k + 1)
t := a [k]
a [k] := a [c.item]
a [c.item] := t
end
end
end
check_length (i: STRING): INTEGER_64
-- Length of the self referential sequence starting with 'i'.
local
found: BOOLEAN
j: INTEGER
s: STRING
do
create s.make_from_string (i)
from
until
found
loop
sequence.extend (s)
s := next (s)
from
j := sequence.count - 1
until
j < 1
loop
if sequence [j] ~ s then
found := True
end
j := j - 1
end
end
Result := sequence.count
end
next (n: STRING): STRING
-- Next item after 'n' in a self referential sequence.
local
i, count: INTEGER
counter: ARRAY [INTEGER]
do
create counter.make_filled (0, 0, 9)
create Result.make_empty
from
i := 1
until
i > n.count
loop
count := n [i].out.to_integer
counter [count] := counter [count] + 1
i := i + 1
end
from
i := 9
until
i < 0
loop
if counter [i] > 0 then
Result.append (counter [i].out + i.out)
end
i := i - 1
end
end
end

View file

@ -0,0 +1,10 @@
// Summarize and say sequence . Nigel Galloway: April 23rd., 2021
let rec fN g=let n=let n,g=List.head g|>List.countBy id|>List.unzip in n@(g|>List.collect(fun g->if g<10 then [g] else [g/10;g%10]))
if List.contains n g then g.Tail|>List.rev else fN(n::g)
let rec fG n g=seq{yield! n; if g>1 then yield! fG(n|>Seq.collect(fun n->[for g in 0..List.head n->g::n]))(g-1)}
let n,g=seq{yield [0]; yield! fG(Seq.init 9 (fun n->[n+1])) 6}
|>Seq.fold(fun(n,l) g->let g=fN [g] in match g.Length with e when e<n->(n,l) |e when e>n->(e,[[g]]) |e->(n,[g]::l))(0,[])
printfn "maximum number of iterations is %d" (n+1)
for n in g do for n in n do
printf "Permutations of "; n.Head|>List.rev|>List.iter(printf "%d"); printfn " produce:"
for n in n do (for n,g in List.countBy id n|>List.sort|>List.rev do printf "%d%d" g n); printfn ""

View file

@ -0,0 +1,37 @@
USING: assocs grouping io kernel math math.combinatorics
math.functions math.ranges math.statistics math.text.utils
prettyprint sequences sets ;
IN: rosetta-code.self-referential-sequence
: next-term ( seq -- seq ) histogram >alist concat ;
! Output the self-referential sequence, given a seed value.
: srs ( seq -- seq n )
V{ } clone [ 2dup member? ] [ 2dup push [ next-term ] dip ]
until nip dup length ;
: digit-before? ( m n -- ? ) dup zero? [ 2drop t ] [ <= ] if ;
! The numbers from 1 rto n sans permutations.
: candidates ( n -- seq )
[1,b] [ 1 digit-groups reverse ] map
[ [ digit-before? ] monotonic? ] filter ;
: max-seed ( n -- seq ) candidates [ srs nip ] supremum-by ;
: max-seeds ( n -- seq )
max-seed <permutations> members [ first zero? ] reject ;
: digits>number ( seq -- n ) [ 10^ * ] map-index sum ;
: >numbers ( seq -- seq ) [ digits>number ] map ;
: main ( -- )
"Seed value(s): " write
1,000,000 max-seeds
[ [ reverse ] map >numbers . ]
[ first srs ] bi
"Iterations: " write .
"Sequence:" print >numbers . ;
MAIN: main

View file

@ -0,0 +1,75 @@
package main
import (
"fmt"
"strconv"
)
func main() {
var maxLen int
var seqMaxLen [][]string
for n := 1; n < 1e6; n++ {
switch s := seq(n); {
case len(s) == maxLen:
seqMaxLen = append(seqMaxLen, s)
case len(s) > maxLen:
maxLen = len(s)
seqMaxLen = [][]string{s}
}
}
fmt.Println("Max sequence length:", maxLen)
fmt.Println("Sequences:", len(seqMaxLen))
for _, seq := range seqMaxLen {
fmt.Println("Sequence:")
for _, t := range seq {
fmt.Println(t)
}
}
}
func seq(n int) []string {
s := strconv.Itoa(n)
ss := []string{s}
for {
dSeq := sortD(s)
d := dSeq[0]
nd := 1
s = ""
for i := 1; ; i++ {
if i == len(dSeq) {
s = fmt.Sprintf("%s%d%c", s, nd, d)
break
}
if dSeq[i] == d {
nd++
} else {
s = fmt.Sprintf("%s%d%c", s, nd, d)
d = dSeq[i]
nd = 1
}
}
for _, s0 := range ss {
if s == s0 {
return ss
}
}
ss = append(ss, s)
}
panic("unreachable")
}
func sortD(s string) []rune {
r := make([]rune, len(s))
for i, d := range s {
j := 0
for ; j < i; j++ {
if d > r[j] {
copy(r[j+1:], r[j:i])
break
}
}
r[j] = d
}
return r
}

View file

@ -0,0 +1,26 @@
Number.metaClass.getSelfReferentialSequence = {
def number = delegate as String; def sequence = []
while (!sequence.contains(number)) {
sequence << number
def encoded = new StringBuilder()
((number as List).sort().join('').reverse() =~ /(([0-9])\2*)/).each { matcher, text, digit ->
encoded.append(text.size()).append(digit)
}
number = encoded.toString()
}
sequence
}
def maxSeqSize = { List values ->
values.inject([seqSize: 0, seeds: []]) { max, n ->
if (n % 100000 == 99999) println 'HT'
else if (n % 10000 == 9999) print '.'
def seqSize = n.selfReferentialSequence.size()
switch (seqSize) {
case max.seqSize: max.seeds << n
case { it < max.seqSize }: return max
default: return [seqSize: seqSize, seeds: [n]]
}
}
}

View file

@ -0,0 +1,7 @@
def max = maxSeqSize(0..<1000000)
println "\nLargest sequence size among seeds < 1,000,000\n"
println "Seeds: ${max.seeds}\n"
println "Size: ${max.seqSize}\n"
println "Sample sequence:"
max.seeds[0].selfReferentialSequence.each { println it }

View file

@ -0,0 +1,25 @@
import Data.Set (Set, member, insert, empty)
import Data.List (group, sort)
step :: String -> String
step = concatMap (\list -> show (length list) ++ [head list]) . group . sort
findCycle :: (Ord a) => [a] -> [a]
findCycle = aux empty where
aux set (x : xs)
| x `member` set = []
| otherwise = x : aux (insert x set) xs
select :: [[a]] -> [[a]]
select = snd . foldl (\(len, acc) xs -> case len `compare` length xs of
LT -> (length xs, [xs])
EQ -> (len, xs : acc)
GT -> (len, acc)) (0, [])
main :: IO ()
main = mapM_ (mapM_ print) $ -- Print out all the numbers
select $ -- find the longest ones
map findCycle $ -- run the sequences until there is a repeat
map (iterate step) $ -- produce the sequence
map show -- turn the numbers into digits
[1..1000000] -- The input seeds

View file

@ -0,0 +1,38 @@
link printf
procedure main()
every L := !longestselfrefseq(1000000) do
every printf(" %i : %i\n",i := 1 to *L,L[i])
end
procedure longestselfrefseq(N) #: find longest sequences from 1 to N
mlen := 0
every L := selfrefseq(n := 1 to N) do {
if mlen <:= *L then
ML := [L]
else if mlen = *L then
put(ML,L)
}
return ML
end
procedure selfrefseq(n) #: return list of sequence oeis:A036058 for seed n
S := set()
L := []
every p := seq(1) do
if member(S,n) then return L # ends at a repeat
else {
insert(S,n)
put(L,n)
n := nextselfrefseq(n)
}
end
procedure nextselfrefseq(n) #: return next element of sequence oeis:A036058
every (Counts := table(0))[integer(!n)] +:= 1 # count digits
every (n := "") ||:= (0 < Counts[i := 9 to 0 by -1]) || i # assemble counts
return integer(n)
end

View file

@ -0,0 +1,29 @@
link strings # to get csort()
procedure main(A)
limit := A[1] | 1000000 # Allow alternate limit
mSq := 0
# May have multiple 'unique' sequence sets (unrelated seeds) so use table
every s := [n := 1 to limit, sequence(n)] do {
if mSq <:= *s[2] then mT := table() # new max, start over
if mSq == *s[2] then insert((/mT[n := csort(n)] := set()) | mT[n],s)
}
dumpSequences(mT)
end
procedure sequence(n) # produce sequence of SDS with seed n
every (repeats := [], iter := seq(), put(repeats, n)) do
if (n := nElem(n)) == !repeats then return repeats # Converged
end
procedure nElem(n) # given n, produce its self-description
every (n1 := "", c := !cset(n)) do
(every (d := 0) +:= (upto(c, n),1)) | (n1 := d||c||n1)
return n1
end
procedure dumpSequences(seqTab) # Show each 'unique' sequence in table
every writes("Seeds:" | (!!seqTab)[1], " ")
write("\n\nIterations: ",*(!!seqTab)[2])
every s := !seqTab do (write() & every write(!(!s\1)[2]))
end

View file

@ -0,0 +1,6 @@
require'stats'
digits=: 10&#.inv"0 :. ([: ".@; (<'x'),~":&.>)
summar=: (#/.~ ,@,. ~.)@\:~&.digits
sequen=: ~.@(, summar@{:)^:_
values=: ~. \:~&.digits i.1e6
allvar=: [:(#~(=&<.&(10&^.) >./))@~.({~ perm@#)&.(digits"1)

View file

@ -0,0 +1,26 @@
;allvar&.> values #~ (= >./) #@sequen"0 values
9900 9090 9009
# sequen 9900
21
,.sequen 9900
9900
2920
192210
19222110
19323110
1923123110
1923224110
191413323110
191433125110
19151423125110
19251413226110
1916151413325110
1916251423127110
191716151413326110
191726151423128110
19181716151413327110
19182716151423129110
29181716151413328110
19281716151423228110
19281716151413427110
19182716152413228110

View file

@ -0,0 +1,4 @@
digits 321
3 2 1
digits inv 34 5
345

View file

@ -0,0 +1,2 @@
summar 0 1 2
10 11 12

View file

@ -0,0 +1,77 @@
import java.util.*;
import java.util.concurrent.ConcurrentHashMap;
import java.util.stream.IntStream;
public class SelfReferentialSequence {
static Map<String, Integer> cache = new ConcurrentHashMap<>(10_000);
public static void main(String[] args) {
Seeds res = IntStream.range(0, 1000_000)
.parallel()
.mapToObj(n -> summarize(n, false))
.collect(Seeds::new, Seeds::accept, Seeds::combine);
System.out.println("Seeds:");
res.seeds.forEach(e -> System.out.println(Arrays.toString(e)));
System.out.println("\nSequence:");
summarize(res.seeds.get(0)[0], true);
}
static int[] summarize(int seed, boolean display) {
String n = String.valueOf(seed);
String k = Arrays.toString(n.chars().sorted().toArray());
if (!display && cache.get(k) != null)
return new int[]{seed, cache.get(k)};
Set<String> seen = new HashSet<>();
StringBuilder sb = new StringBuilder();
int[] freq = new int[10];
while (!seen.contains(n)) {
seen.add(n);
int len = n.length();
for (int i = 0; i < len; i++)
freq[n.charAt(i) - '0']++;
sb.setLength(0);
for (int i = 9; i >= 0; i--) {
if (freq[i] != 0) {
sb.append(freq[i]).append(i);
freq[i] = 0;
}
}
if (display)
System.out.println(n);
n = sb.toString();
}
cache.put(k, seen.size());
return new int[]{seed, seen.size()};
}
static class Seeds {
int largest = Integer.MIN_VALUE;
List<int[]> seeds = new ArrayList<>();
void accept(int[] s) {
int size = s[1];
if (size >= largest) {
if (size > largest) {
largest = size;
seeds.clear();
}
seeds.add(s);
}
}
void combine(Seeds acc) {
acc.seeds.forEach(this::accept);
}
}
}

View file

@ -0,0 +1,17 @@
function selfReferential(n) {
n = n.toString();
let res = [n];
const makeNext = (n) => {
let matchs = {
'9':0,'8':0,'7':0,'6':0,'5':0,'4':0,'3':0,'2':0,'1':0,'0':0}, res = [];
for(let index=0;index<n.length;index++)
matchs[n[index].toString()]++;
for(let index=9;index>=0;index--)
if(matchs[index]>0)
res.push(matchs[index],index);
return res.join("").toString();
}
for(let i=0;i<10;i++)
res.push(makeNext(res[res.length-1]));
return [...new Set(res)];
}

View file

@ -0,0 +1,61 @@
# Given any array, produce an array of [item, count] pairs for each run.
def runs:
reduce .[] as $item
( [];
if . == [] then [ [ $item, 1] ]
else .[length-1] as $last
| if $last[0] == $item
then (.[0:length-1] + [ [$item, $last[1] + 1] ] )
else . + [[$item, 1]]
end
end ) ;
# string to string
def next_self_referential:
def runs2integer: # input is an array as produced by runs,
# i.e. an array of [count, n] pairs, where count is an int,
# and n is an "exploded" digit
reduce .[] as $pair
(""; . + ($pair[1] | tostring) + ([$pair[0]]|implode) ) ;
explode | sort | reverse | runs | runs2integer;
# Given an integer as a string,
# compute the entire sequence (of strings) to convergence:
def sequence_of_self_referentials:
def seq:
. as $ary
| (.[length-1] | next_self_referential) as $next
| if ($ary|index($next)) then $ary
else $ary + [$next] | seq
end;
[.] | seq;
def maximals(n):
def interesting:
tostring | (. == (explode | sort | reverse | implode));
reduce range(0;n) as $i
([[], 0]; # maximalseeds, length
if ($i | interesting) then
($i|tostring|sequence_of_self_referentials|length) as $length
| if .[1] == $length then [ .[0] + [$i], $length]
elif .[1] < $length then [ [$i], $length]
else .
end
else .
end );
def task(n):
maximals(n) as $answer
| "The maximal length to convergence for seeds up to \(n) is \($answer[1]).",
"The corresponding seeds are the allowed permutations",
"of the representative number(s): \($answer[0][])",
"For each representative seed, the self-referential sequence is as follows:",
($answer[0][] | tostring
| ("Representative: \(.)",
"Self-referential sequence:",
(sequence_of_self_referentials | map(tonumber))))
;
task(1000000)

View file

@ -0,0 +1,30 @@
$ jq -n -r -f Self_referential_sequence.jq
The maximal length to convergence for seeds up to 1000000 is 21.
The corresponding seeds are the allowed permutations
of the representative number(s): 9900
For each representative seed, the self-referential sequence is as follows:
Representative: 9900
Self-referential sequence:
[
9900,
2920,
192210,
19222110,
19323110,
1923123110,
1923224110,
191413323110,
191433125110,
19151423125110,
19251413226110,
1916151413325110,
1916251423127110,
191716151413326100,
191726151423128100,
19181716151413326000,
19182716151423128000,
29181716151413330000,
19281716151423230000,
19281716151413430000,
19182716152413230000
]

View file

@ -0,0 +1,61 @@
const seen = Dict{Vector{Char}, Vector{Char}}()
function findnextterm(prevterm)
counts = Dict{Char, Int}()
reversed = Vector{Char}()
for c in prevterm
if !haskey(counts, c)
counts[c] = 0
end
counts[c] += 1
end
for c in sort(collect(keys(counts)))
if counts[c] > 0
push!(reversed, c)
if counts[c] == 10
push!(reversed, '0'); push!(reversed, '1')
else
push!(reversed, Char(UInt8(counts[c]) + UInt8('0')))
end
end
end
reverse(reversed)
end
function findsequence(seedterm)
term = seedterm
sequence = Vector{Vector{Char}}()
while !(term in sequence)
push!(sequence, term)
if !haskey(seen, term)
nextterm = findnextterm(term)
seen[term] = nextterm
end
term = seen[term]
end
return sequence
end
function selfseq(maxseed)
maxseqlen = -1
maxsequences = Vector{Pair{Int, Vector{Char}}}()
for i in 1:maxseed
seq = findsequence([s[1] for s in split(string(i), "")])
seqlen = length(seq)
if seqlen > maxseqlen
maxsequences = [Pair(i, seq)]
maxseqlen = seqlen
elseif seqlen == maxseqlen
push!(maxsequences, Pair(i, seq))
end
end
println("The longest sequence length is $maxseqlen.")
for p in maxsequences
println("\n Seed: $(p[1])")
for seq in p[2]
println(" ", join(seq, ""))
end
end
end
selfseq(1000000)

View file

@ -0,0 +1,68 @@
// version 1.1.2
const val LIMIT = 1_000_000
val sb = StringBuilder()
fun selfRefSeq(s: String): String {
sb.setLength(0) // faster than using a local StringBuilder object
for (d in '9' downTo '0') {
if (d !in s) continue
val count = s.count { it == d }
sb.append("$count$d")
}
return sb.toString()
}
fun permute(input: List<Char>): List<List<Char>> {
if (input.size == 1) return listOf(input)
val perms = mutableListOf<List<Char>>()
val toInsert = input[0]
for (perm in permute(input.drop(1))) {
for (i in 0..perm.size) {
val newPerm = perm.toMutableList()
newPerm.add(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
fun main(args: Array<String>) {
val sieve = IntArray(LIMIT) // all zero by default
val elements = mutableListOf<String>()
for (n in 1 until LIMIT) {
if (sieve[n] > 0) continue
elements.clear()
var next = n.toString()
elements.add(next)
while (true) {
next = selfRefSeq(next)
if (next in elements) {
val size = elements.size
sieve[n] = size
if (n > 9) {
val perms = permute(n.toString().toList()).distinct()
for (perm in perms) {
if (perm[0] == '0') continue
val k = perm.joinToString("").toInt()
sieve[k] = size
}
}
break
}
elements.add(next)
}
}
val maxIterations = sieve.max()!!
for (n in 1 until LIMIT) {
if (sieve[n] < maxIterations) continue
println("$n -> Iterations = $maxIterations")
var next = n.toString()
for (i in 1..maxIterations) {
println(next)
next = selfRefSeq(next)
}
println()
}
}

View file

@ -0,0 +1,53 @@
-- Return the next term in the self-referential sequence
function findNext (nStr)
local nTab, outStr, pos, count = {}, "", 1, 1
for i = 1, #nStr do nTab[i] = nStr:sub(i, i) end
table.sort(nTab, function (a, b) return a > b end)
while pos <= #nTab do
if nTab[pos] == nTab[pos + 1] then
count = count + 1
else
outStr = outStr .. count .. nTab[pos]
count = 1
end
pos = pos + 1
end
return outStr
end
-- Return boolean indicating whether table t contains string s
function contains (t, s)
for k, v in pairs(t) do
if v == s then return true end
end
return false
end
-- Return the sequence generated by the given seed term
function buildSeq (term)
local sequence = {}
repeat
table.insert(sequence, term)
if not nextTerm[term] then nextTerm[term] = findNext(term) end
term = nextTerm[term]
until contains(sequence, term)
return sequence
end
-- Main procedure
nextTerm = {}
local highest, seq, hiSeq = 0
for i = 1, 10^6 do
seq = buildSeq(tostring(i))
if #seq > highest then
highest = #seq
hiSeq = {seq}
elseif #seq == highest then
table.insert(hiSeq, seq)
end
end
io.write("Seed values: ")
for _, v in pairs(hiSeq) do io.write(v[1] .. " ") end
print("\n\nIterations: " .. highest)
print("\nSample sequence:")
for _, v in pairs(hiSeq[1]) do print(v) end

View file

@ -0,0 +1,6 @@
selfRefSequence[ x_ ] := FromDigits@Flatten@Reverse@Cases[Transpose@{RotateRight[DigitCount@x,1], Range[0,9]},Except[{0,_}]]
DisplaySequence[ x_ ] := NestWhileList[selfRefSequence,x,UnsameQ[##]&,4]
data= {#, Length@DisplaySequence[#]}&/@Range[1000000];
Print["Values: ", Select[data ,#[[2]] == Max@data[[;;,2]]&][[1,;;]]]
Print["Iterations: ", Length@DisplaySequence[#]&/@Select[data ,#[[2]] == Max@data[[;;,2]]&][[1,;;]]]
DisplaySequence@Select[data, #[[2]] == Max@data[[;;,2]]&][[1]]//Column

View file

@ -0,0 +1,46 @@
import algorithm, sequtils, sets, strutils, tables
var cache: Table[seq[char], int] # Maps key -> number of iterations.
iterator sequence(seed: string): string =
## Yield the successive strings of a sequence.
var history: HashSet[string]
history.incl seed
var current = seed
yield current
while true:
var counts = current.toCountTable()
var next: string
for ch in sorted(toSeq(counts.keys), Descending):
next.add $counts[ch] & ch
if next in history: break
current = move(next)
history.incl current
yield current
proc seqLength(seed: string): int =
## Return the number of iterations for the given seed.
let key = sorted(seed, Descending)
if key in cache: return cache[key]
result = toSeq(sequence(seed)).len
cache[key] = result
var seeds: seq[int]
var itermax = 0
for seed in 0..<1_000_000:
let itercount = seqLength($seed)
if itercount > itermax:
itermax = itercount
seeds = @[seed]
elif itercount == itermax:
seeds.add seed
echo "Maximum iterations: ", itermax
echo "Seed values: ", seeds.join(", ")
echo "Sequence for $#:".format(seeds[0])
for s in sequence($seeds[0]): echo s

View file

@ -0,0 +1,38 @@
sub next_num {
my @a;
$a[$_]++ for split '', shift;
join('', map(exists $a[$_] ? $a[$_].$_ : "", reverse 0 .. 9));
}
my %cache;
sub seq {
my $a = shift;
my (%seen, @s);
until ($seen{$a}) {
$seen{$a} = 1;
push(@s, $a);
last if !wantarray && $cache{$a};
$a = next_num($a);
}
return (@s) if wantarray;
my $l = $cache{$a};
if ($l) { $cache{$s[$_]} = $#s - $_ + $l for (0 .. $#s); }
else {
$l++ while ($s[-$l] != $a);
$cache{pop @s} = $l for (1 .. $l);
$cache{pop @s} = ++$l while @s;
}
$cache{$s[0]}
}
my (@mlist, $mlen);
for (1 .. 100_000) { # 1_000_000 takes very, very long
my $l = seq($_);
next if $l < $mlen;
if ($l > $mlen) { $mlen = $l; @mlist = (); }
push @mlist, $_;
}
print "longest ($mlen): @mlist\n";
print join("\n", seq($_)), "\n\n" for @mlist;

View file

@ -0,0 +1,78 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"000000"</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">incn</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]=</span><span style="color: #008000;">'9'</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #004600;">false</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">n</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]=</span><span style="color: #008000;">'0'</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">n</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{},</span> <span style="color: #000000;">bestseen</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">maxcycle</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">srs</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">curr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">)></span><span style="color: #000000;">1</span> <span style="color: #008080;">and</span> <span style="color: #000000;">curr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #008000;">'0'</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">curr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">curr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">curr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">curr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]></span><span style="color: #000000;">ch</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">curr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">seen</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">}</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">cycle</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #004600;">true</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">digits</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">curr</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">curr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]-</span><span style="color: #008000;">'0'</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span>
<span style="color: #000000;">digits</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">next</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">digits</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">digits</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">next</span> <span style="color: #0000FF;">&=</span> <span style="color: #7060A8;">sprint</span><span style="color: #0000FF;">(</span><span style="color: #000000;">digits</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">next</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #008000;">'0'</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">next</span><span style="color: #0000FF;">,</span><span style="color: #000000;">seen</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">seen</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">seen</span><span style="color: #0000FF;">,</span><span style="color: #000000;">next</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">curr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">next</span>
<span style="color: #000000;">cycle</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">cycle</span><span style="color: #0000FF;">></span><span style="color: #000000;">maxcycle</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">seen</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]}</span>
<span style="color: #000000;">maxcycle</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">cycle</span>
<span style="color: #000000;">bestseen</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">seen</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">cycle</span><span style="color: #0000FF;">=</span><span style="color: #000000;">maxcycle</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">seen</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">while</span> <span style="color: #004600;">true</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">srs</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">incn</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000080;font-style:italic;">-- add non-leading-0 perms:</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">ri</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ri</span><span style="color: #0000FF;">))</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">pri</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ri</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">pri</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'0'</span> <span style="color: #008080;">and</span> <span style="color: #008080;">not</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pri</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pri</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">res</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"cycle length is "</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">maxcycle</span>
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bestseen</span><span style="color: #0000FF;">,{</span><span style="color: #004600;">pp_Nest</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">})</span>
<!--

View file

@ -0,0 +1,16 @@
(de selfRefSequence (Seed)
(let L (mapcar format (chop Seed))
(make
(for (Cache NIL (not (idx 'Cache L T)))
(setq L
(las (flip (sort (copy (link L))))) ) ) ) ) )
(let Res NIL
(for Seed 1000000
(let N (length (selfRefSequence Seed))
(cond
((> N (car Res)) (setq Res (list N Seed)))
((= N (car Res)) (queue 'Res Seed)) ) ) )
(println 'Values: (cdr Res))
(println 'Iterations: (car Res))
(mapc prinl (selfRefSequence (cadr Res))) )

View file

@ -0,0 +1,65 @@
from itertools import groupby, permutations
def A036058(number):
return ''.join( str(len(list(g))) + k
for k,g in groupby(sorted(str(number), reverse=True)) )
def A036058_length(numberstring='0', printit=False):
iterations, last_three, queue_index = 1, ([None] * 3), 0
def A036058(number):
# rely on external reverse-sort of digits of number
return ''.join( str(len(list(g))) + k
for k,g in groupby(number) )
while True:
if printit:
print(" %2i %s" % (iterations, numberstring))
numberstring = ''.join(sorted(numberstring, reverse=True))
if numberstring in last_three:
break
assert iterations < 1000000
last_three[queue_index], numberstring = numberstring, A036058(numberstring)
iterations += 1
queue_index +=1
queue_index %=3
return iterations
def max_A036058_length( start_range=range(11) ):
already_done = set()
max_len = (-1, [])
for n in start_range:
sn = str(n)
sns = tuple(sorted(sn, reverse=True))
if sns not in already_done:
already_done.add(sns)
size = A036058_length(sns)
if size > max_len[0]:
max_len = (size, [n])
elif size == max_len[0]:
max_len[1].append(n)
return max_len
lenmax, starts = max_A036058_length( range(1000000) )
# Expand
allstarts = []
for n in starts:
allstarts += [int(''.join(x))
for x in set(k
for k in permutations(str(n), 4)
if k[0] != '0')]
allstarts = [x for x in sorted(allstarts) if x < 1000000]
print ( '''\
The longest length, followed by the number(s) with the longest sequence length
for starting sequence numbers below 1000000 are:
Iterations = %i and sequence-starts = %s.''' % (lenmax, allstarts) )
print ( '''
Note that only the first of any sequences with the same digits is printed below.
(The others will differ only in their first term)''' )
for n in starts:
print()
A036058_length(str(n), printit=True)

View file

@ -0,0 +1,12 @@
ls:{raze(string 1_ deltas d,count x),'x d:where differ x} / look & say
sumsay:ls desc@ / summarize & say
seeds:group desc each string til 1000000 / seeds for million integers
seq:(key seeds)!30 sumsay\'key seeds / sequences for unique seeds
top:max its:(count distinct@)each seq / count iterations
/ report results
rpt:{1 x,": ",y,"\n\n";}
rpt["Seeds"]" "sv string raze seeds where its=top / all forms of top seed/s
rpt["Iterations"]string top
rpt["Sequence"]"\n\n","\n"sv raze seq where its=top

View file

@ -0,0 +1,34 @@
/*REXX pgm generates a self─referential sequence and displays sequences with max length.*/
parse arg LO HI . /*obtain optional arguments from the CL*/
if LO=='' | LO=="," then LO= 1 /*Not specified? Then use the default.*/
if HI=='' | HI=="," then HI=1000000 - 1 /* " " " " " " */
max$=; seeds=; maxL=0 /*inialize some defaults and counters. */
do #=LO to HI; n=#; @.=0; @.#=1 /*loop thru seed; define some defaults.*/
$=n
do c=1 until x==n; x=n /*generate a self─referential sequence.*/
n=; do k=9 by -1 for 10 /*generate a new sequence (downwards). */
_=countstr(k, x) /*obtain the number of sequence counts.*/
if _\==0 then n=n || _ || k /*is count > zero? Then append it to N*/
end /*k*/
if @.n then leave /*has sequence been generated before ? */
$=$'-'n; @.n=1 /*add the number to sequence and roster*/
end /*c*/
if c==maxL then do; seeds=seeds # /*is the sequence equal to max so far ?*/
max$=max$ $ /*append this self─referential # to $ */
end
else if c>maxL then do; seeds=# /*use the new number as the new seed. */
maxL=c; max$=$ /*also, set the new maximum L; max seq.*/
end /* [↑] have we found a new best seq ? */
end /*#*/
say ' seeds that had the most iterations: ' seeds
say 'the maximum selfreferential length: ' maxL
do j=1 for words(max$) ; say
say copies('',30) "iteration sequence for: " word(seeds,j) ' ('maxL "iterations)"
q=translate( word( max$, j), ,'-')
do k=1 for words(q); say word(q, k)
end /*k*/
end /*j*/ /*stick a fork in it, we're all done. */

View file

@ -0,0 +1,36 @@
#lang racket
(define (next s)
(define v (make-vector 10 0))
(for ([c s])
(define d (- (char->integer #\9) (char->integer c)))
(vector-set! v d (add1 (vector-ref v d))))
(string-append* (for/list ([x v] [i (in-range 9 -1 -1)] #:when (> x 0))
(format "~a~a" x i))))
(define (seq-of s)
(reverse (let loop ([ns (list s)])
(define n (next (car ns)))
(if (member n ns) ns (loop (cons n ns))))))
(define (sort-string s)
(list->string (sort (string->list s) char>?)))
(define-values [len nums seq]
(for/fold ([*len #f] [*nums #f] [*seq #f])
([n (in-range 1000000 -1 -1)]) ; start at the high end
(define s (number->string n))
(define sorted (sort-string s))
(cond [(equal? s sorted)
(define seq (seq-of s))
(define len (length seq))
(cond [(or (not *len) (> len *len)) (values len (list s) seq)]
[(= len *len) (values len (cons s *nums) seq)]
[else (values *len *nums *seq)])]
;; not sorted: see if it's a permutation of the best
[else (values
*len
(if (and *nums (member sorted *nums)) (cons s *nums) *nums)
*seq)])))
(printf "Numbers: ~a\nLength: ~a\n" (string-join nums ", ") len)
(for ([n seq]) (printf " ~a\n" n))

View file

@ -0,0 +1,46 @@
my @list;
my $longest = 0;
my %seen;
for 1 .. 1000000 -> $m {
next unless $m ~~ /0/; # seed must have a zero
my $j = join '', $m.comb.sort;
next if %seen{$j}:exists; # already tested a permutation
%seen{$j} = '';
my @seq = converging($m);
my %elems;
my $count;
for @seq[] -> $value { last if ++%elems{$value} == 2; $count++; };
if $longest == $count {
@list.push($m);
}
elsif $longest < $count {
$longest = $count;
@list = $m;
print "\b" x 20, "$count, $m"; # monitor progress
}
};
for @list -> $m {
say "\nSeed Value(s): ", my $seeds = ~permutations($m).unique.grep( { .substr(0,1) != 0 } );
my @seq = converging($m);
my %elems;
my $count;
for @seq[] -> $value { last if ++%elems{$value} == 2; $count++; };
say "\nIterations: ", $count;
say "\nSequence: (Only one shown per permutation group.)";
.say for |@seq[^$count], "\n";
}
sub converging ($seed) { return $seed, -> $l { join '', map { $_.value.elems~$_.key }, $l.comb.classify({$^b}).sort: {-$^c.key} } ... * }
sub permutations ($string, $sofar? = '' ) {
return $sofar unless $string.chars;
my @perms;
for ^$string.chars -> $idx {
my $this = $string.substr(0,$idx)~$string.substr($idx+1);
my $char = substr($string, $idx,1);
@perms.push( |permutations( $this, join '', $sofar, $char ) );
}
return @perms;
}

View file

@ -0,0 +1,37 @@
$cache = {}
def selfReferentialSequence_cached(n, seen = [])
return $cache[n] if $cache.include? n
return [] if seen.include? n
digit_count = Array.new(10, 0)
n.to_s.chars.collect {|char| digit_count[char.to_i] += 1}
term = ''
9.downto(0).each do |d|
if digit_count[d] > 0
term += digit_count[d].to_s + d.to_s
end
end
term = term.to_i
$cache[n] = [n] + selfReferentialSequence_cached(term, [n] + seen)
end
limit = 1_000_000
max_len = 0
max_vals = []
1.upto(limit - 1) do |n|
seq = selfReferentialSequence_cached(n)
if seq.length > max_len
max_len = seq.length
max_vals = [n]
elsif seq.length == max_len
max_vals << n
end
end
puts "values: #{max_vals.inspect}"
puts "iterations: #{max_len}"
puts "sequence:"
selfReferentialSequence_cached(max_vals[0]).each_with_index do |val, idx|
puts "%2d %d" % [idx + 1, val]
end

View file

@ -0,0 +1,35 @@
import spire.math.SafeLong
import scala.annotation.tailrec
import scala.collection.parallel.immutable.ParVector
object SelfReferentialSequence {
def main(args: Array[String]): Unit = {
val nums = ParVector.range(1, 1000001).map(SafeLong(_))
val seqs = nums.map{ n => val seq = genSeq(n); (n, seq, seq.length) }.toVector.sortWith((a, b) => a._3 > b._3)
val maxes = seqs.takeWhile(t => t._3 == seqs.head._3)
println(s"Seeds: ${maxes.map(_._1).mkString(", ")}\nIterations: ${maxes.head._3}")
for(e <- maxes.distinctBy(a => nextTerm(a._1.toString))){
println(s"\nSeed: ${e._1}\n${e._2.mkString("\n")}")
}
}
def genSeq(seed: SafeLong): Vector[String] = {
@tailrec
def gTrec(seq: Vector[String], n: String): Vector[String] = {
if(seq.contains(n)) seq
else gTrec(seq :+ n, nextTerm(n))
}
gTrec(Vector[String](), seed.toString)
}
def nextTerm(num: String): String = {
@tailrec
def dTrec(digits: Vector[(Int, Int)], src: String): String = src.headOption match{
case Some(n) => dTrec(digits :+ ((n.asDigit, src.count(_ == n))), src.filter(_ != n))
case None => digits.sortWith((a, b) => a._1 > b._1).map(p => p._2.toString + p._1.toString).mkString
}
dTrec(Vector[(Int, Int)](), num)
}
}

View file

@ -0,0 +1,58 @@
;; Syntactic sugar for calling reduce-left
(defmacro reduce-with ((acc init item sequence) . body)
^(reduce-left (lambda (,acc ,item) ,*body) ,sequence ,init))
;; Macro similar to clojure's ->> and ->
(defmacro opchain (val . ops)
^[[chain ,*[mapcar [iffi consp (op cons 'op)] ops]] ,val])
;; Reduce integer to a list of integers representing its decimal digits.
(defun digits (n)
(if (< n 10)
(list n)
(opchain n tostring list-str (mapcar (op - @1 #\0)))))
(defun dcount (ds)
(digits (length ds)))
;; Perform a look-say step like (1 2 2) --"one 1, two 2's"-> (1 1 2 2).
(defun summarize-prev (ds)
(opchain ds copy (sort @1 >) (partition-by identity)
(mapcar [juxt dcount first]) flatten))
;; Take a starting digit string and iterate the look-say steps,
;; to generate the whole sequence, which ends when convergence is reached.
(defun convergent-sequence (ds)
(reduce-with (cur-seq nil ds [giterate true summarize-prev ds])
(if (member ds cur-seq)
(return-from convergent-sequence cur-seq)
(nconc cur-seq (list ds)))))
;; A candidate sequence is one which begins with montonically
;; decreasing digits. We don't bother with (9 0 9 0) or (9 0 0 9);
;; which yield identical sequences to (9 9 0 0).
(defun candidate-seq (n)
(let ((ds (digits n)))
(if [apply >= ds]
(convergent-sequence ds))))
;; Discover the set of longest sequences.
(defun find-longest (limit)
(reduce-with (max-seqs nil new-seq [mapcar candidate-seq (range 1 limit)])
(let ((cmp (- (opchain max-seqs first length) (length new-seq))))
(cond ((> cmp 0) max-seqs)
((< cmp 0) (list new-seq))
(t (nconc max-seqs (list new-seq)))))))
(defvar *results* (find-longest 1000000))
(each ((result *results*))
(flet ((strfy (list) ;; (strfy '((1 2 3 4) (5 6 7 8))) -> ("1234" "5678")
(mapcar [chain (op mapcar tostring) cat-str] list)))
(let* ((seed (first result))
(seeds (opchain seed perm uniq (remove-if zerop @1 first))))
(put-line `Seed value(s): @(strfy seeds)`)
(put-line)
(put-line `Iterations: @(length result)`)
(put-line)
(put-line `Sequence: @(strfy result)`))))

View file

@ -0,0 +1,27 @@
(defun count-and-say (str)
(let* ((s [sort (copy-str str) <])
(out `@[s 0]0`))
(each ((x s))
(if (eql x [out -1])
(inc [out -2])
(set out `@{out}1@x`)))
out))
(defun ref-seq-len (n : doprint)
(let ((s (tostring n)) hist)
(while t
(push s hist)
(if doprint (pprinl s))
(set s (count-and-say s))
(each ((item hist)
(i (range 0 2)))
(when (equal s item)
(return-from ref-seq-len (length hist)))))))
(defun find-longest (top)
(let (nums (len 0))
(each ((x (range 0 top)))
(let ((l (ref-seq-len x)))
(when (> l len) (set len l) (set nums nil))
(when (= l len) (push x nums))))
(list nums len)))

View file

@ -0,0 +1,46 @@
;; Macro very similar to Racket's for/fold
(defmacro for-accum (accum-var-inits each-vars . body)
(let ((accum-vars [mapcar first accum-var-inits])
(block-sym (gensym))
(next-args [mapcar (ret (progn @rest (gensym))) accum-var-inits])
(nvars (length accum-var-inits)))
^(let ,accum-var-inits
(flet ((iter (,*next-args)
,*[mapcar (ret ^(set ,@1 ,@2)) accum-vars next-args]))
(each ,each-vars
,*body)
(list ,*accum-vars)))))
(defun next (s)
(let ((v (vector 10 0)))
(each ((c s))
(inc [v (- #\9 c)]))
(cat-str
(collect-each ((x v)
(i (range 9 0 -1)))
(when (> x 0)
`@x@i`)))))
(defun seq-of (s)
(for* ((ns ()))
((not (member s ns)) (reverse ns))
((push s ns) (set s (next s)))))
(defun sort-string (s)
[sort (copy s) >])
(tree-bind (len nums seq)
(for-accum ((*len nil) (*nums nil) (*seq nil))
((n (range 1000000 0 -1))) ;; start at the high end
(let* ((s (tostring n))
(sorted (sort-string s)))
(if (equal s sorted)
(let* ((seq (seq-of s))
(len (length seq)))
(cond ((or (not *len) (> len *len)) (iter len (list s) seq))
((= len *len) (iter len (cons s *nums) seq))))
(iter *len
(if (and *nums (member sorted *nums)) (cons s *nums) *nums)
*seq))))
(put-line `Numbers: @{nums ", "}\nLength: @len`)
(each ((n seq)) (put-line ` @n`)))

View file

@ -0,0 +1,49 @@
proc nextterm n {
foreach c [split $n ""] {incr t($c)}
foreach c {9 8 7 6 5 4 3 2 1 0} {
if {[info exist t($c)]} {append r $t($c) $c}
}
return $r
}
# Local context of lambda term is just for speed
apply {limit {
# Build a digit cache; this adds quite a bit of speed
set done [lrepeat [set l2 [expr {$limit * 100}]] 0]
# Iterate over search space
set maxlen 0
set maxes {}
for {set i 0} {$i < $limit} {incr i} {
if {[lindex $done $i]} continue
# Compute the sequence length for this value (with help from cache)
set seq {}
for {set seed $i} {$seed ni $seq} {set seed [nextterm $seed]} {
if {$seed < $l2 && [lindex $done $seed]} {
set len [expr {[llength $seq] + [lindex $done $seed]}]
break
}
set len [llength [lappend seq $seed]]
}
# What are we going to do about it?
if {$len > $maxlen} {
set maxlen $len
set maxes [list $i]
} elseif {$len == $maxlen} {
lappend maxes $i
}
# Update the cache with what we have learned
foreach n $seq {
if {$n < $l2} {lset done $n $len}
incr len -1
}
}
# Output code
puts "max length: $maxlen"
foreach c $maxes {puts $c}
puts "Sample max-len sequence:"
set seq {}
# Rerun the sequence generator for printing; faster for large limits
for {set seed [lindex $c 0]} {$seed ni $seq} {set seed [nextterm $seed]} {
lappend seq $seed
puts "\t$seed"
}
}} 1000000

View file

@ -0,0 +1,71 @@
import "/seq" for Lst
import "/math" for Nums
var limit = 1e6
var selfRefSeq = Fn.new { |s|
var sb = ""
for (d in "9876543210") {
if (s.contains(d)) {
var count = s.count { |c| c == d }
sb = sb + "%(count)%(d)"
}
}
return sb
}
var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
var perms = []
var toInsert = input[0]
for (perm in permute.call(input[1..-1])) {
for (i in 0..perm.count) {
var newPerm = perm.toList
newPerm.insert(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
var sieve = List.filled(limit, 0)
var elements = []
for (n in 1...limit) {
if (sieve[n] == 0) {
elements.clear()
var next = n.toString
elements.add(next)
while (true) {
next = selfRefSeq.call(next)
if (elements.contains(next)) {
var size = elements.count
sieve[n] = size
if (n > 9) {
var perms = permute.call(n.toString.toList).map { |p| p.join("") }.toList
perms = Lst.distinct(perms)
for (perm in perms) {
if (perm[0] != "0") {
var k = Num.fromString(perm.join(""))
sieve[k] = size
}
}
}
break
}
elements.add(next)
}
}
}
var maxIterations = Nums.max(sieve)
for (n in 1...limit) {
if (sieve[n] >= maxIterations) {
System.print("%(n) -> Iterations = %(maxIterations)")
var next = n.toString
for (i in 1..maxIterations) {
System.print(next)
next = selfRefSeq.call(next)
}
System.print()
}
}

View file

@ -0,0 +1,32 @@
N:=0d1_000_001;
fcn lookAndJustSaying(seed){ // numeric String --> numeric String
"9876543210".pump(String,'wrap(n){
(s:=seed.inCommon(n)) and String(s.len(),n) or ""
});
}
fcn sequence(seed){ // numeric string --> sequence until it repeats
seq:=L();
while(not seq.holds(seed)){ seq.append(seed); seed=lookAndJustSaying(seed); }
seq
}
fcn decending(str) //--> True if digits are in descending (or equal) order
{ (not str.walker().zipWith('<,str[1,*]).filter1()) }
szs:=List.createLong(25); max:=0;
foreach seed in (N){
z:=seed.toString();
if(decending(z)){ // 321 generates same sequence as 312,132,123,213
len:=sequence(z).len();
if(len>max) szs.clear();
if(len>=max){ szs.append(seed.toString()); max=len; }
}
}
// List permutations of longest seeds
// ("9900"-->(((9,0,0,9),...))-->((9,0,0,9),...)-->("9009"...)
// -->remove numbers w/leading zeros-->remove dups
zs:=szs.apply(Utils.Helpers.permute).flatten().apply("concat")
.filter(fcn(s){ s[0]!="0" }) : Utils.Helpers.listUnique(_);
println(max," iterations for ",zs.concat(", "));
zs.pump(Console.println,sequence,T("concat",", "));