grubのメニューリストをコンパクトにする。

まだ途中。

/etc/default/grub

diff --git a/grub b/grub
index a5c4c53..eda140c 100644
--- a/grub
+++ b/grub
@@ -21,7 +21,7 @@ GRUB_CMDLINE_LINUX=""
 #GRUB_DISABLE_LINUX_UUID=true
 
 # Uncomment to disable generation of recovery mode menu entries
-#GRUB_DISABLE_LINUX_RECOVERY="true"
+GRUB_DISABLE_LINUX_RECOVERY="true"
+# Uncomment to enable menu entries compact
+GRUB_ENABLE_MENU_COMPACT=true
 # Uncomment to get a beep at grub start
 #GRUB_INIT_TUNE="480 440 1"

/etc/grub.d/10_linux

diff --git a/10_linux b/10_linux
index e5231e4..339fafe 100755
--- a/10_linux
+++ b/10_linux
@@ -113,6 +113,12 @@ EOF
 list=`for i in /boot/vmlinu[xz]-* /vmlinu[xz]-* ; do
         if grub_file_is_not_garbage "$i" ; then echo -n "$i " ; fi
       done`
+
+if [ "x${GRUB_ENABLE_MENU_COMPACT}" = "xtrue" ]; then
+    lines=`echo $list`
+    list=`for i in $lines; do echo $i; done | sort -r | head -n 1`
+fi
+
 prepare_boot_cache=
 
 while [ "x$list" != "x" ] ; do

grub.cfgの作成

なぜか/etc/default/grubに環境変数を追加してもうまくいかない。

sudo update-grub

とりあえず、これでお茶を濁す

sudo GRUB_ENABLE_MENU_COMPACT=true update-grub

time_tをめぐる冒険？

time_tが何にtypeされているか知りたい。
こんなファイルを作成して

foo.c

#include <time.h>
time_t x;

gcc -Eでマクロを展開する。

gcc -E foo.c | grep typedef | grep time_t

long intでした。

typedef long int __time_t;
typedef __time_t time_t;

clojureの再帰とスタックオーバーフロー(remove-first)

たまたまcljureのMLを見ていた時に、nickiktさんという人が

「"scheme-remove-first"という関数を
書いたのだけれど、自分の実装ではstack overflowしてしまうので気に入らない。
誰かだれかもっと良いバージョンを書いてみてくれ

https://groups.google.com/group/clojure/browse_thread/thread/9e400d1381b11665?pli=1

というようなことを書いていたメールを発見しました。
scheme-remove-firstでやりたいことはこんな感じです。

(remove-first 2 '(1 2 3 1 2 3 1 2 3)) ; => (1 3 1 2 3 1 2 3)

名前の通りですね。

実際にnickiktさんが書いた関数はこんな感じでした。

remove-first

(defn remove-first [syb lst]
 (if (empty? lst)
   '()
   (if (= (first lst) syb)
     (rest lst)
     (cons (first lst) (remove-first syb (rest lst))))))

これは明らかによくありませんね。
consとrestでschemeのように再帰させていくかたちですが、スタックを食いつぶしてしまいます。
とりあえずは実装の方法を変えないままにコードを見易くしていきましょう。

clojureのdestructuring(分配束縛)を使って一気に複数の値を束縛できます。これを使いましょう。
ついでに、eとcollという風に引数の名前も変えました。

destructuringを使う。

(let [[x & xs] [1 2 3]]
     (list x xs)) ; => (1 (2 3))

(defn remove-first2 [e coll] 
 (if (empty? coll)
   '()
   (let [[x & coll*] coll]
   (if (= e x) 
     coll*
     (cons x (remove-first2 e coll*))))))

実はclojureにはリストの残りの値を取り出す関数が2つあります。nextとrestです。
違いは、残りの要素が空の場合の結果です。nextはnilを返してrestは空リストを返します。

(next [1]) ; => nil
(rest [1]) ; => ()

もちろん、nilは偽としてあつかわれますね？
ついでに、when-letマクロも使ってみましょう。
これはletによる値の束縛と条件分岐を同時に行なうマクロです。

(when-let [[x & xs] nil]
  (println "success!"))
;; nil

このwhen-letとdestructuringを組み合わせることでもっと簡単に書けるようになります。
(もちろん、今のままではstack overflowすることには変わりません)

when-letを使う

(defn remove-first3 [e coll] 
  (when-let [[x & coll*] coll]
    (if (= e x) coll* (cons x (remove-first3 e coll*)))))

記述がコンパクトになりました。ifの部分を1行にしてしまっても問題ないですね。
わかりやすい記述ができたところで、そろそろ本題のstack overflowをなくしていきましょう。
遅延シークエンスを作るようにして途中で計算を打ちきれるようにします。

stack overflowをなくす

遅延シークエンスを作るにはlazy-seqを使いましょう。
pythonやjavascriptを使っている人にとってのyieldみたいな感じです。

(defn remove-first* [e coll]
  (lazy-seq
   (when-let [[x & xs] coll]
     (if (= e x) xs (cons x (remove-first* e xs))))))

たしかにきれいに短く書けたのですが、clojureの文法を使って短くできただけで
結局のところremove-firstの処理を1から全て実装してしまっています。もっと楽はできないでしょうか？

clojureの標準ライブラリに詳しい人は、「そんなことしなくてもclojure.core/split-withを使えばもっと簡単に書けるよ」
と言うかもしれません。こんな感じですね。

(defn remove-first+ [e coll]
  (let [[left right] (split-with #(not (= e %)) coll)]
    (lazy-cat left (next right))))

確かにsplit-withを使うことで簡単に書けます。しかし問題があります。遅いんです。

(let [xs (range 1 100000)]
  ;;(time (dotimes [i 1000] (remove-first3 99999 xs))) ;;もちろんStackOverflow
    (time (dotimes [i 1000] (remove-first+ 99999 xs)))
    (time (dotimes [i 1000] (remove-first* 99999 xs))))

;; "Elapsed time: 4.098972 msecs"
;; "Elapsed time: 0.818267 msecs"

自分の手で書いた関数に比べてだいぶ遅いですね。
安易なsplit-withの利用は避けるべきです。
どうにかできないでしょうか？

split-withが遅延シークエンスを返さないから問題なのです。
split-withに近い手続きが書けたなら、
split-withを使った時のように関数を使って楽に書くことができそうです。

結局のところ2つに分割した内の残りの部分をひとつ取り除ければ良いのです。
split-withのように条件式をとって、それに対応しなくなったところで止まる手続きを考えましょう。
CPS風に、条件に合致しなくなったところで呼ぶ関数contも一緒にとってあげることにします。

split-with-cont

(defn split-with-cont [p coll cont]
  (lazy-seq 
   (when-let [[x & xs] coll]
     (if (not (p x)) (cont coll) (cons x (split-with-cont p xs cont))))))

ほとんどremove-first+と変わらないような定義ですね。
これを利用して速い関数を作ることができれば、
clojureの関数と文法を使ってより良いremove-firstが作れたと言えるような気がします。

(defn remove-first+2 [e coll]
  (split-with-cont #(not (= e %)) coll next))

nextを渡してあげれば良いわけです。
ただし、split-with-contはsplit-withのように過ぎ去った過去*1をみることができません。

あとは実行時間の比較です。

(let [xs (range 1 100000)]
  (time (dotimes [i 1000] (remove-first+ 99999 xs)))
  (time (dotimes [i 1000] (remove-first+2 99999 xs)))
  (time (dotimes [i 1000] (remove-first* 99999 xs))))

;; "Elapsed time: 4.665175 msecs"
;; "Elapsed time: 0.850143 msecs"
;; "Elapsed time: 0.758958 msecs"

少しおそくなったものの結構良い速度なんじゃないでしょうか?

*1:分配束縛した際の左側のリスト

久しぶりの更新。treeコマンドを作った。

はじまり

何だか最近は更新も滞って何も書いていませんでした。
たまたま、clojureでtreeコマンドを実装しているのをみて作ってみました。

treeコマンドをsequenceだけを使って実装できそうな気がしたのです。
例えば、1,2,3…という数列を作る時には、iterateにincと数字を渡せば良いのと同じように、
上手い具合に、何かの関数とルートになるディレクトリのパスだけ渡して綺麗に書けないかなーと。

(iterate inc 1) ;; (1 2 3 4 ....
(iterate f "<root-directory>") ;; (<root-directory> ... 

コード

reverseが必要だったり、empty?で調べているところが気にくわないのですが完成しました。
30行くらいです。まー、まずまずといったところです。

(ns tool.tree 
  (:import java.io.File))
    
(defn- check-cons [x y]
  (if (empty? x) y (cons x y)))

(defn- dir-files [dir]
  (-> (if (string? dir) (File. dir) dir) .listFiles sort))

(defn files-extend [seqs]
  (let [[[x & xs] & rest] seqs]
    (cond (and x (.isDirectory x)) (check-cons (dir-files x) (cons xs rest))
	  (not x) rest
	  :else (check-cons xs rest))))

(defn- prn-tree-left-side [xs]
  (doseq [x (reverse xs)]
    (print (if (empty? x) "       " "│     "))))

(defn tree [dir]
  (println dir)
  (let [origin (dir-files dir)]
    (doseq [[xs & seqs] (take-while identity (iterate files-extend [origin]))]
      (when-let [[x & xr] xs]
	(prn-tree-left-side seqs)
	(let [prefix (if (empty? xr) "└── " "├── ")]
	  (println prefix (.getName x)))))))

(->> *command-line-args* (map tree) dorun)

123-45-67+89=100

http://d.hatena.ne.jp/fortran66/20100502/1272731623
を見て面白そうだったのでやってみました。
方法は単純でルールの中で存在する可能性のある全ての式を作ってそれをevalするというもの。

Rule

• 問題は、１ ２ ３ ４ ５ ６ ７ ８ ９ のどこかに数学記号を３つ入れて答えが１００になるようにする
• 記号は複数回使って良い
• 数字は並べ替えちゃだめ

Code

(use srfi-42)
(use srfi-1)

(define (list->number xs)  ;;(<> '(1 2 3)) -> 123
  (fold (lambda (x n) (+ (* n 10 ) x)) 0 xs))

(define (add-tag tag xs) (cons tag xs))

(define (divide-n n xs) ;;n個のしきりで分割(tree)
  (cond ((= n 0) (list (add-tag 'number xs)))
	(else
	 (append-ec (: i 1 (length xs)) 
		    (receive (lhs rhs) (split-at xs i)
		      (cond ((= n 1) (map (cute list 'OP  <> (add-tag 'number rhs))
					  (divide-n(- n 1) lhs)))
			    (else
			     (append (map (cute list 'OP  <> (add-tag 'number rhs))
					  (divide-n(- n 1) lhs))
				     (map (cute list 'OP (add-tag 'number lhs) <>)
					  (divide-n(- n 1) rhs))))))))))

(define (transform ops tree) ;;OPを+ * - /などに(number 1 2 3)を123に変えた形に変換
  (match tree
    [('number . xs) (list (list->number xs))]
    [('OP x y)
     (list-ec (: op ops) (: lhs (transform ops x)) (: rhs (transform ops y))
	      (list op lhs rhs))]))

(define (find-answer ans ops n xs)
  (let1 env (interaction-environment)
    (filter (lambda (exp) (= ans (eval exp env)))
	    (append-map (cut transform ops <>) (divide-n n xs)))))

(define (unwrap-procedure tree);;#<subr +>のような表示を+に変える。
  (map (lambda (x)
	 (cond ((list? x) (unwrap-procedure x))
	       ((procedure? x) (procedure-info x))
	       (else x)))
       tree))

(define (solve ans n)
  (for-each (compose print unwrap-procedure)
	    (find-answer ans (list + * / -) n (iota 9 1))))

(solve 100 3)

;; gosh> (- 123 (+ 45 (- 67 89)))
;; (- 123 (- (+ 45 67) 89))
;; (+ (- 123 (+ 45 67)) 89)
;; (+ (- (- 123 45) 67) 89)

lazy-sequenceって重要ですね＞＜

http://d.hatena.ne.jp/kencoba/20100405/1270433351
速度が全然違う＞＜

(defn move [a b]
  ['move a 'to b])

(defn hanoi [a b c n]
  (if (< n 1)
    nil
    (if (= n 1)
      (list (move a c))
      (concat (hanoi a c b (- n 1))
              (cons (move a c)
                    (hanoi b a c (- n 1)))))))

(defn hanoi-seq [a b c n]
  ((fn step [a b c n]
     (lazy-seq
      (cond (< n 1) nil
	    (= n 1) (list (move a c))
	    :else (lazy-cat (step a c b (- n 1))
			    (list (move a c))
			    (step b a c (- n 1))))))
   a b c n))

(defn h [fun n] (fun 'a 'b 'c n))

(defn check [n]
  (empty?
   (remove identity
	   (map (fn [i] (= (h hanoi i) (h hanoi-seq i)))
		(take n (iterate inc 1))))))

(check 15)  ; => true
(time (do (h hanoi 15) 'end)) ; => "Elapsed time: 5.448703 msecs"end
(time (do (h hanoi-seq 15) 'end)) ; => "Elapsed time: 0.054197 msecs"end

まー、単に評価されていないだけなんですけど

(time (do (dorun (h hanoi 15)) 'end)) ; => "Elapsed time: 61.193063 msecs"end
(time (do (dorun (h hanoi-seq 15)) 'end)) ; => "Elapsed time: 150.73996 msecs"end

そういえばOnLispに!ってマクロありましたね。

schemeだとfuncallが要らなくなるので綺麗になると書かれていたけれど…使い道が思いつかない。

(define-module onlisp-macros
  (use srfi-1) ;filter
  (module-exports !))
(select-module onlisp-macros)
  
(define *!-table* (make-hash-table))

(define-macro (! fun)
  (hash-table-get *!-table* fun))

(let ((src (apply append (map module-exports (all-modules))))
      (env (interaction-environment)))
  (for-each (lambda (x) 
	      (let1 x* (string->symbol (regexp-replace #/!$/ (symbol->string x) ""))
		(hash-table-put! *!-table* x* (eval x env))))
	    (filter (lambda (x)  (#/!$/ (symbol->string x))) src)))

;; (define xs (iota 10))
;; ((! span) even? xs)
;; xs ; => (0)