2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -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
|
||||
|
|
@ -5,7 +5,7 @@ my %seen;
|
|||
for 1 .. 1000000 -> $m {
|
||||
next unless $m ~~ /0/; # seed must have a zero
|
||||
my $j = join '', $m.comb.sort;
|
||||
next if %seen.exists($j); # already tested a permutation
|
||||
next if %seen{$j}:exists; # already tested a permutation
|
||||
%seen{$j} = '';
|
||||
my @seq := converging($m);
|
||||
my %elems;
|
||||
|
|
@ -23,7 +23,7 @@ for 1 .. 1000000 -> $m {
|
|||
};
|
||||
|
||||
for @list -> $m {
|
||||
say "Seed Value(s): ", ~permutations($m).uniq.grep( { .substr(0,1) != 0 } );
|
||||
say "Seed Value(s): ", my $seeds = ~permutations($m).unique.grep( { .substr(0,1) != 0 } );
|
||||
my @seq := converging($m);
|
||||
my %elems;
|
||||
my $count;
|
||||
|
|
@ -41,7 +41,7 @@ sub permutations ($string, $sofar? = '' ) {
|
|||
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 ) ) ;
|
||||
@perms.push( |permutations( $this, join '', $sofar, $char ) );
|
||||
}
|
||||
return @perms;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,59 +1,58 @@
|
|||
@(do
|
||||
;; Syntactic sugar for calling reduce-left
|
||||
(defmacro reduce-with ((acc init item sequence) . body)
|
||||
^(reduce-left (lambda (,acc ,item) ,*body) ,sequence ,init))
|
||||
;; 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])
|
||||
;; 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)))))
|
||||
;; 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)))
|
||||
(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))
|
||||
;; 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)))))
|
||||
;; 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))))
|
||||
;; 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)))))))
|
||||
;; 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))
|
||||
(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)`)
|
||||
(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 `Sequence: @(strfy result)`)))))
|
||||
(put-line `Iterations: @(length result)`)
|
||||
(put-line)
|
||||
(put-line `Sequence: @(strfy result)`))))
|
||||
|
|
|
|||
|
|
@ -1,32 +1,27 @@
|
|||
@(do
|
||||
(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 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 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)))
|
||||
|
||||
(let ((r (find-longest 1000000)))
|
||||
(format t "Longest: ~a\n" r)
|
||||
(ref-seq-len (first (first r)) t)))
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -1,47 +1,46 @@
|
|||
@(do
|
||||
;; 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)))))
|
||||
;; 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 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 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) >])
|
||||
(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`)))
|
||||
(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`)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue