れんしゅう

numdot.scm

(define (range low high)
  (if (> low high)
      ()
      (cons low (range (+ low 1) high))))

(define (flatmap func seq)
  (if (null? seq)
      ()
      (append (func (car seq)) (flatmap func (cdr seq)))))

(define (numdot n)
  (define (numdot-sub sets rest)
    (if (null? rest)
        (list sets)
        (flatmap (^(index)
            (numdot-sub (add-to-set sets index (car rest)) (cdr rest)))
          (range 0 (length sets)))))
  (define (add-to-set sets index x)
    (cond ((null? sets) (list (list x)))
          ((= 0 index)
            (cons (append (car sets) (list x)) (cdr sets)))
          (else
            (cons (car sets) (add-to-set (cdr sets) (- index 1) x)))))
  (numdot-sub () (range 1 n)))

(define (concat-as-string seq)
  (if (null? seq)
      ""
      (string-append (x->string (car seq)) (concat-as-string (cdr seq)))))

(define (sets->string sets)
  (cond ((null? sets) "")
        ((= 1 (length sets)) (concat-as-string (car sets)))
        (else
          (string-append
            (concat-as-string (car sets))
            "."
            (sets->string (cdr sets))))))

(define (print-numdot n)
  (map (^(sets) (print (sets->string sets))) (numdot n)))