2010/10/29

Emacs Lisp : complement

述語を反転させるアレですね。(complement equal) とやると (lambda args (not (apply equal args))) が返るような高階関数です。

Scheme を書いている時によく使います。定義も簡単なので、無ければすぐ書けます。たまたま今日は Emacs Lisp で自前の関数を書いている時に complement が欲しかったので、書こうとしたらしばらくハマりました。。無ければ無いでよかったんですが、この際自前の Emacs Lisp 関数を定義したファイルに書き加えておいても良いかなと思い、書くことにしたのです。

デフォルトがダイナミックスコープである点にやられました。やはりデフォルトはレキシカルスコープでスペシャル変数や fluid-let などを用意してある方が良いなぁと思うわけです。慣れなんでしょうけどね。
(defun complement (f)
  (lexical-let ((f f))
    (lambda (&rest args)
      (not (apply f args)))))

(defun not-equal (x y)
  (funcall (complement #'equal) x y))

(funcall #'not-equal "" "a")
;; -> t

追記

検索したら素敵なページがあった!complement だけでなく fold や compose も再帰ではなく反復で定義してあるし、any, every, filter, take-while などなど Schemer 歓喜!

自分でちくちく書く必要はなかったようです。

Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

2010/10/28

gist を blog に embed する時の見た目や色(CSS) を変える

blog に gist を貼り付けることが多いです。見た目を変えたいなぁと思っていたのでやってみました。
参考にしたのはこちら。

色合いは自分の Emacs のハイライトを htmlize.el したものを参考にしてやってみました。やってみたんですが、どうにもクドイので実際にこのまま使うか迷っています。
こんな感じ。


css

用意した css は以下のものです。

余談ですが

Emacs では color-theme.el の midnight を少し変更したものを使っています。
;; color theme
(require 'color-theme nil t)
(color-theme-initialize)
(color-theme-midnight)
(set-face-background 'region "blue4")
(set-face-background 'trailing-whitespace "purple4")
(set-face-background 'modeline-buffer-id "grey5")
(set-face-foreground 'modeline-buffer-id "maroon2")
(set-face-background 'mode-line "grey20")
(set-face-foreground 'mode-line "grey75")
(set-face-background 'mode-line-inactive "grey3")
(set-face-foreground 'mode-line-inactive "grey35")
(set-face-background 'secondary-selection "red")
(set-face-underline-p 'modeline nil)
(custom-set-faces
 '(font-lock-comment-face ((t (:italic nil :foreground "slate gray")))))

Scheme のハイライトは quack.el の pltish を少し変更しています。
;; quack
(custom-set-faces
 '(quack-pltish-keyword-face ((t (:bold t :foreground "maroon2"))))
 '(quack-pltish-defn-face ((t (:bold t :foreground "darkgoldenrod3"))))
 '(quack-threesemi-semi-face ((t (:bold t :foreground "blue"))))
 '(quack-threesemi-text-face ((t (:bold t :foreground "blue")))))

追記

gist のハイライトの変更は止めました。




Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

2010/10/22

vector-iota

(vector-iota 10)
;; #(0 1 2 3 4 5 6 7 8 9)
(vector-iota 10 10)
;; #(10 11 12 13 14 15 16 17 18 19)
(vector-iota 10 0 2)
;; #(0 2 4 6 8 10 12 14 16 18)



追記

@valvallow (use srfi-42)(define (vector-iota c :optional(b 0)(s 1))(vector-ec(: x b (+ b(* s c))s)x)) 内包表記ってドキュメントがよくわかんないですよね。
(use srfi-42)

(define (vector-iota c :optional(b 0)(s 1))
  (vector-ec (: x b (+ b (* s c)) s) x))

(vector-iota 10 1 3)
;; #(1 4 7 10 13 16 19 22 25 28)
内包表記、使いこなせねぇー!

プログラミングGauche

2010/10/20

熊本 #Emacs 的何か #Ekumacs !

正式アナウンスです。熊本でEmacsにまつわる何かをする会を企画しています。興味のある方はリプライください。ハッシュタグは #ekumacs にしようと思います。

技術系の勉強会や集まりがあまりなかった熊本でもいろいろ始まってきましたね!良いことだ!やったー!
私が知っている限りではこの辺りですが、Android に Ruby に Lisp に、今回 Emacs と・・・。結構とんがってるね熊本!

追記


Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

2010/10/15

Scheme で数独を解く

明日で 25 回目となる 9LISP(もはや言語は Lisp に限らない、という状態ですが(笑))の宿題が、「数独を解くプログラム」なのでやってみました。Scheme (Gauche)で書きました。

まず数独を良く知らなかったのでそこから。

簡単な問題を解いてみるとこんな具合。
(define test-data-1
  '((7 8 0 5 2 0 0 0 6)
    (9 0 0 0 0 3 0 7 5)
    (0 0 5 0 0 6 0 4 0)
    (0 0 4 0 6 1 3 0 2)
    (1 0 0 9 0 0 0 0 7)
    (8 0 2 0 7 0 6 0 0)
    (0 5 0 2 0 0 8 0 0)
    (6 3 0 4 0 0 0 0 1)
    (2 0 0 0 3 7 0 5 9)))

(define test-data-1-ans
  '((7 8 1 5 2 4 9 3 6)
    (9 4 6 1 8 3 2 7 5)
    (3 2 5 7 9 6 1 4 8)
    (5 7 4 8 6 1 3 9 2)
    (1 6 3 9 4 2 5 8 7)
    (8 9 2 3 7 5 6 1 4)
    (4 5 7 2 1 9 8 6 3)
    (6 3 9 4 5 8 7 2 1)
    (2 1 8 6 3 7 4 5 9)))

(define test-data-2
  '((0 0 7 0 4 0 0 0 0)
    (0 3 0 9 1 0 6 2 0)
    (0 0 0 7 0 0 3 8 4)
    (2 4 9 0 7 1 5 3 6)
    (1 5 0 0 0 0 0 7 8)
    (0 0 8 5 0 0 0 9 1)
    (0 9 2 0 8 4 7 5 3)
    (0 8 0 6 0 2 1 4 9)
    (5 1 4 3 0 0 0 6 2)))

(define test-data-2-ans
  '((8 6 7 2 4 3 9 1 5)
    (4 3 5 9 1 8 6 2 7)
    (9 2 1 7 6 5 3 8 4)
    (2 4 9 8 7 1 5 3 6)
    (1 5 6 4 3 9 2 7 8)
    (3 7 8 5 2 6 4 9 1)
    (6 9 2 1 8 4 7 5 3)
    (7 8 3 6 5 2 1 4 9)
    (5 1 4 3 9 7 8 6 2)))

(time (equal? (backtrack-solver test-data-1)
              test-data-1-ans))
; real   0.109
; user   0.094
; sys    0.000
;; #t

(time (equal? (backtrack-solver test-data-2)
              test-data-2-ans))
; real   0.172
; user   0.125
; sys    0.015
;; #t
とても遅いですね。。

バックトラックで解く方の実装がだいぶ残念な感じですが、一応「数学のエキスパートが3ヶ月かけて作成した「世界一難しい数独」 - GIGAZINE」も解けました。遅いですが。
(define most-difficult-data
  '((0 0 5 3 0 0 0 0 0)
    (8 0 0 0 0 0 0 2 0)
    (0 7 0 0 1 0 5 0 0)
    (4 0 0 0 0 5 3 0 0)
    (0 1 0 0 7 0 0 0 6)
    (0 0 3 2 0 0 0 8 0)
    (0 6 0 5 0 0 0 0 9)
    (0 0 4 0 0 0 0 3 0)
    (0 0 0 0 0 9 7 0 0)))

(define most-difficult-data-ans
  '((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)))

(time (equal? (backtrack-solver most-difficult-data)
              most-difficult-data-ans))
; real  15.438
; user  15.375
; sys    0.047
;; #t

amb とか cps を使ってできそうな気がしたので、四苦八苦しながらやってみましたが、結局できずこの有様・・・。明日の 9LISP が終わってからまた改めて考えてみます。


ということで、とりあえずさらしておきます。
全景はこんな感じ。
(use srfi-1) ; drop, split-at
(use srfi-9) ; define-record-type
(use util.list) ; slices
(use liv.matrix) ; matrix-*, *-matrix

(define-constant region-size 3)
(define-constant fullset-numbers (iota (* region-size region-size) 1))

(define (single? ls)
  (and (pair? ls)
       (null? (cdr ls))))

;; matrix x or y -> region position
(define (region-pos mn)
  (quotient mn region-size))

;; mmatrix x and y -> region index
(define (region-index mx my)
  (+ (region-pos mx)
     (* region-size
        (region-pos my))))

(define (region-ref region n)
  (list-ref region n))

(define (slice-matrix-rows matrix size)
  (map (lambda (row)
         (slices row size)) matrix))

(define (matrix->regions matrix size)
  (let1 sliced (slice-matrix-rows matrix size)
    (let rec ((m sliced)(acc '()))
      (if (null? m)
          (apply append (reverse acc))
          (receive (took dropped)(split-at m size)
            (rec dropped (cons (apply map append took) acc)))))))

(define (candidates matrix x y . keywords)
  (let-keywords* keywords ((eq? =)
                           (empty? zero?)
                           (ignore '()))
    (let1 f (pa$ filter (complement empty?))
      (let* ((row-candidates (f (matrix-row-ref matrix y)))
             (col-candidates (f (matrix-col-ref matrix x)))
             (region-candidates (f (region-ref (matrix->regions matrix region-size)
                                               (region-index x y)))))
        (lset-difference eq? fullset-numbers row-candidates
                         col-candidates region-candidates
                         ignore)))))

(define (has-empty? matrix :optional (empty? zero?))
  (let/cc hop
    (fold (lambda (row acc)
            (if-let1 it (any empty? row)
                     (hop it)
                     acc)) #f matrix)))

;;
;; naked single solve
;;

(define (fix-naked-singles matrix . keywords)
  (let-keywords* keywords ((empty? zero?)
                           (car car))
    (let1 exist? #f
        (values (map-matrix-with-index
                 (lambda (e x y)
                   (if (empty? e)
                       (let1 can (candidates matrix x y)
                         (if (single? can)
                             (begin
                               (unless exist?
                                 (set! exist? (not exist?)))
                               (car can))
                             e))
                       e)) matrix)
                exist?))))

(define (fix-naked-singles-solver matrix
                                  :optional (more identity))
  (let rec ((m matrix))
    (receive (cand exist?)(fix-naked-singles m)
      (cond (exist? (rec cand))
            ((has-empty? cand)(more cand))
            (else cand)))))

;;
;; backtrack solver
;;

(define-record-type point
  (make-point x y) point?
  (x point-x)
  (y point-y))

(define (backtrack-solver matrix)
  (let/cc hop
    (let ((mstack '())(cstack '())(pstack '())(count 0))
      (let backtrack ((m (matrix-copy matrix))(bt-cand '())
                      (bt-point (make-point -1 -1)))
        (for-each-matrix-with-index
         (lambda (e x y)
           (when (zero? e)
             (let1 cand (if (and (= x (point-x bt-point))
                                 (= y (point-y bt-point)))
                            bt-cand
                            (candidates m x y))
               (cond ((null? cand)
                      (inc! count)
                      (backtrack (pop! mstack)
                                 (pop! cstack)
                                 (pop! pstack)))
                     ((single? cand)
                      (matrix-set! m x y (car cand)))
                     (else
                      (push! mstack (matrix-copy m))
                      (push! cstack (cdr cand))
                      (push! pstack (make-point x y))
                      (matrix-set! m x y (car cand))))))) m)
        (hop m count)))))

追記

@aharisu さんが scheme で書いたものは、私が書いたものと比べて 3 ~ 7 倍高速でした!

追記2

@kikuchan98 さんによる実装。短くて美しくて速い!流石っす。amb 使ってあります。しかもこれが scheme で書いた初めてのコードらしいです・・・。

プログラミングGauche

2010/10/14

ちょっと考えてみたけど、やっぱボツだった accum

これを読んで、以前再帰とか S 式に慣れるために何度も書いたことを思い出しました。
SICPThe Little Schemer にも登場しますね。

とりあえず、Scheme で改めて書いてみました。

Common Lisp だと、こうでしょうか。

或いはこう?(仕様を満たせていませんね・・・)


書いているうちに、こういうのがあったら良いんじゃないかなぁ、と思いました。
(hoge pred calc acc dec i) ==
(if (pred i)
    acc
    (hoge pred calc (calc i acc) dec (dec i)))

パッと見 unfold に似てるので、unfold で無理やり書いてみました。

やはり unfold では強引な気がしたので試しに accum というのを定義してみました。

試しに fizzbuzz を書いてみたり。

いまいち。ちょっと変更。

それでもいまいち。きっともっとちゃんと抽象化されたものがどこかにあるはず。。

追記

調べたら、ちょっと前に unfold で書いてた。今日書いたものより、こっちの方が良い・・・。


Scheme手習い

Common Lisp の loop マクロ

難しい。すごく柔軟で便利だと聞くけど、個人的な印象では融通が効かないなぁと感じている次第です。きっと慣れないせいなんだきっと。。
やっぱ named let でいいじゃん・・・。と思ってしまいます。再帰かわいいよ再帰。
その点、Common Lisp はほとんどの処理系が末尾呼び出し最適化をしてくれるらしいので良いとして、Emacs Lisp てめぇは(ry


実践Common Lisp

2010/10/12

Emacs Lisp: intersperse

まぁ、こうやって自前で用意しなくてもあるんでしょうが・・・。
(defun single? (ls)
  (and (not (null ls))
       (null (cdr ls))))

(defun intersperse (item ls)
  (pair-fold1 #'(lambda (pr acc)
                  (if (single? pr)
                      (cons (car pr) acc)
                      (cons item (cons (car pr) acc))))
              '() (reverse ls)))
ELISP> (intersperse " " '(1 2 3))
(1 " " 2 " " 3)

Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

Emacs Lisp: fold に続いて pair-fold

ちょっと強引ですが。。
(defun pair-fold1 (proc seed ls)
  (loop
     for e on ls by #'cdr
     for acc = (funcall proc ls seed)
     then (funcall proc e acc)
     finally (return acc)))

Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

Emacs Lisp の cl package には loop マクロがあるので、取りあえず fold もどきを定義

loop マクロに慣れないので、取りあえずその場しのぎ的に fold を。。
(defun fold1 (proc seed ls)
  (loop for e in ls
     for acc = seed then (funcall proc e acc)
     finally (return acc)))

そういえば、先日知ったんですが、M-x ielm で Emacs Lisp の REPL が立ち上がるみたいですね。
ELISP> (fold1 #'* 1 '(1 2 3 4 5))
120
ELISP> (fold1 #'cons '() '(1 2 3 4 5))
(5 4 3 2)

あと unfold と pair-fold 辺りを用意しとけばある程度困らないかも・・・?

Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

2010/10/08

JavaScript の継続(continuation)によるループ

ちょっと試してみました。JavaScript の処理系は Rhino(Rhino 1.7 release 2 2009 03 22) です。

Continuation を使って sum を定義してみました。
function callcc (f){
  return f(new Continuation());
}

function identity (x){
  return x;
}

function sum (n){
  var i = 0;
  var total  = 0;
  var hop = new Continuation();
  var next = callcc(identity);

  if (n < i){
    hop(total);
  } else {
    total += i;
    ++i;
    next(next);
  }
}

sum(10);
// -> 55

loop 関数にしてみました。loop 関数を使って sum と fact を定義してみました。期待通りに動いているようです。
function loop (func){
  var hop = new Continuation();
  var next = callcc(identity);
  func(hop);
  next(next);
}

function fact (i) {
  var acc = 1;
  return loop (function (hop){
                 if (i === 0){
                   hop(acc);
                 } else {
                   acc *= i--;
                 }
               });
}

fact(10);
// 3628800

function sum (i) {
  var acc = 0;
  return loop (function (hop) {
                 if (i === 0){
                   hop(acc);
                 } else {
                   acc += i--;
                 }
               });
}

sum(10);
// 55

accum を定義。
function accum (i, pred, afunc, ifunc, seed){
  var acc = seed;
  return loop (function (hop){
                 if (pred(i)) {
                   hop(acc);
                 } else {
                   acc = afunc(i, acc);
                   i = ifunc(i);
                 }});
}

function zerop (i){
  return i === 0;
}

function dec (i){
  return --i;
}

function mul (x, y){
  return x * y;
}

function plus (x, y){
  return x + y;
}

function sum (i){
  return accum (i, zerop, plus, dec, 0);
}

function fact (i){
  return accum(i, zerop, mul, dec, 1);
}

sum(10);
// -> 55
fact(10);
// -> 3628800


while を使えば良い話なんですけどね。

JavaScript 第5版

2010/10/06

新しい「Scheme手習い」amazonに並んだっぽい!

Scheme手習い


絶版になった旧版の方、高けぇ(笑)表紙はどんなのだったんだろう。

追記


原書はこちら。
The Little Schemer, 4th Edition

Emacs で JavaScript (js2.el, js-comint.el)


掲題の設定をさらしておこうかと。雑な設定ですけども。。実際の画面は上の画像の通りです。

参考にしたのはこちら。
ポイントは js2-mode-hook に以下の一行を加えていることくらいでしょうか。
(local-set-key "\C-c\C-r" 'js-send-region)
region を js の repl に送るコマンドです。

(require 'js-comint)
(setq inferior-js-program-command "java org.mozilla.javascript.tools.shell.Main")
(add-hook 'js2-mode-hook '(lambda ()
                            (local-set-key "\C-x\C-e" 'js-send-last-sexp)
                            (local-set-key "\C-\M-x" 'js-send-last-sexp-and-go)
                            (local-set-key "\C-cb" 'js-send-buffer)
                            (local-set-key "\C-c\C-b" 'js-send-buffer-and-go)
                            (local-set-key "\C-cl" 'js-load-file-and-go)
                            (local-set-key "\C-c\C-r" 'js-send-region)
                            ))

(when (load "js2" t)
  (setq js2-cleanup-whitespace nil
        js2-mirror-mode nil
        js2-bounce-indent-flag nil)
  (defun indent-and-back-to-indentation ()
    (interactive)
    (indent-for-tab-command)
    (let ((point-of-indentation
           (save-excursion
             (back-to-indentation)
             (point))))
      (skip-chars-forward "\s " point-of-indentation)))
  (define-key js2-mode-map "\C-i" 'indent-and-back-to-indentation)
;;  (define-key js2-mode-map "\C-m" nil)
  (add-to-list 'auto-mode-alist '("\\.js$" . js2-mode)))
(setq-default c-basic-offset 4)
(defun js-other-window ()
  "Run JavaScript on other window"
  (interactive)
  (split-window-horizontally 80)
  (let ((buf-name (buffer-name (current-buffer))))
    (js2-mode)
    (run-js inferior-js-program-command)
    (switch-to-buffer-other-window
     (get-buffer-create buf-name))))
;; (define-key global-map
;;    "\C-cj" 'js-other-window)


Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

Re: javascript - にも無限リストを (遅延ストリーム pipe 編)

PAIP(実用 Common Lisp (IT Architects’Archive CLASSIC MODER))に載ってる pipe は JavaScript でもいけそうだなぁと思って書いてみました。わりと強引に書きました。JavaScript には Lisp/Scheme のマクロのように引数の評価を遅らせるような機能(?)がないので、しかたなく呼び出し側で無名関数で包みました。よくないスタイルですが、取りあえず動くので良いんじゃないでしょうか。他に何か良い方法があれば、教えていただけると助かります。

で、その pipe でエラトステネスの篩をやってみると以下のような感じです。
var primes = sieve(integers(2));
enumerate(primes, 10);
// ->  [2,3,5,7,11,13,17,19,23,29,31,function () { return filter(pred, tail(pipe));}]

JavaScript による pipe とエラトステネスの篩のソースは以下のもの。JavaScript っぽさとかないかもしれませんし、突っ込みどころも多々あるでしょうが多めに見てください。。


階乗のリストだとこうでしょうか。
function facts (pipe) {
  var rec = function (p, acc){
    var h = head(p);
    var cur = 0 === h ? 1 : h * acc;
    return makePipe(cur, function () { return rec(tail(p), cur); });
  };
  return rec(pipe, 1);
}

enumerate(facts(integers(0)), 5);
// -> [1,1,2,6,24,120,function () { return rec(tail(p), cur); }]

enumerate(facts(integers(0)), 10);
// [1,1,2,6,24,120,720,5040,40320,362880,3628800,function () { return rec(tail(p), cur); }

ところで

JavaScript の生みの親であるブレンダン・アイクが、実は
ブラウザで動く Scheme が作れると聞いて!
ということでネスケに入ったなんて話もあるらしいですね。
伝統的なマクロじゃないにしろ、それっぽいものがあったら JavaScript ももっと強力だったでしょうに。

そういえば

Rhino だと Scheme 由来の継続(continuation)や let が使えるそうで。
Scheme 以外で明示的に継続に触れたことが無いので、試して見ます。
(ruby にも call/cc があるんでしたっけ)

例えば、何の変哲もない、というかただ再帰するだけの deep 関数を例に取ると、
function deep (n){
  var ret;
  if (n === 0){
    ret = n;
  } else {
    ret =  deep(n - 1);
  }
  print(n);
  return ret;
}
deep(10);
/*
0
1
2
3
4
5
6
7
8
9
10
0
*/

再帰の基底条件に達した後は、今まで潜った再帰を戻るわけですよね。そのときに n が print されている状態です。
で、継続のお決まりの例である脱出をしてみたいので、以下のように書き換えて見ます。

ポイントは、実際の再帰を内部で定義した rec 関数に任せている点と、deep の先頭で継続オブジェクトを取得している点。
function deep (n){
  var cont = new Continuation();
  var rec = function (n){
    var ret;
    if (n === 0){
      ret = n;
      cont(ret);
    } else {
      ret =  rec(n - 1);
    }
    print(n);
    return ret;
  };
  return rec(n);
}

deep(10);
// -> 0
print されませんね。結果である 0 だけが表示されています。この結果が意図通りのものです。

基底条件に達した時点で保存しておいた継続に結果を渡して呼び出しているので、潜った再帰はなかったことに。なかったことに、と言うと語弊があるでしょうか。まぁ、気になったら Scheme でもやってみてください。

一応確認するために、rec の下で print すると、ちゃんと再帰していることがわかります。基底条件、つまり最深部まで再帰を潜って cont に渡された値が cont が宣言された以降の処理の結果となるわけです。何を言ってるかわから(ry。
function deep (n){
  var cont = new Continuation();
  var rec = function (n){
    print(n);
    var ret;
    if (n === 0){
      ret = n;
      cont(ret);
    } else {
      ret =  rec(n - 1);
    }
    print(n);
    return ret;
  };
  return rec(n);
}
deep(10);
/*
10
9
8
7
6
5
4
3
2
1
0
0
 */

追記

あ、今回使った JavaScript の処理系は
Rhino 1.7 release 2 2009 03 22
です。

Emacs + Rhino + js2.el + js-comint.el 最強です。

追記2

いつも教えて頂いてます!ありがとうございます!
@valvallow ジェネレータが実装されてない処理系も多いみたいですね。 とりあえず、無限リストとかの考え方は無視して典型的な JavaScript らしい書き方で書いてみました。 http://gist.github.com/613523


実用 Common Lisp (IT Architects’Archive CLASSIC MODER)

ソースコードハイライト htmlize.el

教えて頂きました!
@valvallow emacs の表示をそのまま html 化する elisp コード htmlize というのがあります。 http://bit.ly/IdlEc もし html を貼れるブログならこういうのもアリかも。
これはイイかも!!
(define (fact n)
  (if (zero? n)
      1
      (* n (fact (- n 1)))))

(fact 10)
;; 3628800

;; --------------------------------

(use srfi-1)
(define (fact n)
  (fold * 1 (unfold zero? identity (lambda (n)
                                     (- n 1)) n)))

(fact 10)
;; 3628800


Emacsテクニックバイブル ~作業効率をカイゼンする200の技~

2010/10/05

ソースコードハイライト highlight.js

blogger でのコードハイライトは悩みますよね・・・。Lisp/Scheme に関しては google code prettify もいまいちですし。いまいちというか、全然ダメですよね。
最近はずっと gist にアップしたものを貼り付けていました。しかし、毎度毎度小さなコード片までもアップすることに嫌気がさしていたので、どうにかならないものかと思っていました。

そこで、再度探してみたら highlight.js というものがあったので、下記の記事で試してみました。
いろいろなテーマがあるようです。
しばらくは背景が黒の sunburst にしてみます。
(use srfi-1)
(define (fact n)
  (fold * 1 (unfold zero? identity (lambda (n)
                                     (- n 1)) n)))

(fact 10)
;; 3628800

追記

全然ダメなのは使い方みたい。。もっかい google code prettify を使ってみることにします。

追記2

結局、以下を参考に google code prettify にしました。

追記3

結局 google code prettify もやめて、これにしました。
(define (fact n)
  (if (zero? n)
      1
      (* n (fact (- n 1)))))

(fact 10)
;; 3628800


JavaScript 第5版

2010/10/04

plus1

学生さんもカッコだらけの言語が宿題に出るなんて大変ですね。
;; (plus1 5) =&gt; error 発生
;; (plus1 '()) =&gt; ()
;; (plus1 '(5)) =&gt; (6)
;; (plus1 '(1 2 3 7)) =&gt; (2 3 4 8)

;; map
(define (plus1 ls)
  (map (lambda (n)
         (+ n 1)) ls))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)


;; unfold
(use srfi-1)
(define (plus1 ls)
  (unfold null?
          (lambda (ls)
            (+ (car ls) 1))
          cdr ls))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)


;; recursive
(define (plus1 ls)
  (if (null? ls)
      '()
      (cons (+ 1 (car ls))
            (plus1 (cdr ls)))))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)


;; tail call recursive
(define (plus1 ls)
  (let rec ((ls ls)(acc '()))
    (if (null? ls)
        (reverse acc)
        (rec (cdr ls)(cons (+ (car ls) 1) acc)))))

(plus1 5)
;; error
(plus1 '())
;; ()
(plus1 '(5))
;; (6)
(plus1 '(1 2 3 7))
;; (2 3 4 8)





;; (min 5) =&gt; error発生
;; (min '()) =&gt; error
;; (min '(20 15)) =&gt; 15
;; (min '(30 5 90 25)) =&gt; 5

(define (min ls)
  (if (null? ls)
      (error)
      (fold (lambda (e ret)
              (if (&lt; e ret)
                  e
                  ret))(car ls) ls)))

(min 5)
;; error
(min '())
;; error
(min '(20 15))
;; 15
(min '(30 5 90 25))
;; 5

(define (min ls)
  (if (null? ls)
      (error)
      (let rec ((ls ls)(ret (car ls)))
        (if (null? ls)
            ret
            (rec (cdr ls)(if (&lt; (car ls) ret)
                             (car ls)
                             ret))))))

(min 5)
;; error
(min '())
;; error
(min '(20 15))
;; 15
(min '(30 5 90 25))
;; 5
The Little Schemer, 4th Edition