2013/03/27

フィールドSE刑事・慕情編

このシリーズもっとくれ
written by time: 0 件のコメント:
labels :

2013/03/25

雑なリマインダ その2

以前、こんなものを作った。

こんな雑なbatだけど今でも使っている。でもタスクバーにcmdが出っぱなしなのでうざい。間違って閉じてしまうこともある。ということで、改良というより作りなおしてwindows標準のタスクスケジューラに登録するようなものにした。Windows7だと動くと思います。

@ECHO OFF
ECHO --------------------------------------------
ECHO 指定時刻にメッセージを表示します
ECHO --------------------------------------------
SET /p MESSAGE_TEXT="メッセージを入力して下さい > "
SET /p START_TIME="時刻を指定して下さい（ex. 09:15） > "
SET TIME2=%time: =0%
SET TASK_CREATE_TIME=%TIME2:~0,2%%TIME2:~3,2%%TIME2:~6,2%
SET TASK_CREATE_DATE=%date:~-10,4%%date:~-5,2%%date:~-2,2%
SET TASK_ID=%USERNAME%-%TASK_CREATE_DATE%%TASK_CREATE_TIME%
SCHTASKS /CREATE /SC ONCE /TN %TASK_ID% /TR "msg.exe console "%MESSAGE_TEXT% /ST %START_TIME% /V1 /Z
PAUSE
view raw reminder2.bat hosted with ❤ by GitHub

タスクは実行されたあとに削除されるようになっている（/Zオプション）。ただ/ZオプションをつけただけだとXMLがどうのこうのというエラーが出るので/V1オプションを付けてある。

エラー: タスク XML に必須の要素または属性が含まれていません。
(41,4):EndBoundary:

タスクスケジューラに登録するID文字列を作るときに日付と時間を使ってるんだけど、そのフォーマット指定がえらいことになってる。

それと、結局使ってないけど、コマンドの結果を変数に保存するのにforを使う必要があるらしく、これもやけに大変だな・・・。勉強になるなぁ（白目

@FOR /F "usebackq tokens=*" %%i in (`DATE /T`) DO @SET TASK_CREATE_DATE=%%i

ついでにメモしておくと、unixでいう cat は type、diff は fc、traceroute は tracert、grep は findstr、ifconfig は ipconfig 辺りで代用できるって認識で良いのかね。more、arp、ping、netstat、nslookup なんかは同じのがあるようで。


written by time: 1 件のコメント:
labels : ,

2013/03/24

2013/03/24

written by time: 0 件のコメント:
labels : , ,

2013/03/23

Land of Lisp 10章のシミュレーション

画像は Land of Lisp 10 章で作るシミュレーションの世界にて100万日が経過した状態。

遺伝子とエネルギーを持った動く動物が、草と森がある世界で動きまわって食事をし、無性生殖で繁殖する世界のシミュレーション。動物は遺伝情報に従い特定の動きを見せ、動くことでエネルギーを消費する。草を食べることでエネルギーを補充、繁殖でエネルギーを大幅に消費、エネルギーが足りないと繁殖できない、エネルギーが切れると死ぬ、というもの。

ライフゲームも似たようなもんだよね。

プログラムの大部分は本に載っているCommon Lispのコードと翻訳者であるshiroさんが公開されているGaucheによるコードを基に、少し改造していくつかの条件をパラメータで渡せるコマンドにしてみたもの。

パラメータをいじって30万日くらい動かすと結果が違って楽しい。動作はコマンドを実行してEnterを押すごとに世界が1日進む。300000などの数値を打ち込んでEnterを押すとその分日数が経過する。

#!/usr/local/bin/gosh
;;; 本とshiroさんのコードを写経しつつ少し改造してあります。
;;; https://github.com/shirok/Gauche-LoL/blob/master/evolution.scm
;;; https://github.com/shirok/Gauche-LoL/blob/master/evolution-color.scm
(use srfi-1) ; list-tabulate
(use srfi-27) ; random-integer
(use gauche.parameter)
(use gauche.record)
(use gauche.sequence)
(use gauche.process)
(use gauche.parseopt)
(define-constant +GENES_LENGTH+ 8)
(define *plants* (make-hash-table 'equal?))
(define *width* (make-parameter 100))
(define *height* (make-parameter 30))
(define *jungle* (make-parameter '(45 10 10 10)))
(define *plant-energy* (make-parameter 80) )
(define (random-plant! left top width height)
(let1 pos (cons (+ left (random-integer width))
(+ top (random-integer height)))
(hash-table-put! *plants* pos #t)))
(define (add-plants!)
(apply random-plant! (*jungle*))
(random-plant! 0 0 (*width*)(*height*)))
(define-record-type animal #t #t
(x)(y)(energy)(dir)(genes))
(define *animals*
(list (make-animal
(ash (*width*) -1)
(ash (*height*) -1)
1000
0
(list-tabulate
+GENES_LENGTH+
(^_ (+ 1 (random-integer 10)))))))
(define (move! animal)
(let ((dir (animal-dir animal))
(x (animal-x animal))
(y (animal-y animal)))
(set! (animal-x animal)
(modulo (+ x (cond ((and (>= dir 2)(< dir 5)) 1)
((or (= dir 1)(= dir 5)) 0)
(else -1))
(*width*))
(*width*)))
(set! (animal-y animal)
(modulo (+ y (cond ((and (>= dir 0)(< dir 3)) -1)
((and (>= dir 4)(< dir 7)) 1)
(else 0))
(*height*))
(*height*)))
(dec! (animal-energy animal))))
(define (turn! animal)
(let1 x (random-integer (apply + (animal-genes animal)))
(define (angle genes x)
(let rec ((genes genes)(x x)(acc 0))
(let1 xnu (- x (car genes))
(if (< xnu 0)
acc
(rec (cdr genes) xnu (+ acc 1))))))
(set! (animal-dir animal)
(modulo (+ (animal-dir animal)
(angle (animal-genes animal) x))
+GENES_LENGTH+))))
(define (eat! animal)
(let1 pos (cons (animal-x animal)(animal-y animal))
(when (hash-table-get *plants* pos #f)
(inc! (animal-energy animal)(*plant-energy*))
(hash-table-delete! *plants* pos))))
(define *reproduction-energy* (make-parameter 200))
(define (reproduce! animal)
(let1 e (animal-energy animal)
(when (>= e (*reproduction-energy*))
(set! (animal-energy animal)(ash e -1))
(let ((animal-nu (make-animal (animal-x animal)
(animal-y animal)
(animal-energy animal)
(animal-dir animal)
(list-copy
(animal-genes animal))))
(mutation (random-integer +GENES_LENGTH+)))
(update! (~ animal-nu 'genes mutation)
(^v (max 1 (+ v (random-integer 3) -1))))
(push! *animals* animal-nu)))))
(define (update-world!)
(set! *animals* (remove! (^(animal)(<= (animal-energy animal) 0))
*animals*))
(dolist (animal *animals*)
(turn! animal)
(move! animal)
(eat! animal)
(reproduce! animal))
(add-plants!))
(define (draw-world)
(dotimes (y (*height*))
(newline)
(display "|")
(dotimes (x (*width*))
(display (cond ((find (^(animal) (and (= (animal-x animal) x)
(= (animal-y animal) y)))
*animals*)
=> (^a (with-color #\M (animal-genes a))))
((hash-table-get *plants* (cons x y) #f) #\*)
(else #\space))))
(display "|")
))
(define *hue-vecs*
'((255 0 0)
(255 191 0)
(128 255 0)
(0 255 64)
(0 255 255)
(0 64 255)
(128 0 255)
(255 0 191)))
(define *terminal-colors*
'(((0 0 0) "30")
((205 0 0) "31")
((0 205 0) "32")
((205 205 0) "33")
((0 0 238) "34")
((205 0 205) "35")
((0 205 205) "36")
((229 229 229) "37")
((127 127 127) "30;1")
((255 0 0) "31;1")
((0 255 0) "32;1")
((255 255 0) "33;1")
((92 92 255) "34;1")
((255 0 255) "35;1")
((0 255 255) "36;1")
((255 255 255) "37;1")))
(define (gene-color gene)
(let1 factor (/. (apply + gene))
(define (col picker)
(clamp (reduce + 0 (map (^(c g)(*. (picker c) g factor))
*hue-vecs* gene))
0 255))
(list (col car) (col cadr) (col caddr))))
(define (find-closest-terminal-color color)
(define (distance c1 c2)
(apply + (map (^p (expt (- (p c1) (p c2)) 2)) (list car cadr caddr))))
(find-min *terminal-colors* :key (^e (distance (car e) color))))
(define (with-color char gene)
(let1 entry (find-closest-terminal-color (gene-color gene))
(format "\u001b[~am~a\u001b[0m" (cadr entry) char)))
(random-source-randomize! default-random-source)
(define (evolution :optional
(width #f)(height #f)(jungle #f)(plant-energy #f)
(reproduction-energy #f))
(parameterize ((*width* (or width (*width*)))
(*height* (or height (*height*)))
(*jungle* (or jungle (*jungle*)))
(*plant-energy* (or plant-energy (*plant-energy*)))
(*reproduction-energy* (or reproduction-energy (*reproduction-energy*))))
(read-line)
(let loop ()
(draw-world)
(newline)
(let1 str (read-line)
(unless (equal? str "quit")
(if-let1 x (string->number str)
(dotimes (i x)
(update-world!)
(when (zero? (modulo i 1000))
(display #\.)(flush)))
(update-world!))
(loop))))))
(define (tput . args)
(run-process `(tput ,@args)))
(define (get-tput-val . args)
(process-output->string `(tput ,@args)))
(define (usage cmd)
(print "usage: " cmd "[option ...]")
(print " options:")
(print " w|width : world width (default: terminal width - 2)")
(print " h|height : world height (default: terminal height - 1)")
(print " j|jungle : jungle location and size (top left width height)")
(print " (default (45 10 10 10)) ")
(print " p|plant-energy : (default 80)")
(print " r|reproduction-energy : (default 200)")
(exit))
(define (main args)
(let-args (cdr args)
((help "h|help" => (cut usage (car args)))
(width "w|width=i" (- (string->number (get-tput-val 'cols)) 2))
(height "h|height=i" (- (string->number (get-tput-val 'lines)) 1))
(jungle "j|jungle=e" '(45 10 10 10))
(plant-energy "p|plant-energy=i" 80)
(reproduction-energy "r|reproduction-energy=i" 200)
(else (opt . _)
(print "Unknown option : " opt)
(usage (car args)))
. rest)
(evolution width height jungle plant-energy reproduction-energy)))
view raw evolution.scm hosted with ❤ by GitHub

さて、読んでいてよくわからなかったのが、P.202の turn 手続きで移動方向を決める部分。説明を読んでもいまいち意味がわからなかった。angle 手続きを呼び出す辺り。angle の定義はこれ。

(define (angle genes x)
  (let1 xnu (- x (car genes))
    (if (< xnu 0)
        0
        (+ 1 (angle (cdr genes) xnu)))))

自分なりに書きなおしてみたのはこれ。

(define (angle genes x)
  (let rec ((genes genes)(x x)(acc 0))
    (let1 xnu (- x (car genes))
      (if (< xnu 0)
          acc
          (rec (cdr genes) xnu (+ acc 1))))))

angle 手続き事態は難しくないけど、これを使って何をやってるのかがわからなかった。

angle の仕事は、引数 x を基に、引数 genes（リスト）から一つ要素を選び、選ばれた要素のインデックスを返すこと。例えば、genes が (1 1 10 5 2 1 1 1) だった場合、合計が22なので x は0〜21のランダムな数値（angle を呼び出す側で決められる）で束縛される。angle の評価結果として出現する頻度が最も高いのが2、次が3、その次が4。

絵に書くとこんな感じか。絵の上の行の数値が x 、下が選択される要素。

今この絵を描いていて思いついたけど、以下のようなリストからランダムに選ぶのと同じってことだな。

(use srfi-27)
(let1 genes '(1 1 10 5 2 1 1 1)
  (apply append
         (map (^(g i)
                (iota g i 0))
              genes
              (iota (length genes)))))
;; => (0 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 4 4 5 6 7)

ということで、angle 手続きは下記のようなものでも良いということか。

(define (angle genes x)
  (~ (apply append
            (map (^(g i)
                   (iota g i 0))
                 genes
                 (iota (length genes))))
     x))

余談

これ、条件をちゃんと考えたら「ライフメーカーの掟」のプロローグ部分（ロボットがバグって進化し始める）のシミュレーション作れるんじゃないの。 （「ロボットがバグって進化し始める」っていう説明ではすごくちゃちなものに聞こえてしまうな。これをホーガン氏が書くとどえらい壮大なことになるんだよなあ。） このシミュレーションプログラムを有性生殖にして工場を作るだけでも近いものになりそうだな、という話。


written by time: 0 件のコメント:
labels : , , ,

2013/03/22

tputのサンプル

tputでterminalサイズいっぱいにランダムに背景色を設定し続けるサンプル。わさおがKPFのLTでちらっと見せてくれたのを思い出して真似してみた。あれはコレ↓を使ったやつなんだろうけども。

tput colsとlinesでterminalのサイズを取得し、ランダムな座標にランダムな背景色を指定し続ける。

こんな感じ。

スクリプトはGauche。tputの実行はgauche.processモジュールのrun-process、tputの実行結果取得はprocess-output->stringで。

下のはtput colsでterminalの幅を取得してランダムな背景色を指定しつつ行末まで行ったらreturnして行頭に戻ってループ。

#!/usr/local/bin/gosh
(use gauche.process)
(use math.mt-random)
(define (main args)
(define rand
(let1 m (make <mersenne-twister> :seed (sys-time))
(^n (mt-random-integer m n))))
(define (get-tput-val . args)
(process-output->string `(tput ,@args)))
(define (tput . args)
(run-process `(tput ,@args)))
(define (make-random-color)
#`",(string #\\escape)[4,(+ (rand 8) 1)m ,(string #\\escape)[0m")
(let ((cols (x->integer (get-tput-val 'cols)))
(lines (x->integer (get-tput-val 'lines))))
(dynamic-wind
(^ _ (tput 'civis)(tput 'clear))
(^ _ (let1 size (iota (* cols lines))
(display (apply string-append (map (^_ (make-random-color)) size)))
(while #t
(for-each (^_ (tput 'cup (rand lines)(rand cols))
(display (make-random-color))
(sys-nanosleep 1000000)
(flush))
size))))
(^ _ (tput 'cnorm)))))
view raw termrandbgcolor.scm hosted with ❤ by GitHub
#!/usr/local/bin/gosh
(use gauche.process)
(use math.mt-random)
(define (main args)
(define rand
(let1 m (make <mersenne-twister> :seed (sys-time))
(^n (mt-random-integer m n))))
(define (get-tput-val . args)
(process-output->string `(tput ,@args)))
(define (tput . args)
(run-process `(tput ,@args)))
(define (make-random-color)
#`",(string #\\escape)[4,(+ (rand 8) 1)m ,(string #\\escape)[0m")
(let1 cols (x->integer (get-tput-val 'cols))
(while #t
(for-each (^_ (display (make-random-color))
(sys-nanosleep 10000000)
(flush))
(iota cols))
(display "\r"))))
view raw termrandline.scm hosted with ❤ by GitHub

まあ、両方ともあんまり意味はない。ヒマだったんだ。

written by time: 0 件のコメント:
labels : , ,

2013/03/21

Re: ターミナルに黒魔道士

昨日の記事に予想外の反響。

ブコメにRubyのワンライナーがあったのでGaucheでもワンライナーで書いてみた。

だいぶ長くなったけどこんな感じ。

cat temp/kuromadousi.dat | gosh -u srfi-13 -e '(for-each(^s(string-for-each(^c(display(if(eq? #\space c)" "#`",(string #\\escape)[4,|c|m ,(string #\\escape)[0m")))s)(print))(port->list read-line(standard-input-port))))'
view raw termdraw.sh hosted with ❤ by GitHub
written by time: 0 件のコメント:
labels : , ,

2013/03/20

2013/03/20

written by time: 0 件のコメント:
labels : , ,

ターミナルに黒魔道士

こんなの見かけて、楽しそうだったのでやってみた。

ただ単にファイルから読み込んだ色情報を基に半角空白をansi escapeして表示してるだけ。

スクリプトはGaucheで書きました。エスケープの処理は以前クリスマスツリーを飾ったときに作ったものを流用。

Gaucheのバージョンはこれ。
 % gosh -V    
Gauche scheme shell, version 0.9.4_pre3 [utf-8,pthreads], x86_64-unknown-linux-gnu
ソースは以下。
0 00 0000000
01011011111110
010111111111000
0111111111111110
011111111111100
01113113111111110
0101310011111110
00100031133100
030333133110
0003033330000
0110337330000
01103333011000
001033007703330
0101000110033330
033011011330113330
033301111333111330
0333 077033311130
000 01110000000
01033010
0033300
011111110
01111110
711110
07771170
000000
view raw batz.dat hosted with ❤ by GitHub
0000 00000 0
02222022222000020
022222222222222220
02022222222222220
0226662266222020
0206662266262220
00333022222220
000322222220
032032332220
000303333322000
06663333332066660
0603333000222020
022003060003330
033320002033023330
033302022033322330
0330 022003332230
00 060066000000
06600660
0603300
03333000
0222222220
06666660
0266660
02226620
000000
view raw galuf.dat hosted with ❤ by GitHub
00
00330
033320
0033320
003333220
000000033332220
0333333332222220
02222333322220
0002222333200
00002222220
030000022220
00300300002220
04000030000400
040000000000040
044400044444440
00444444400040
0330444440044440
03304444033044440
004404403304440
040440040044440
040444440044440
044044440044440
044404444044440
0444400444044040
044444444444004440
0000000000000000
view raw kuromadousi.dat hosted with ❤ by GitHub
0000
00077770
00777777770
0077777777770
07777777770770
077000077777070
070055550777770
0700555555077770
07050355555077770
07005003003507770
0700303300307770
07030330330770
0703333370770
00070333307700
0577070000777770
05550777770000770
05577007705777070
05777777705557770
05557777705577770
05577777705777770
05770777705557770
05550777705577770
0570775770575770
0505755755055750
0555555555055550
000000000 0000
view raw siromadousi.dat hosted with ❤ by GitHub
#!/usr/local/bin/gosh
(use gauche.parseopt)
(define-constant ANSI_ESCAPE_BG_COLOR_BASE 40)
(define (ansi-escape str color-num)
(apply string-append
(map (apply$ string)
(list `(#\escape #\[ ,@(string->list (x->string color-num)) #\m)
(string->list str)
`(#\escape #\[ ,@'(#\0) #\m)))))
(define (draw ls)
(for-each
(^l (for-each
(^x (if-let1 n (string->number x)
(display (ansi-escape " " (+ n ANSI_ESCAPE_BG_COLOR_BASE)))
(display " ")))
l)
(print))
ls))
(define (usage cmd)
(print "usage: " cmd " file1.dat file2.dat ... filen.dat")
(print "exapmle: % echo \'0123 4567\' | " cmd)
(print (draw '(("0" "1" "2" "3" " " "4" "5" "6" "7"))))
(exit))
(define (input->list)
(define (line->list val)
(map string (string->list val)))
(let rec ((acc '()))
(let1 val (read-line)
(if (eof-object? val)
(reverse acc)
(rec (cons (line->list val) acc))))))
(define (list->double ls)
(fold-right (^ (x acc)
(cons x (cons x acc)))
'()
ls))
(define (main args)
(let-args (cdr args)
((help "h|help" => (cut usage (car args)))
(else (opt . _)
(print "Unknown option : " opt)
(usage (car args)))
. rest)
(let1 data (if (null? rest)
(input->list)
(apply map (^ rows (apply append rows))
(map (cut with-input-from-file <> input->list)
rest)))
(print (draw (map list->double data))))))
view raw termdraw.scm hosted with ❤ by GitHub

追記

スクリプトを使わずに、ただ表示したければコレ↓をcatすれば表示されるかも。
gnu screenのスクリーンセーバーにしてみようかな。

追記

関係ないけど、ちなみに今は.screenrcに以下のように設定している。以前作った、ふぁぼった中からランダムに表示させるコマンド。 

blankerprg favrand valvallow

追記

ワンライナー書いてみた。

追記


written by time: 0 件のコメント:
labels : , ,

2013/03/13

2013/03/13

written by time: 0 件のコメント:
labels : , ,

2013/03/09

2013/03/09

written by time: 0 件のコメント:
labels : , ,

2013/03/02

2013/03/02

written by time: 0 件のコメント:
labels : , ,
登録: 投稿 (Atom)