2013-11-29

gitの右クリックメニューを削除する方法。

ついでなのでメモしておこう。
コマンドプロンプトで、以下のコマンドを実行すれば消える。

> cd "C:\Program Files (x86)\Git\git-cheetah"
> regsvr32 /u git_shell_ext64.dll

2013-11-29

ちょっと気になったこと

インストーラーのGUIが動かないので、インストールオプションが変えられない。あんまり困ることはないんだけど、gitを入れた時に右クリックメニューに勝手に追加されたのには閉口した。あとはBaidu IMEが勝手にインストールされないよな…とかがちょっと不安になる。
アンインストールはパッケージによっては上手くいかない場合があった。普通にプログラムの追加と削除からアンインストールしたほうがイイかも。
あとGUIツールとしてChocolateyGUIというのが用意されているけど、結構使い勝手が悪い。cliもそうなんだけど、ローカルにキャッシュを持っていないのか、反応が遅い。この辺改善されると嬉しいなあ。

とはいえ便利なのは間違いないので、なるべくこれを使って環境構築していきたい。

2013-11-29

使い方

インストール方法

公式サイト見れば分かるけどコマンドプロンプトを立ち上げて以下のコマンドをコピペして実行すれば終わり。

@powershell -NoProfile -ExecutionPolicy unrestricted -Command "iex ((new-object net.webclient).DownloadString('https://chocolatey.org/install.ps1'))" && SET PATH=%PATH%;%systemdrive%\chocolatey\bin

パッケージのインストール方法

パッケージは複数指定できるので簡単。
正式なコマンド名はchocolateyだけど、コマンド名長いからか、エイリアスが用意されている。インストールはcinst、アンインストールはcuninstでできる。
細かい使い方はGitHub - chocolatey/chocolatey: [DEPRECATED - https://github.com/chocolatey/choco] Chocolatey NuGet - Like apt-get, but for windows.を参照。

2013-11-29

Windowsのパッケージ管理ソフト Chocolatey

Linuxのyumとかaptとか便利だよな、いいなーとか思ってたんだけど、調べてみたら、WindowsにもChcolateyというパッケージ管理ソフトがあった。試しに使ってみたところ、すこぶる便利だった。

Chocolatey - The package manager for Windows

公式サイトを見ると、emacsとかrubyとかgitといった開発関係のパッケージも色々あるんだけど、それに加えてiTunesとかChromeとかDropboxとか果てはMS Officeまであったりする。Officeは勿論ライセンスが必要だけど。

chocolateyのレポジトリにバイナリがあるわけではなく、配布元のサイトから自動でダウンロードしてインストールをする作りにみえる。なんにせよコマンド一つで自動でインストールできるので、ChocolateyをつかうとOSのクリーンインストール後の環境整備が楽にできる。

2010-12-06

Form Letters

Scheme Programming Praxis

Form Letters | Programming Praxisを解いてみました。
あるテキスト中に埋め込まれた $n を単語列中のn番目の要素で置き換えるという、簡単なテンプレートエンジンを作る問題です。
テンプレートとなるテキストを受け取って、単語リストを与えられたら文章を生成する関数を返す、高階関数を作りました。たとえば、"test $1 test $0"というテキストを処理したい場合、

((lambda () "test") ) (lambda () (ref wordlist 0)) (lambda () "test")  (lambda () (ref wordlist 1))

というリストを生成し、リストの各要素を評価した上で連結する関数が返ります。
この関数に単語リストを渡すと結果のテキストが得られます。

gosh> (define schema (parse-schema "test $1 test $0"))
schema
gosh> (schema '("!" "!!"))
"test !! test !"

という具合。On Lispに載っていた表現としての関数、というのをやってみたかったんですが、実際のところどこまで効率的になっているのかわからないです。
単語リストが足りない場合はエラーで終了します。エラーをキャッチして空白にでも置き換えてもいいんですが、エラー出る方が良いかなあという気もするのでそのままにしておきます。

(define (number-char? chr)
  (and (char<=? #\0 chr) (char<=? chr #\9)))

(define (parse-chars charlist result preg midproc endproc)
  (call/cc
   (lambda (break)
     (let loop ((charlist charlist) (buffer ()) (result result))
       (cond [(null? charlist) (endproc buffer result)]
	     [(preg (car charlist))
	      (loop (cdr charlist) () (midproc break charlist buffer result))]
	     [else (loop (cdr charlist) (cons (car charlist) buffer) result)])))))
   
(define (parse-wordlist str splitter)
  (define (add2wordlist buffer wordlist)
    (if (null? buffer) wordlist (cons (list->string (reverse buffer)) wordlist)))
  (parse-chars (string->list str) ()
	       (cut char=? <> splitter)
	       (lambda (break charlist buffer result) (add2wordlist buffer result))
	       (lambda (buffer result) (reverse (add2wordlist buffer result)))))

(define (parse-schema str)
  (let ((wordlist ()))
    (define (sepalator? char) (char=? #\$ char))
    (define (addwords buffer schema)
      (if (null? buffer) schema (let ((words (list->string (reverse buffer))))
				    (cons (lambda () words) schema))))
    (define (addtmplt buffer schema)
      (if (null? buffer) schema
	(let ((idx (x->integer (list->string (reverse buffer)))))
	  (cons (lambda () (ref wordlist idx)) schema))))
    (define (main-loop charlist schema)
      (parse-chars charlist schema sepalator?
		   (lambda (break chlst buffer schema)
		     (break (subst-loop (cdr chlst) (addwords buffer schema))))
		   (lambda (buffer schema) (reverse (addwords buffer schema)))))
    (define (subst-loop charlist schema)
      (if (sepalator? (car charlist))
	  (main-loop (cdr charlist) (addwords '(#\$) schema))
	  (parse-chars charlist schema (compose not number-char?)
		       (lambda (break chlst buffer schema)
			 (break (main-loop chlst (addtmplt buffer schema))))
		       (lambda (buffer schema) (reverse (addtmplt buffer schema))))))
    (let ((schema (main-loop (string->list str) ())))
      (lambda (wrdlst)
	(set! wordlist wrdlst)
	(string-join (map (lambda (proc) (proc)) schema) "")))))

(define (main args)
  (if (null? (cddr args)) (begin (print "input file name") (exit)))
  (let* ((template (call-with-input-file (ref args 1) (lambda (in) (port->string in))))
	 (schema (parse-schema template)))
    (call-with-input-file (ref args 2)
      (lambda (in)
	(port-for-each (lambda (line) (print "") (display (schema (parse-wordlist line #\,))))
		       (lambda () (read-line in) ))))))

parse-wordlistは単なるstring-splitの劣化版です。parse-charsは文字を一文字ずつバッファに読み込んでいって、特定の文字が来たらアクションを起こすという部分を切り出してます。

2010-12-06

Maximum Sum Subsequence

Scheme Programming Praxis

Programming Praxis | A collection of etudes, updated weekly, for the education and enjoyment of the savvy programmerというサイトにMaximum Sum Subsequence | Programming Praxisという問題があったので解いてみました。
cont-max2はほぼサイトに載っていた模範解答の最後のやつ（O(n)の解答）と同じでした。たcont-maxは最大値に加えて、最大になる部分数列も出力します。
数列を前から順番に見ていって、その時点での最大値と、一つ前の数列を使った最大値＋今の値と、今の値を比較して大きい方を最大値に入れる、というのを繰り返してます。

(use gauche.collection)
(define (cont-max lst)
  (define (initseq val)
    (cons (list val) val))
  (let loop ((lst (cdr lst)) 
	     (prev-lst-max (initseq (car lst)))
	     (max (initseq (car lst))))
    (if (null? lst)
	max
	(let* ((new-lst-max (if (positive? (cdr prev-lst-max))
				(cons (cons (car lst) (car prev-lst-max)) (+ (car lst) (cdr prev-lst-max)))
				(initseq (car lst)))))
	  (loop (cdr lst)
		new-lst-max
		(find-max (list new-lst-max max) :key cdr))))))

(define (cont-max2 lst)
  (let loop ((lst (cdr lst)) (prev-lst-max (car lst)) (cur-max (car lst)))
    (if (null? lst)
	cur-max
	(let ((new-lst-max (if (positive? prev-lst-max) (+ prev-lst-max (car lst)) (car lst))))
	  (loop (cdr lst) new-lst-max (max cur-max new-lst-max))))))

gosh> (cont-max '(31  -41  59  26  -53  58  97  -93  -23  84))
((97 58 -53 26 59) . 187)

gosh> (cont-max2 '(31  -41  59  26  -53  58  97  -93  -23  84))
187

そういえば模範解答は最大値の初期値を0にしてしまっているので、最初の値が負の場合は、上手くいかない場合があります。

gosh> (max-sum-subsequence '(-31 -32 -123 -32)) 0
どう見ても0ではない...

(10/12/07追記)
コメントにて、部分列は空列を含むので、空列の和を0とすると模範解答は正しいのではないかという指摘を受けました。言われてみると、確かにそう考えるほうが自然ですね。そうすると上の回答は間違ってて、loopのprev-lst-maxとcur-maxの初期値を0にしてlstの初期値をlstにしなければなりません。

2010-11-28

数独

Scheme

Gaucheで数独解くﾌﾟﾛｸﾞﾗﾑを作ってみました｡
Gigazineに前のっていた世界で一番解くのが難しい問題とか言うのも解けたので､多分大丈夫だと思います｡
数学のエキスパートが3ヶ月かけて作成した「世界一難しい数独」 - GIGAZINE

という感じで未確定ﾏｽを0にして入力すると､

>gosh sudoku.scm problem.txt

1 4 5  3 2 7  6 9 8
8 3 9  6 5 4  1 2 7
6 7 2  9 1 8  5 4 3

4 9 6  1 8 5  3 7 2
2 1 8  4 7 3  9 5 6
7 5 3  2 9 6  4 8 1

3 6 7  5 4 2  8 1 9
9 8 4  7 6 1  2 3 5
5 2 1  8 3 9  7 6 4

という感じで答えが出ます｡速度はそこそこ｡問題の入力は面倒ですね｡
解き方は普通です｡途中変な工夫しようとしたら無駄にはまったので素直なやり方にしました｡

1.すべての未確定のﾏｽに(1 2 3 4 5 6 7 8 9)というﾘｽﾄを用意する｡
2. 確定しているﾏｽと同じﾌﾞﾛｯｸ､同じ列､同じ行のﾏｽのﾘｽﾄから確定ﾏｽの数字を削除する｡
3.すべての確定しているﾏｽについて2.を行う｡
4.未確定ﾏｽが残っている場合は､深さ優先探索を行う｡
5.同じﾌﾞﾛｯｸ､または同じ列､または同じ行に同じ数字の確定ﾏｽができたらﾊﾞｯｸﾄﾗｯｸ｡
6.未確定ﾏｽがなくなったら探索終了｡

という流れです｡resolveが5と6の実装､clean-board､cleanが1と2と3の実装です｡あとはほとんどﾃﾞｰﾀｱｸｾｽ用の関数です｡CLOSを使ってboardをｵﾌﾞｼﾞｪｸﾄにすればよかったかなｰと思いつつ面倒なのでそのままです｡
cleanが汚い感じなので残念｡あと

 (let ((value (proc1 A)))
   (if (pred) (proc2 value) (proc3 value)))

というのをすっきりと各方法が思いつかなかった。

しかしいつも良い名前がつけられなくて困ります｡

(use srfi-1)
(use gauche.sequence)
(define *width* 9)
(define *blocks* 3)

(define (resolved? lst)
  (null? (cdr lst)))

(define (idx->ij idx)
  (values (quotient idx *width*) (modulo idx *width*)))

(define (memoize func)
  (let* ((cache (make-hash-table 'equal?))
	 (getCache (cut hash-table-get cache <> #f))
	 (setCache! (lambda (key value) (hash-table-put! cache key value) value)))
    (lambda args
      (cond [(getCache args) => values]
	    [else (setCache! args (apply func args))]))))

;;board struct
(define (read-board port)
  (let loop ((board ()))
    (let* ((line (read-line port)))
      (if (eof-object? line)
	  board
	  (loop (append board (map digit->integer (string->list line))))))))

(define (init-board board);board = (<not-resolved list> . <board>)
  (if (= (length board) (* *width* *width*))
      board
      (error "this file is not valid sudoku problem"))
  (cons (iota (* *width* *width*))
	(list->vector (map (lambda (i) (if (= i 0) (iota *width* 1) (list i))) board))))

(define (get-val board idx)
  (vector-ref (cdr board) idx))

(define (set-val! board idx val)
  (vector-set! (cdr board) idx val))

(define (copy-board board)
  (cons (list-copy (car board)) (vector-copy (cdr board ))))

(define (resolve! board idx)
  (set! (car board) (remove (cut = <> idx) (car board))))

(define (map-with-index-board! proc idx-list board)
  (for-each (lambda (idx)
	      (receive (i j) (idx->ij idx)
		(set-val! board idx (proc idx (get-val board idx)))))
	    idx-list) board)

(define (each-with-index-board proc idx-list board)
  (map-with-index-board! (lambda (idx val) (proc idx val) val) idx-list board))

(define (not-resoleved-idx-lst board)
  (car board))
  
(define (num-not-resolved board)
  (fold (lambda (val prev)
	  (if (resolved? val) prev (+ prev 1)))
	0 (cdr board)))

(define (make-candidates board)
  (let ((idx (caar board)))
    (map (lambda (val) (let ((new-board (copy-board board))) (set-val! new-board idx (list val)) new-board)) (get-val board idx))))

(define (print-board board)
  (for-each-with-index
   (lambda (idx val)
     (receive (i j) (idx->ij idx)
       (when (= j 0)
	 (display (if (= 0 (modulo i 3)) "\n\n" "\n")))
       (cond [(null? val) (display "!")]
	     [(resolved? val) (display (car val))]
	     [else (display "-")])
       (if (= 2 (modulo j 3))
	   (display "  ")
	   (display " "))))
   (cdr board))
  (display "\n"))

;;make index list related to "idx"
(define (get-region-idx-list idx) 
  (receive (i j) (idx->ij idx)
    (let ((region-i (quotient i *blocks*)) (region-j (quotient j *blocks*)))
      (remove
       (cut = <> idx)
       (filter (lambda (idx)
		 (if (and (= region-i (quotient idx (* *blocks* *width*)))
			  (= region-j (quotient (modulo idx *width*) *blocks*)))
		     #t #f))
	       (iota (* *width* *width*)))))))
  
(define (get-row-idx-list idx)
  (receive (i j) (idx->ij idx)
    (remove (cut = <> idx)
	    (map (cut + <> (* i *width*)) (iota *width*)))))

(define (get-column-idx-list idx)
  (receive (i j) (idx->ij idx)
    (remove (cut = <> idx)
	    (map (lambda (x) (+ j (* x *width*))) (iota *width*)))))

(define get-related-idx-list
  (memoize (lambda (idx) (lset-union equal? (get-region-idx-list idx) (get-row-idx-list idx) (get-column-idx-list idx)))))

;;
(define (delete lst val) ;; remove (resolved? lst)
  (remove (cut = <> (car val)) lst))

(define (block proc)
  (call/cc proc))

(define (clean! board)
  (block (lambda (break)
	   (each-with-index-board
	    (lambda (idx val)
	      (resolve! board idx)
	      (map-with-index-board!
	       (lambda (idx2 lst)
		 (let ((newlst (delete lst val)))
		   (if (null? newlst) (break #f) newlst)))
	       (get-related-idx-list idx) board))
	    (filter (lambda (idx) (resolved? (get-val board idx))) (not-resoleved-idx-lst board)) board)
	   (num-not-resolved board))))

(define (clean-board! board)
  (let loop ((prev-resolved +inf.0))
    (let ((resolved (clean! board)))
      (cond [(not resolved) #f]; backtrack
	    [(or (= resolved prev-resolved) (= resolved 0)) resolved]
	    [else (loop resolved)]))))

(define (resolve init-board)
  (let loop ((stack (list init-board)))
    (when (null? stack) (print "I cannot solve this problem!") (exit))
    (case (clean-board! (car stack))
	[(#f) (loop (cdr stack))]
	[(0) (car stack)]
	[else (loop (append (make-candidates (car stack)) (cdr stack)))])))

(define (main args)
  (if (null? (cdr args))
      (print "file not found")
      (call-with-input-file (cadr args)
	(lambda (iport)
	  (print-board (resolve (init-board (read-board iport))))))))