Last active
July 6, 2021 13:29
-
-
Save TakashiHarada/d1120f0658bc41ab1cd06b2bafe8c8bb to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(define rember-f | |
(lambda (test? a l) | |
(cond | |
((null? l) (quote ())) | |
((test? (car l) a) (rember-f test? a (cdr l))) | |
(else (cons (car l) (rember-f test? a (cdr l))))))) | |
(rember-f = 5 '(6 2 5 3)) | |
(rember-f eq? 'jelly '(jelly beans are good)) | |
(define eq?-c | |
(lambda (a) | |
(lambda (x) | |
(eq? x a)))) | |
(define eq?-salad (eq?-c 'salad)) | |
(eq?-salad 'salad) | |
(eq?-salad 'tuna) | |
(define rember-f | |
(lambda (test?) | |
(lambda (a l) | |
(cond | |
((null? l) (quote ())) | |
((test? (car l) a) (cdr l)) | |
(else (cons (car l) ((rember-f test?) a (cdr l)))))))) | |
(define a 'eq?) | |
(define l '(= eq? / + *)) | |
((rember-f eq?) 'salad '(shrimp salad and tuna salad)) | |
((rember-f eq?) a l) | |
((rember-f eq?) 'eq? '(equal? eqan? eqlist? eqpair?)) | |
(define insertL-f | |
(lambda (test?) | |
(lambda (new old l) | |
(cond | |
((null? l) (quote ())) | |
((test? (car l) old) (cons new l)) | |
(else (cons (car l) ((insertL-f test?) new old (cdr l)))))))) | |
(define insertR-f | |
(lambda (test?) | |
(lambda (new old l) | |
(cond | |
((null? l) (quote ())) | |
((test? (car l) old) (cons old (cons new (cdr l)))) | |
(else (cons (car l) ((insertR-f test?) new old (cdr l)))))))) | |
;; (define insert-g | |
;; (lambda (test? direction) | |
;; (lambda (new old l) | |
;; (cond | |
;; ((test? (car l) old) | |
;; (cond | |
;; ((eq? direction 'L) (cons new l)) | |
;; (else (cons old (cons new (cdr l)))))) | |
;; (else (cons (car l)) ((insert-g test? direction) new old (cdr l))))))) | |
(define seqL | |
(lambda (new old l) | |
(cons new (cons old l)))) | |
(define seqR | |
(lambda (new old l) | |
(cons old (cons new l)))) | |
(define insert-g | |
(lambda (seq) | |
(lambda (new old l) | |
(cond | |
((null? l) (quote ())) | |
((eq? (car l) old) (seq new old (cdr l))) | |
(else | |
((insert-g seq) new old (cdr l))))))) | |
;; (define insertL (insert-g seqL)) | |
;; (define insertR (insert-g seqR)) | |
(define insertL | |
(insert-g | |
(lambda (new old l) | |
(cons new l)))) | |
(define insertR | |
(insert-g | |
(lambda (new old l) | |
(cons old (cons new (cdr l)))))) | |
(define seqS | |
(lambda (new old l) | |
(cons new l))) | |
(define subst | |
(insert-g seqS)) | |
(define atom-to-function | |
(lambda (x) | |
(cond | |
((eq? x (quote +)) +) | |
((eq? x (quite *)) *) | |
(else expt)))) | |
(define operator | |
(lambda (aexp) | |
(car aexp))) | |
(define 1st-sub-exp | |
(lambda (nexp) | |
(cdr (car nexp)))) | |
(define 2nd-sub-exp | |
(lambda (nexp) | |
(cdr (car nexp)))) | |
(define atom? | |
(lambda (x) | |
(and (not (pair? x)) (not (null? x))))) | |
(define value | |
(lambda (nexp) | |
(cond | |
((atom? nexp) nexp) | |
(else | |
((atom-to-function (operator nexp)) | |
(value (1st-sub-exp nexp)) | |
(value (2nd-sub-exp nexp))))))) | |
;; (atom-to-function (operator '(+ 5 3))) | |
(value (expt 2 (+ (+ 3 5) (expt 2 3)))) | |
;; (define twice | |
;; (lambda (f) | |
;; (lambda (x) (f (f x))))) | |
;; (define p3 | |
;; (lambda (x) (+ 3 x))) | |
;; ((twice p3) 10) | |
(define multirember-f | |
(lambda (test?) | |
(lambda (a lat) | |
(cond | |
((null? lat) (quote ())) | |
((test? (car lat) a) ((multirember-f test?) a (cdr lat))) | |
(else (cons (car lat) ((multirember-f test?) a (cdr lat)))))))) | |
((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)) | |
(define eq?-tuna | |
(eq?-c (quote tuna))) | |
(define multiremberT | |
(lambda (test? lat) | |
(cond | |
((null? lat) (quote ())) | |
((test? (car lat)) (multiremberT test? (cdr lat))) | |
(else | |
(cons (car lat) (multiremberT test? (cdr lat))))))) | |
(multiremberT eq?-tuna '(shrimp salad tuna salad and tuna)) | |
(define multirember&co | |
(lambda (a lat col) | |
(cond | |
((null? lat) (col (quote ()) (quote ()))) | |
((eq? (car lat) a) | |
(multirember&co a | |
(cdr lat) | |
(lambda (newlat seen) | |
(col newlat (cons (car lat) seen))))) | |
(else | |
(multirember&co a | |
(cdr lat) | |
(lambda (newlat seen) | |
(col (cons (car lat) newlat) seen))))))) | |
(define a-friend | |
(lambda (x y) | |
(null? y))) | |
(multirember&co 'tuna '(tuna) a-friend) | |
;; (define col a-friend) | |
;; (define new-friend | |
;; (lambda (newlat seen) | |
;; (col newlat (cons (car lat) seen)))) | |
(define new-friend | |
(lambda (newlat seen) | |
(a-friend newlat (cons (quote tuna) seen)))) | |
(define latest-friend | |
(lambda (newlat seen) | |
(a-friend (cons (quote and) newlat) seen))) | |
(define last-friend | |
(lambda (x y) (length x))) | |
(multirember&co 'tuna '(strawberries tuna and swordfish) last-friend) | |
;; (lambda (newlat seen) (col newlat (cons (car lat) seen))) ;; match | |
;; (lambda (newlat seen) (col (cons (car lat) newlat) seen)) ;; else | |
(define multirember&co | |
(lambda (a lat col) | |
(cond | |
((null? lat) (col (quote ()) (quote ()))) | |
((eq? (car lat) a) | |
(multirember&co a | |
(cdr lat) | |
(lambda (newlat seen) | |
(col newlat (cons (car lat) seen))))) | |
(else | |
(multirember&co a | |
(cdr lat) | |
(lambda (newlat seen) | |
(col (cons (car lat) newlat) seen))))))) | |
;; (multirember&co 'tuna '(strawberries tuna and swordfish) last-friend) | |
;; (multirember&co 'tuna | |
;; '(tuna and swordfish) | |
;; (lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen))) | |
;; (multirember&co 'tuna | |
;; '(tuna and swordfish) | |
;; (lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen))) | |
;; (multirember&co 'tuna | |
;; '(and swordfish) | |
;; (lambda (newlat1 seen1) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; newlat1 (cons 'tuna seen1)))) | |
;; (multirember&co 'tuna | |
;; '(swordfish) | |
;; (lambda (newlat2 seen2) | |
;; ((lambda (newlat1 seen1) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; newlat1 (cons 'tuna seen1))) | |
;; (cons 'and newlat2) seen2))) | |
;; (multirember&co 'tuna | |
;; '() | |
;; (lambda (newlat3 seen3) | |
;; ((lambda (newlat2 seen2) | |
;; ((lambda (newlat1 seen1) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; newlat1 (cons 'tuna seen1))) | |
;; (cons 'and newlat2) seen2)) | |
;; (cons 'swordfish newlat3) seen3))) | |
;; ((lambda (newlat3 seen3) | |
;; ((lambda (newlat2 seen2) | |
;; ((lambda (newlat1 seen1) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; newlat1 (cons 'tuna seen1))) | |
;; (cons 'and newlat2) seen2)) | |
;; (cons 'swordfish newlat3) seen3)) (quote ()) (quote ())) | |
;; ((lambda (newlat2 seen2) | |
;; ((lambda (newlat1 seen1) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; newlat1 (cons 'tuna seen1))) | |
;; (cons 'and newlat2) seen2)) | |
;; (cons 'swordfish (quote ())) (quote ())) | |
;; ((lambda (newlat1 seen1) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; newlat1 (cons 'tuna seen1))) | |
;; (cons 'and '(swordfish)) (quote ())) | |
;; ((lambda (newlat seen) | |
;; (last-friend (cons 'strawberries newlat) seen)) | |
;; (cons 'and '(swordfish)) (cons 'tuna (quote ()))) | |
;; (last-friend (cons 'strawberries (cons 'and '(swordfish))) '(tuna)) | |
(define multiinsertLR | |
(lambda (new oldL oldR lat) | |
(cond | |
((null? lat) (quote ())) | |
((eq? (car lat) oldL) | |
(cons new (cons oldL (multiinsertLR new oldL oldR (cdr lat))))) | |
((eq? (car lat) oldR) | |
(cons oldR (cons new (multiinsertLR new oldL oldR (cdr lat))))) | |
(else | |
(cons (car lat) (multiinsertLR new oldL oldR (cdr lat))))))) | |
(define multiinsertLR&co | |
(lambda (new oldL oldR lat col) | |
(cond | |
((null? lat) (col (quote ()) 0 0)) | |
((eq? (car lat) oldL) | |
(multiinsertLR&co new oldL oldR (cdr lat) | |
(lambda (newlat L R) | |
(col (cons new (cons oldL newlat)) (+ 1 L) R)))) | |
((eq? (car lat) oldR) | |
(multiinsertLR&co new oldL oldR (cdr lat) | |
(lambda (newlat L R) | |
(col (cons oldR (cons new newlat)) L (+ 1 R))))) | |
(else | |
(multiinsertLR&co new oldL oldR (cdr lat) | |
(lambda (newlat L R) | |
(col (cons (car lat) newlat) L R))))))) | |
(define new 'salty) | |
(define oldL 'fish) | |
(define oldR 'chips) | |
(define lat '(chips and fish or fish and chips)) | |
(multiinsertLR&co new oldL oldR lat (lambda (lat- l r) (cons lat- (cons l (cons r '()))))) | |
;; (define div | |
;; (lambda (n m) | |
;; (cond | |
;; ((< 1 n) 0) | |
;; (else (+ (div (n- | |
(define evens-only* | |
(lambda (l) | |
(cond | |
((null? l) (quote ())) | |
((atom? (car l)) | |
(cond | |
((even? (car l)) (cons (car l) (evens-only* (cdr l)))) | |
(else (evens-only* (cdr l))))) | |
(else | |
(cons (evens-only* (car l)) (evens-only* (cdr l))))))) | |
(evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)) | |
(define evens-only*&co | |
(lambda (l col) | |
(cond | |
((null? l) (col (quote ()) 1 0)) | |
((atom? (car l)) | |
(cond | |
((even? (car l)) | |
(evens-only*&co (cdr l) | |
(lambda (newl p s) | |
(col (cons (car l) newl) (* (car l) p) s)))) | |
(else | |
(evens-only*&co (cdr l) | |
(lambda (newl p s) | |
(col newl p (+ (car l) s))))))) | |
(else | |
(evens-only*&co (car l) | |
(lambda (al ap as) | |
(evens-only*&co (cdr l) | |
(lambda (dl dp ds) | |
(col (cons al dl) | |
(* ap dp) | |
(+ as ds)))))))))) | |
(define the-last-friend | |
(lambda (newl product sum) (cons sum (cons product newl)))) | |
(evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2) the-last-friend) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment