Summarize and say sequence: Difference between revisions

<lang txr>@(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)))))

(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`)))</lang>