(define non (lambda (x) 'non))
(define id (lambda (x) x))
(define add1 (lambda (x) (+ x 1)))
(define sub1 (lambda (x) (- x 1)))
(define ++ (lambda (i) (+ i 1)))
(define -- (lambda (i) (- i 1)))
(define ** (lambda (a b) (expt a b)))
(define // (lambda (a b) (quotient a b)))
(define /@ (lambda (a b) (remainder a b)))
(define /: (lambda (a b) (modulo a b)))
(define make-even (lambda (n) (* 2 n)))
(define make-odd (lambda (n) (+ (make-even n) 1)))
(define parity-of (lambda (p) (if(odd? p) -1 1)))
(define swap-test (lambda (a b) (** a b)))
(define swap-test (lambda (a b) (let* ((dummy a) (a b) (b dummy))(** a b))))
(define adjust-of (lambda (x) (let ((digit 100) (slide (if (positive? x) 1/2 -1/2))) (/ (truncate (+ slide (* digit x))) digit) )))
(define iota (lambda (min max) (if (> min max) '() (cons min (iota (++ min) max)) )))
(define iota-reverse
(lambda (min max)
(if (> min max)
'()
(cons max (iota-reverse min (-- max))) )))
(define iota
(lambda (min max)
(let iota-loop ((i max) (tmp '()))
(if (< i min)
tmp
(iota-loop (-- i) (cons i tmp)) ))))
(define iota-reverse
(lambda (min max)
(let iota-loop ((i min) (tmp '()))
(if (> i max)
tmp
(iota-loop (++ i) (cons i tmp)) ))))
(define iota
(lambda (max . opt)
(let* ((min (if (null? opt) 1 (car opt)))
(step (if (or (null? opt) (null? (cdr opt))) 1 (cadr opt)))
(dummy max)
(max (if (null? opt) max min))
(min (if (null? opt) min dummy)))
(let loop ((i (- min step)) (tmp '()))
(if (< (- max step) i)
(reverse tmp)
(loop (+ i step)
(cons (adjust-of (+ i step)) tmp)) )))))
(define iota
(lambda lst
(let* ((x (length lst))
(max (if (= 1 x) (car lst) (cadr lst)))
(min (if (< 1 x) (car lst) 1))
(step (if (= 3 x) (caddr lst) 1)))
(let loop ((i (- min step)) (tmp '()))
(if (< (- max step) i)
(reverse tmp)
(loop (+ i step)
(cons (adjust-of (+ i step)) tmp)) )))))
(define succ (lambda (list) (cons 1 list)))
(define pred (lambda (list) (cdr list)))
(define plus
(lambda (x y)
(if (null? y)
x
(succ (plus x (pred y))) )))
(define plus-num
(lambda (x y)
(if (zero? y)
x
(add1 (plus-num x (sub1 y))) )))
(define mult
(lambda (x y)
(if (null? y)
'()
(plus x (mult x (pred y))) )))
(define pows
(lambda (x y)
(if (null? y)
'(1)
(mult x (pows x (pred y))) )))
(define kakko
(lambda (i)
(if (zero? i)
(list)
(append (list (kakko (-- i)))
(kakko (-- i))) )))
(define plus
(lambda (x y)
(if (zero? y)
x
(+ 1 (plus x (- y 1))))))
(define mult (lambda (x y)
(if (zero? y)
0
(+ x (mult x (- y 1))))))
(define pows
(lambda (x y)
(if (zero? y)
1
(* x (pows x (- y 1))))))
(define plus-iter
(lambda (x y p)
(if (zero? y)
(+ x p)
(plus-iter x (- y 1) (+ p 1)) )))
(define plus-tailrec
(lambda (x y)
(define plus-iter
(lambda (x y p)
(if(zero? y)
(+ x p)
(plus-iter x (- y 1) (+ p 1)) )))
(plus-iter x y 0)))
(define mult-tailrec
(lambda (x y)
(define mult-iter
(lambda (x y p)
(if (zero? y)
p
(mult-iter x (- y 1) (+ x p))) ))
(mult-iter x y 0)))
(define pows-tailrec
(lambda (x y)
(define pows-iter
(lambda (x y p)
(if (zero? y)
p
(pows-iter x (- y 1) (* x p))) ))
(pows-iter x y 1)))
(define sq
(lambda (x)
(* x x) ))
(define sq**
(lambda (b n)
(cond ((zero? n) 1)
((even? n) (sq (sq** b (/ n 2))))
((odd? n) (* b (sq** b (- n 1))) ))))
(define sq**-tailrec
(lambda (b n)
(define sq**-iter
(lambda (b n p)
(cond ((zero? n) p)
((even? n) (sq**-iter (* b b) (/ n 2) p))
((odd? n) (sq**-iter b (- n 1) (* b p)) ))))
(sq**-iter b n 1)))
(define fact
(lambda (n)
(if (zero? n)
1
(* n (fact (- n 1))))))
(define fact-tailrec
(lambda (n)
(define fact-iter
(lambda (y p)
(if (zero? y)
p
(fact-iter (- y 1) (* y p))) ))
(fact-iter n 1)))
(define fact-let
(lambda (n)
(let countdown ((y n) (p 1))
(if (zero? y)
p
(countdown (- y 1) (* y p)) ))))
(define fact-do
(lambda (n)
(do ((y n (- y 1)) (p 1 (* y p)))
((zero? y) p)
(display p) (display " ") )))
(define fact-do
(lambda (n)
(do ((y n (- y 1)) (p 1 (* y p)))
((zero? y) p) )))
(define id-updown
(lambda (lst)
(if (null? lst)
'()
(cons (car lst)
(id-updown (cdr lst))) )))
(define length
(lambda (lst)
(if (null? lst)
0
(+ 1 (length (cdr lst))) )))
(define list-head
(lambda (lst n)
(if (zero? n)
'()
(cons (car lst)
(list-head (cdr lst) (- n 1))) )))
(define last-pair
(lambda (lst)
(list (list-ref lst (- (length lst) 1))) ))
(define last-pair
(lambda (lst)
(if (null? (cdr lst))
lst
(last-pair (cdr lst)) )))
(define nonpair?
(lambda (x)
(not (pair? x))))
(define id-all
(lambda (lst)
(if (nonpair? lst)
lst
(cons (id-all (car lst))
(id-all (cdr lst))) )))
(define length-all
(lambda (lst)
(cond ((null? lst) 0)
((nonpair? lst) 1)
(else (+ (length-all (car lst))
(length-all (cdr lst)) )))))
(define reverse-all
(lambda (lst)
(if (nonpair? lst)
lst
(append (reverse-all (cdr lst))
(list (reverse-all (car lst))) ))))
(define flatten
(lambda (lst)
(cond ((null? lst) '())
((pair? lst)
(append (flatten (car lst))
(flatten (cdr lst))))
(else (list lst)))))
(define num0-9 (iota 0 9))
(define num1-9 (iota 1 9))
(define filter
(lambda (predi lst)
(cond ((null? lst) '())
((predi (car lst))
(cons (car lst)
(filter predi (cdr lst))))
(else (filter predi (cdr lst))) )))
(define remove
(lambda (predi lst)
(cond ((null? lst) '())
((predi (car lst))
(remove predi (cdr lst)))
(else (cons (car lst)
(remove predi (cdr lst)))) )))
(define target?
(lambda (proc x)
(lambda (y) (proc y x))))
(define flatmap
(lambda (proc lst)
(apply append (map proc lst))))
(define (double n)
(apply append
(map (lambda (i)
(map (lambda (j) (list i j))
(iota (- i 1)) ))
(iota n) )))
(define sq+ (lambda (i j) (+ (sq i) (sq j))))
(define (triple n)
(apply append
(map (lambda (i)
(map (lambda (j)
(list (sq+ i j) i j))
(iota (- i 1)) ))
(iota n) )))
(define dismap
(lambda (proc dlst)
(map (lambda (x) (map proc x)) dlst)))
(define call/cc call-with-current-continuation)
-
- 与えた処理においてxで指定したところの値を呼び出している
> (call/cc (lambda (x) (x (* 7 (+ 3 5 )))))
56
> (call/cc (lambda (x) (* (x 7) (+ 3 5))))
7
> (call/cc (lambda (x) (* 7 (x (+ 3 5)))))
8
> (call/cc (lambda (x) (* 7 (+ (x 3) 5))))
3
> (call/cc (lambda (x) (* 7 (+ 3 (x 5)))))
5
- call/ccを使って順列を作る。順列は、ある要素で出来た順列に、その順列に含まれていない要素をつないで作る
> (permutations '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
> (permutations '("a" "b" "c"))
(("a" "b" "c") ("a" "c" "b") ("b" "a" "c") ("b" "c" "a") ("c" "a" "b") ("c" "b" "a"))
> (length (permutations (iota 5)))
120
