47 lines
1.5 KiB
Plaintext
47 lines
1.5 KiB
Plaintext
;; 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`)))
|