Re: TSS rember1*

• vallog: TSS rember1*
• vallog: TSS rember1*, let/cc, try

もっとカッコよく書けないのかなーと思いながら。

	;; rember1*
	(define (rember1* a tree)
	(cond ((null? tree) '())
	((list? (car tree))
	(let ((ret (rember1* a (car tree))))
	(cons ret (if (equal? ret (car tree))
	(rember1* a (cdr tree))
	(cdr tree)))))
	((eq? a (car tree))(cdr tree))
	(else (cons (car tree)
	(rember1* a (cdr tree))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(if (null? tree)
	'()
	(let ((ar (car tree))
	(dr (cdr tree)))
	(cond ((list? ar)
	(let ((r (rember1* a ar)))
	(cons r (if (equal? r ar)
	(rember1* a dr)
	dr))))
	((eq? a ar) dr)
	(else (cons ar
	(rember1* a dr)))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(if (null? tree)
	'()
	(let ((ar (car tree))
	(dr (cdr tree)))
	(if (eq? a ar)
	dr
	(let ((r (if (list? ar)
	(rember1* a ar)
	ar)))
	(cons r (if (equal? r ar)
	(rember1* a dr)
	dr)))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(if (null? tree)
	'()
	(let ((ar (car tree))
	(dr (cdr tree))
	(r1* (pa$ rember1* a)))
	(if (eq? a ar)
	dr
	(let ((r (if (list? ar)
	(r1* ar)
	ar)))
	(cons r (if (equal? r ar)
	(r1* dr)
	dr)))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(if (null? tree)
	'()
	(let ((ar (car tree))
	(dr (cdr tree))
	(term (lambda (pred x)
	(if pred
	(rember1* a x)
	x))))
	(if (eq? a ar)
	dr
	(let ((r (term (list? ar) ar)))
	(cons r (term (equal? r ar) dr)))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(if (null? tree)
	'()
	(let ((f (lambda (pred x)
	(if (pred (car tree))
	(rember1* a x)
	x))))
	(if (eq? a (car tree))
	(cdr tree)
	(let ((r (f list? (car tree))))
	(cons r (f (pa$ equal? r)(cdr tree))))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(let ((f (lambda (pred x)
	(if (pred (car tree))
	(rember1* a x)
	x))))
	(if (null? tree)
	'()
	(if (eq? a (car tree))
	(cdr tree)
	(let ((r (f list? (car tree))))
	(cons r (f (pa$ equal? r)(cdr tree))))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree)
	(let ((f (lambda (pred x)
	(if (pred (car tree))
	(rember1* a x)
	x))))
	(cond ((null? tree) '())
	((eq? a (car tree))(cdr tree))
	(else (let ((r (f list? (car tree))))
	(cons r (f (pa$ equal? r)(cdr tree))))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))))
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))
	(define (rember1* a tree . rest)
	(let-optionals* rest ((eqp eq?))
	(let ((f (lambda (pred x)
	(if (pred (car tree))
	(rember1* a x)
	x))))
	(cond ((null? tree) '())
	((eqp a (car tree))(cdr tree))
	(else (let ((r (f list? (car tree))))
	(cons r (f (pa$ equal? r)(cdr tree)))))))))
	(rember1* 5 '(1 2 (3 4 ()(1 2 3 4)(((5))) 6 7 8)(((5 6 () 5))(9 10))) eqv?)
	; -> (1 2 (3 4 () (1 2 3 4) ((())) 6 7 8) (((5 6 () 5)) (9 10)))

view raw rember1-rember1star.scm hosted with ❤ by GitHub

いくつか書いていれば何か思いつくかなー、と思いましたが思いつきませんでした。わかりにくくなった気がします。

• How To Become A Hacker: TSS rember1*

しかし、ホント The Seasoned Schemer のコードときたら・・・。。