なにはともあれ、遊び相手といったら彼だ。

なんで、こんなにいい男にいい相手がいないんだろう。
文字どおり十年ぶりに野球をした。大人はたまにキャッチボールをすべきだと思った。
(define-syntax tag-case
(syntax-rules (else)
((_ e0 (else e2 e3 ...)) (begin e2 e3 ...))
((_ e0 (e1 e2 e3 ...)) (if (equal? e0 e1) (begin e2 e3 ...)))
((_ e0 (e1 e2 e3 ...) c1 c2 ...)
(if (equal? e0 e1) (begin e2 e3 ...) (tag-case e0 c1 c2 ...)))))
(define (tagged-line-filter tagged-line)
(let ((tag (car tagged-line))
(str (cadr tagged-line)))
(tag-case tag
('column (column-filter str))
('verbatim (verbatim-filter str))
('table (table-filter str))
('numbered (numbered-filter str))
('itemized (itemized-filter str))
('enumerate (enumerate-filter str))
(else (default-filter str)))))
(define dice6
(make-probability-space
(list 1 2 3 4 5 6)
(lambda (w) (/ 1 6))))
dice6
=>
((1 . 0.16666666666666666) (2 . 0.16666666666666666) (3 . 0.16666666666666666)
(4 . 0.16666666666666666) (5 . 0.16666666666666666) (6 . 0.16666666666666666))
(define (even-pv w)
(if (even? w) 1 0))
((lead-distribution even-pv) dice6)
=> ((0 . 0.5) (1 . 0.5))
(variance dice6)
=> 2.9166666666666665
(variance ((lead-distribution even-pv) dice6))
=> 0.25
hisashim:mapcan おもしろいよな
shikano:破壊的ですよ
hisashim:いいんだよ、zip のフラットなのができるから
(compose (curry #'apply #'nconc) #'mapcar)
(define (my-mapcan fn . ls)
(apply append (apply map fn ls)))
##
#
##
#
#
## ## # # ### ###
# # # ## # # ## #
## ## # #
# # ## ##
# # # ## # # ## #
# # ## ## ### ###
(define (distinct? sets)
(= (length (apply lset-union = sets))
(* (length sets) (length (car sets)))))
(define (get-distinct-n set n)
(combinations-for-each
(lambda (s)
(if (distinct? s)
(begin (display s) (newline))))
set
n))
(get-distict-n valid-list 9)
(define (deep-rember item list)こんなふうな結果が得られる(昨日の定義では、末尾の3が残ってしまう)。
(cond ((null? list) '())
((not (pair? (car list)))
(if (equal? item (car list))
(cdr list)
(cons (car list) (deep-rember item (cdr list)))))
(else
(if (equal? item (caar list))
(append (cdar list) (cdr list))
(if (not (pair? (caar list)))
(cons (caar list) (deep-rember item (cons (cdar list) (cdr list))))
(deep-rember item
(append (caar list) (cdar list) (cdr list))))))))
gosh> (deep-rember 3 '(2 (1 4 ((((6))))) (3)))リスト同士を繋ぐときに append を使っているのは、deep-rember の結果として得られるリストにできるだけ nil を残さないため。nil があると、昨日定義した deep-equal? で、null? を終端条件に使えない。
(2 1 4 6 ())
(define (deep-equal? list1 list2)
(cond ((and (null? list1) (null? list2)) #t)
((equal? (deep-car list1) (deep-car list2))
(deep-equal? (deep-rember (deep-car list1) list1)
(deep-rember (deep-car list2) list2)))
(else #f)))
(define (deep-car list)
(cond ((null? list) '())
((not (pair? (car list))) (car list))
((null? (car list)) (deep-car (cdr list)))
(else (deep-car (car list)))))(define (deep-rember item list)
(cond ((null? list) '())
((not (pair? (car list)))
(if (equal? item (car list))
(cdr list)
(cons (car list) (deep-rember item (cdr list)))))
((null? (car list))
(list (car list) (deep-rember item (cdr list))))
(else
(if (equal? (deep-rember item (car list)) (car list))
(append (car list) (deep-rember item (cdr list)))
(append (deep-rember item (car list)) (cdr list))))))
dump -0f - /dev/hdb1 | restore xf -
install-mbr /dev/hda1
;; Iterative sum
(define (sum f a z)
(define (sum-iter i summed)
(if (> i z)
summed
(sum-iter (+ i 1) (+ summed (f i)))))
(sum-iter a 0))
(sum (lambda (x) x) 1 10)
=> 55
;; change coin iterative
(define (d k)
(cond ((= k 1) 1)
((= k 2) 5)
((= k 3) 10)
((= k 4) 25)
((= k 5) 50)))
(define (cc-iter a k)
(define (sum i summed)
(if (= i (- k 1))
summed
(sum (+ i 1)
(+ summed (cc-iter (- a (d (- k i))) (- k i))))))
(cond ((< a 0) 0)
((= k 1) 1)
(else (sum 0 1))))
(define (count-change-iter a)
(cc-iter a 5))
(count-change-iter 100)
=> 292
(define (d k)
(cond ((= k 1) 1)
((= k 2) 5)
((= k 3) 10)
((= k 4) 25)
((= k 5) 50)))
(define (sum-cc cc a k)
(cond ((< a 0) 0)
((or (= a 1) (= k 1)) 1)
(else (+ (cc (- a (d k)) k)
(sum-cc cc a (- k 1))))))
(define (cc a k)
(sum-cc cc a k))
(define (count-change a)
(cc a 5))
起床後、朝食をとりながら中国語の復習(30分)
↓
エウレカセブン(30分)
↓
掃除しながら中国語ヒアリング(1時間)
↓
プリキュア(30分)
↓
中国語(1時間30分)
↓
確率論の教科書を読む(2時間)
↓
メール書いたり(30分)
↓
昼食、昼寝(1時間30分)
↓
なぜかCプログラミング(3時間)
↓
ディナー(2時間)
↓
Cの続きをやって、終身(1時間)
現在の仕事をきちんとやりつつ資産運用
↓
並行して、未熟な技術のリハビリと習得(数学と英語とコンピュータサイエンスと中国語)
刺激メモ:必要ならUSへ行くことも検討すること
↓
転職または起業
fold proc 種 (x_1 x_2 ... x_n)
proc (x_n ... (proc x_1 種)...)
proc (...(proc 種 x_1) ... x_n)
gosh-rl> (fold / 128 '(8 4 2))
0.03125
Hugs.Base> foldl (/) 128 [8,4,2]
2.0
gosh-rl> (fold (lambda (x y) (/ y x)) 128 '(8 4 2))
2
Hugs.Base> foldl (\ x y -> 10 * x + y) 0 [1,2,3]
123
gosh-rl> (fold (lambda (x y) (+ (* 10 x) y)) 0 '(1 2 3))
60
(use gauche.uvector)
(use srfi-27)
(use math.mt-random)
;; make random vector
(define (make-random-vector! n)
(mt-random-fill-f64vector! (make-random-source) (make-f64vector n)))
(define (ith-random randoms i)
(f64vector-ref randoms i))
(define (ith-random-pair randoms i)
(list (ith-random randoms (* 2 i))
(ith-random randoms (+ (* 2 i) 1))))
;; rect as ((x0 x1) (y0 y1))
(define (point-inner-closed? point closed)
(and (< (car closed) point) (< point (cadr closed))))
(define (pair-inner-rects? pair rects) ; not cps !
(let ((rect (car rects)))
(if (null? (cdr rects))
(and (point-inner-closed? (car pair) (car rect))
(point-inner-closed? (cadr pair) (cadr rect)))
(or (pair-inner-rects? pair (list rect))
(pair-inner-rects? pair (cdr rects))))))
;; monte-carlo
;; area as '(rect1 rect2 ...)
(define (monte-carlo area n)
(let ((randoms (make-random-vector! (* 2 (+ n 1)))))
(let f ((i 0))
(if (> i n)
0
(if (pair-inner-rects? (ith-random-pair randoms i) area)
(+ (f (+ i 1)) 1)
(f (+ i 1)))))))
;; main
(define times 10000)
(define rect1 (list (list 0.0 0.2) (list 0.0 0.2)))
(define rect2 (list (list 0.1 0.3) (list 0.1 0.3)))
(define s1 (monte-carlo (list rect1) times))
(define s2 (monte-carlo (list rect2) times))
(define s1-and-s2 (monte-carlo (list rect1 rect2) times))
(display (< s1-and-s2 (+ s1 s2)))
=> #t
javascript:
var pageTitle=document.title;
var pageURL=document.URL;
var userSelection=document.getSelection();
function nomdic(cc){if(cc<10){cc='0'+cc};return cc};
var nowDate=new Date();
var yyyy=nowDate.getFullYear();
var mm=(nowDate.getMonth()+1);
var dd=nowDate.getDate();
var hh=nowDate.getHours();
var min=nowDate.getMinutes();
var ss=nowDate.getSeconds();
var howmName=yyyy+'-'+nomdic(mm)+'-'+nomdic(dd)+'-'+nomdic(hh)+nomdic(min)+nomdic(ss)+'.howm';
var howmDate=yyyy+'-'+nomdic(mm)+'-'+nomdic(dd);
var openWin=window.open('',howmName,'innerWidth=600,innerHeight=400,scrollbars,menubar');
openWin.document.writeln
(howmName + '<br/>= ' + 'URLメモ ' + pageTitle + '<br/>' + '['+howmDate+']' + ' <<< '
+ pageURL + '<br/><br/>' + userSelection); void(openWin.document.close());
quicksort [] = []
quicksort (x:xs) = quicksort [y | y <- xs, y<x ]
++ [x]
++ quicksort [y | y <- xs, y>=x]
(define (quicksort ls)
(if (null? ls)
'()
(append (quicksort (filter (lambda (x) (> (car ls) x)) (cdr ls)))
(list (car ls))
(quicksort (filter (lambda (x) (<= (car ls) x)) (cdr ls))))))
(define (quicksort/cps ls k)
(if (null? ls)
(k '())
(quicksort/cps (filter (lambda (x) (> (car ls) x)) (cdr ls))
(lambda (ls-lower)
(quicksort/cps (filter (lambda (x) (<= (car ls) x)) (cdr ls))
(lambda (ls-upper) (k (append ls-lower (list (car ls)) ls-upper))))))))
(use srfi-1)
;; 長方形は対角線の端点(にあるマス)で定義: ((x0 y0) (x1 y1))
;; ただし、 右上がりの対角線で定義 i.e. x0 <= x1, y0 <= y1
(define-syntax rect?
(syntax-rules ()
((_ rect ...)
(and (and (<= (caar rect) (caadr rect)) (<= (cadar rect) (cadadr rect))) ...))))
(define (expand-x from-ls to-ls)
(let ((xfrom (car from-ls)) (xto (car to-ls)) (yfrom (cadr from-ls)))
(map (lambda (x) (cons x yfrom))
(let f ((xcurrent xfrom))
(let ((xnext (+ xcurrent 1)))
(if (> xnext (+ xto 1))
'()
(cons xcurrent (f xnext))))))))
(define (expand-rect-diag from-ls to-ls)
(let ((x-ls (expand-x from-ls to-ls)) (yfrom (cadr from-ls)) (yto (cadr to-ls)))
(let* ((ycurrent yfrom) (ynext (+ ycurrent 1)))
(if (> ynext (+ yto 1))
'()
(append x-ls
(expand-rect-diag (list (car from-ls) ynext) to-ls))))))
(define (expand-rect rect-with-diag)
(let ((from-ls (car rect-with-diag)) (to-ls (cadr rect-with-diag)))
(expand-rect-diag from-ls to-ls)))
;; 長方形からなる領域の面積(=マスの数)
(define-syntax sumup-rect
(syntax-rules ()
((_ e1) (length (expand-rect e1)))
((_ e1 e2 ...)
(length (lset-union equal? (expand-rect e1) (expand-rect e2) ...)))))
;; 2つの長方形が交わってるかどうか
(define (intersect? rect1 rect2)
(if (rect? rect1 rect2)
(< (sumup-rect rect1 rect2) (+ (sumup-rect rect1) (sumup-rect rect2)))))
(define rect1 (list '(0 0) '(3 2)))
(define rect2 (list '(3 3) '(4 4)))
(define rect3 (list '(1 1) '(4 4)))
gosh-rl> (intersect? rect1 rect2)
#f
gosh-rl> (intersect? rect1 rect3)
#t
長方形A, Bの面積を|A|, |B|とする。
|S| =def ∫(x,y) {(x, y) ∈ A ∪ B} dxdy
|S| < |A| + |B| ⇒ A と Bは交わる
; lcar, lcdr, ltake は "Gauche リファレンスマニュアル" の例を流用
; http://www.shiro.dreamhost.com/scheme/gauche/man/gauche-refj_90.html#SEC94
(use srfi-1)
(define (lcar lis) ;; lazy car
(car (force lis)))
(define (lcdr lis) ;; lazy cdr
(cdr (force lis)))
(define (ltake lis n) ;; lazy take
(if (<= n 0) '() (cons (lcar lis) (ltake (lcdr lis) (- n 1)))))
(define (lfilter pred ls) ;; lazy filter. i know it's not cps.
(if (pred (lcar ls))
(cons (lcar ls) (delay (lfilter pred (lcdr ls))))
(lfilter pred (lcdr ls))))
(define (integers-above num)
(let mkls ((x num))
(delay (cons x (mkls (+ x 1))))))
(define primes
(let prime-list ((ls (integers-above 2)))
(cons (lcar ls)
(delay (prime-list (lfilter (lambda (x) (> (modulo x (lcar ls)) 0)) (lcdr ls)))))))
gosh> (ltake primes 25)
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
primes = sieve [2..]
where sieve (s:ss) = s:sieve (filter (\x -> x `mod` s > 0) ss)
Main> take 25 pimes
[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
(let prime-list ((ls '(2 3 4 5 6 7 8 9 10 11 12)))
(if (null? ls)
()
(cons (car ls)
(prime-list (filter (lambda (x) (> (modulo x (car ls)) 0))
(cdr ls))))))
=>(2 3 5 7 11)
(define int-inf
(let mkls ((x 0))
(delay (cons x (mkls (+ x 1))))))
gosh> (ltake int-inf 20)
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
(define (primes-under num)
(let prime-list ((ls (let mkls ((x 2))
(if (<= num x) '() (cons x (mkls (+ x 1)))))))
(if (null? ls)
()
(cons (car ls)
(prime-list (filter (lambda (x) (> (modulo x (car ls)) 0))
(cdr ls)))))))
=>(primes-under 100)
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
<table><tr><td><img src="./fig/foobar.gif"/></td></tr></table>
line.gsub! /(\w)/e, '\1 '
for i in `ls -A`; do ruby -e"old=ARGV[0]; new=old.gsub(/.*?(\d{1,2})\.GIF/, '\1.gif'); File.rename(old, new)" $i; done
; Dibvig-3.5.2-1
(define calc1
(lambda (exp)
(define-syntax complain
(syntax-rules ()
((_ e1 e2 e3) (e1 (list e2 e3)))))
(call/cc
(lambda (ek)
(define apply-op
(lambda (ek op args)
(op (do-calc ek (car args)) (do-calc ek (cadr args)))))
(define do-calc
(lambda (ek exp)
(cond
((number? exp) exp)
((and (list? exp) (= (length exp) 3))
(let ((op (car exp)) (args (cdr exp)))
(case op
((add) (apply-op ek + args))
((sub) (apply-op ek - args))
((mul) (apply-op ek * args))
((div) (apply-op ek / args))
(else (complain ek "invalid operator" op)))))
(else (complain ek "invalid expression" exp)))))
(do-calc ek exp)))))
gosh> (calc1 '(div 2 3))
=> 0.6666666666666666
gosh> (calc1 '(div (div (div 3 2)) 2))
=> ("invalid expression" (div (div 3 2)))
; Dibvig-3.5.2-2
(define calc2
(lambda (exp)
(define-syntax complain
(syntax-rules ()
((_ e1 e2) (list e1 e2))))
(let ()
(define apply-op
(lambda (op args)
(op (do-calc (car args)) (do-calc (cadr args)))))
(define do-calc
(lambda (exp)
(cond
((number? exp) exp)
((and (list? exp) (= (length exp) 3))
(let ((op (car exp)) (args (cdr exp)))
(case op
((add) (apply-op + args))
((sub) (apply-op - args))
((mul) (apply-op * args))
((div) (apply-op / args))
(else (complain "invalid operator" op)))))
(else (complain "invalid expression" exp)))))
(do-calc exp))))
gosh> (calc2 '(div 2 3))
=> 0.6666666666666666
gosh> (calc2 '(div (div (div 3 2)) 2))
=> *** ERROR: operation / is not defined between ("invalid expression" (div (div 3 2))) and 2
Stack Trace:
_______________________________________
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ((ls ls))
(cond
((null? ls) 1)
((= (car ls) 0) (break 0))
(else (* (car ls) (f (cdr ls))))))))))
(product '(2 3 4) => 24
(define product
(lambda (ls)
(let ((ls ls))
(cond
((null? ls) 1)
((= (car ls) 0) 0)
(else (* (car ls) (product (cdr ls))))))))
(Define product/cps
(lambda (ls k)
(let ((ls ls) (k k))
(cond
((null? ls) k)
((= (car ls) 0) 0)
(else (product/cps (cdr ls) (* (car ls) k)))))))
(product/cps '(2 3 4) 1) => 24
(define product/cps
(lambda (ls k)
(let ((break k))
(let f ((ls ls) (k k))
(cond
((null? ls) (k 1))
((= (car ls) 0) (break 0))
(else (f (cdr ls) (lambda (x) (k (* (car ls) x))))))))))
(product/cps '(2 3 4) (lambda (x) x)) => 24
; (fold-puts '("a" ("b" . "l") "c" "d" ("e" . "d") "f" "g"))
; =>
; edcb
; f a
; g
;
(use srfi-1)
(define culc-room-space
(lambda (ls)
(cons
(if (>= (car ls) (cadr ls))
(car ls)
(cadr ls))
(if (>= (caddr ls) (cadddr ls))
(caddr ls)
(cadddr ls)))))
(define count-direction
(lambda (ls)
(let f ((ls ls) (height+ 1) (height- 1) (width+ 1) (width- 1) (direction "u"))
(if (null? (cdr ls))
(cond ((equal? direction "l")
(list height+ height- (- width+ 1) width-))
((equal? direction "r")
(list height+ height- width+ (- width- 1)))
((equal? direction "u")
(list (- height+ 1) height- width+ width-))
((equal? direction "d")
(list height+ (- height- 1) width+ width-)))
(if (and (pair? (car ls)) (dotted-list? (car ls)))
(cond ((equal? (cdr (car ls)) "l")
(f (cdr ls) height+ height- (+ width+ 1) width- "l"))
((equal? (cdr (car ls)) "r")
(f (cdr ls) height+ height- width+ (+ width- 1) "r"))
((equal? (cdr (car ls)) "u")
(f (cdr ls) (+ height+ 1) height- width+ width- "u"))
((equal? (cdr (car ls)) "d")
(f (cdr ls) height+ (+ height- 1) width+ width- "d")))
(cond ((equal? direction "l")
(f (cdr ls) height+ height- (+ width+ 1) width- direction))
((equal? direction "r")
(f (cdr ls) height+ height- width+ (+ width- 1) direction))
((equal? direction "u")
(f (cdr ls) (+ height+ 1) height- width+ width- direction))
((equal? direction "d")
(f (cdr ls) height+ (+ height- 1) width+ width- direction))
(else
(f (cdr ls) height width direction))))))))
(define make-room
(lambda (size)
(do ((m (make-vector (car size)))
(i 0 (+ i 1)))
((= i (car size)) m)
(vector-set! m i (make-vector (cdr size))))))
(define puts-room
(lambda (m)
(do ((i 0 (+ i 1)))
((= i (vector-length m)))
(let ((column (vector-ref m i)))
(do ((i 0 (+ i 1)))
((= i (vector-length column)))
(let ((char (vector-ref column i)))
(if (string? char)
(display char)
(display " ")))))))))
(define set-char-at!
(lambda (room i j character)
(vector-set! (vector-ref room i) j character)))
(define fold-puts
(lambda (ls)
(let* ((dirs (count-direction ls)) (m (make-room (culc-room-space dirs))))
(let puts ((i (- (car dirs) 1))
(j (- (caddr dirs) 1))
(ls ls)
(dir "u"))
(if (null? (cdr ls))
(puts-room m)
(if (and (pair? (car ls)) (dotted-list? (car ls)))
(begin
(set-char-at! m i j (caar ls))
(cond ((equal? (cdr (car ls)) "l")
(puts i (- j 1) (cdr ls) "l"))
((equal? (cdr (car ls)) "r")
(puts i (+ j 1) (cdr ls) "r"))
((equal? (cdr (car ls)) "u")
(puts (- i 1) j (cdr ls) "u"))
((equal? (cdr (car ls)) "d")
(puts (+ i 1) j (cdr ls) "d"))))
(begin
(set-char-at! m i j (car ls))
(cond ((equal? dir "l")
(puts i (- j 1) (cdr ls) "l"))
((equal? dir "r")
(puts i (+ j 1) (cdr ls) "r"))
((equal? dir "u")
(puts (- i 1) j (cdr ls) "u"))
((equal? dir "d")
(puts (+ i 1) j (cdr ls) "d"))))))))))
(define prime-list
(let ((primes '()))
(lambda (upper-int)
(let next-primes ((test-int 2) (primes primes))
(let next-divider ((test-int test-int)
(ls (reverse primes)))
(cond ((null? ls)
(next-primes (+ test-int 1) (cons test-int (reverse primes))))
((> test-int upper-int)
primes)
((integer? (/ test-int (car ls)))
(next-primes (+ test-int 1) (reverse primes)))
(else
(next-divider test-int (cdr ls)))))))))
(define prime-list
(let ((primes '(2)))
(lambda (upper-int)
(let next-prime ((test-int 3) (ls primes))
(if (< test-int upper-int)
(if (integer? (/ test-int (car (reverse ls))))
(next-prime (+ test-int 1) primes)
(if (null? (cdr ls))
(begin (set! primes (cons test-int primes))
(next-prime (+ test-int 1) primes))
(next-prime test-int (reverse (cdr (reverse ls))))))
primes)))))
(prime-list 91) =>
(89 83 79 73 71 67 61 59 53 47 43 41 37 31 29 23 19 17 13 11 7 5 3 2)
(define rvs
(lambda (ls)
(let fishy-rvs ((rvsed '()) (amari ls))
(if (null? amari)
rvsed
(fishy-rvs
(cons (car amari) rvsed)
(cdr amari))))))
(define fishy-rvs
(lambda (tr)
(cond
((null? (cdr tr)) tr)
((null? (cdr (cdr tr))) (cons (car (cdr tr)) (car tr)))
(else (let ((amari-tr (cdr (cdr tr))))
(fishy-rvs
(cons
(cons (car (cdr tr)) (car tr))
amari-tr)))))))
(define car2proper-list
(lambda (ls)
(cons (cons (car ls) ()) (cdr ls))))
(define rvs
(lambda (tr)
(if (list? tr)
(fishy-rvs (car2proper-list tr))
"it's not list!")))
#!/usr/bin/gosh
(use gauche.charconv)
(use text.tree)
(use text.html-lite)
(use www.cgi)
(define (main args)
(write-tree
`(,(cgi-header)
,(html-doctype)
,(html:html
(html:head (html:title "jabber"))
(html:body
(html:p 4649)
(html:p "おはいよう")))
)))