M-OZ BLOG

Scheme-users.jpTwitter

# 2010/01/26(Tue) : Scheme Quiz 1 問目
Twitter にて Scheme を使ったクイズを出題した。

baal:スキームクーイズ!さて突然ですがここで Schemer の皆さんに問題です。
Q1. リストの最初の要素を car と list-ref を使わず取り出してください。

A. SRFI-1 の first を使う。

A. reverse して最後の要素を match で取り出す。

A. 頭に何か cons して cadr を使う。

A. (apply (lambda (x . _) x) xs)

A. (apply #'identity (last (reverse x))) ;CL?

A. (dolist (i l) (return i)) ;CL?

A. (def mycar (l) (ccc[map _ l])) ;Arc

A. (call/cc (λ (c) (for-each (λ (x) (c x)) xs)))

A. (vector-ref (list->vector xs) 0)

A. (call/cc (cut map <> l))

A. (find idfn l) ;Arc

A. (find-if'identity l) ;CL

A. (find-if (constantly t) l) ;CL

A. (find[+]l) ;Arc?

A. (find[*]l) ;Arc?

A. (define (my-car lst) (set-cdr! lst '()) (apply (lambda (x) x) lst))

A. (find (lambda _ #t) '(a b c))

A. (reduce-right (lambda (x . _) x) #f lst)

A. (define-syntax syntax-car (syntax-rules () ((_ (a . _)) a)))

A. (syntax->datum (syntax-case lst () [(x . _) #'x]))

# 2010/01/20(Wed) : Vim からつぶやく。
Vim からつぶやく。

mztweet.scm

(define (main . args)
 (if (pair? args)
  (tweet *id* *pw* (car args))))

$VIMRUNTIME/autoload/mylib.vim

function mylib#MzTweet(...)
 let msg = getline('.')
 if a:0 > 0
  let msg = a:1
 endif
 if len(msg) > 0
  echo system("mztweet \"" . msg . "\"")
 endif
endfunction

:call mylib#MzTweet()
# 2010/01/15(Fri) : MzScheme でつぶやく
MzScheme で twitter に投稿するプログラムを書いてみた。

(require net/url
  net/uri-codec
  net/base64)

(define (tweet id pw msg)
 (let ((port
   (post-pure-port
    (string->url (string-append
     "http://twitter.com/statuses/update.xml?"
     (alist->form-urlencoded `((status . ,msg)))))
    #f
    (list (string-append "Authorization: Basic "
     (bytes->string/utf-8 (base64-encode
      (string->bytes/utf-8 (string-append id ":" pw)))))))))
  (display-pure-port port)
  (close-input-port port)))

(tweet id password message)

ポイントは POST なのに GET 風にパラメータを送ってるところ。
# 2009/05/31(Sun) : SONY SRS-M50 購入
MacBook と iPhone のためにアクティブスピーカーを購入。
事前にネットで調べて SONY の SRS-M50 にした。
評判通りのなかなか良い音に満足。

20090531.jpg
# 2009/04/26(Sun) : Macbookを買いました。
Macbookを買いました。
ポリカーボネートの白のやつ。
届いたのは二週間くらい前なんだけど、まだあんまり触れてない。
ちょっとづつ手探りで環境を整えているところ。

Apple Developer Connection
* http://developer.apple.com/jp/
 Xcode という開発ソフトをダウンロード。

MacPorts
* http://www.macports.org/
 Unix系ソフトをいろいろダウンロード。

MacVim
* http://code.google.com/p/macvim/
 MacOSX版Vimはここでダウンロード。
 日本語もOK!
# 2009/04/22(Wed) : [MEMO] VB.NETで外部DLLを動的に呼び出す
おしごとめも。
Dim asm As System.Reflection.Assembly
asm = System.Reflection.Assembly.LoadFrom("plugins\PluginTest.dll")
Dim plgin As Object
plgin = asm.CreateInstance("PluginTest.PluginTestClass")
Dim params() As Object = {}
Dim mi As System.Reflection.MethodInfo
mi = plgin.GetType.GetMethod("Open")
mi.Invoke(plgin, params)
# 2009/03/21(Sat) : Twitter はじめました。
Twitter はじめました。
http://twitter.com/baal5084
# 2009/03/07(Sat) : iPhone 3G (16GB WHITE) 買ってきた。
急にものすごく欲しくなって iPhone 3G (16GB WHITE) 買ってしまった。
iPhone 3G
# 2009/02/05(Thu) : Scheme を作ろう 9
Y Combinator が動くようになった。
未だにコレの原理が理解できてないけど、動いた。

 (define Y
  (lambda (f)
   ((lambda (proc)
    (f (lambda (arg) ((proc proc) arg))))
   (lambda (proc)
    (f (lambda (arg) ((proc proc) arg)))))))
 (define fact
  (lambda (f)
   (lambda (n)
    (if (= 0 n) 1 (* n (f (- n 1)))))))
 ((Y fact) 5)
 ;=> 120
# 2009/02/03(Tue) : Scheme を作ろう 8
再帰ができるようになった。
(begin
(define f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))
(f 8))
;=> 40320
# 2009/01/26(Mon) : Scheme を作ろう 7
↓このへんを参考に lex + yacc 勉強中。

http://www.linux.or.jp/JF/JFdocs/Lex-YACC-HOWTO.html

なかなか面白い仕組みだ。
パーサは flex + bison で作ろうと思う。
# 2009/01/19(Mon) : Scheme を作ろう 6
ごくごく単純なLisp処理系が出来てきた。
こうなるとMy処理系向けプログラムを書きたくなってくるんだけれど...
まだパーサは書けてないので、
例えば 1 + 2 を計算するプログラムはこんな感じになる。

CONS(make_symbol("+"),CONS(make_number(1),CONS(make_number(2),NIL)))
;-> 3

パーサがほしいな。
lex とか yacc とかいうソフトを使うのがセオリーらしい。
Flex と GNU Bison というのもよく使われてるようだ。
# 2009/01/04(Sun) : 2009年の目標
あけましておめでとうござます m(_ _)m
さてさて、遅くなってしまったけど、今年も目標を立てておこうと思う。

* Scheme 処理系を作る。
* お金を貯める。

とりあえずこの2つ。
後で追加するかもしれない。
# 2008/12/23(Tue) : Intel G33 (DG33BUC) 機に Debian インストール成功!!

lenny RC1 リリースのインストーラでは失敗。
dailyビルドイメージ名刺サイズのisoファイルでうまくインストールできた。
# 2008/12/12(Fri) : [ORACLE] [SQL] [PERL] お仕事メモ

・レコードに行番号(連番)を割り当てる

 (1) ROWNUM を使う
  Ex: SELECT ROWNUM ,... FROM ...
  ※注意※ ROWNUM は ORDER BY で並び替えを行う前に番号を割り当てる。

 (2) ROW_NUMBER を使う
  Ex: SELECT ROW_NUMBER() OVER (ORDER BY ...) ,... FROM ...

・グループ毎にレコードに行番号(連番)を割り当てる

 (1) ROW_NUMBER と PARTITION BY を使う
  Ex: ROW_NUMBER() OVER (PARTITION BY ... ,... ORDER BY ... ,...)

・Windows 環境で ActivePerl と Oracle を同時に使うには

 そのままだとライブラリの検索パスが衝突するので、以下のようにソース内でライブラリの検索パスを設定する。

 BEGIN {
  @INC = ('/Perl/site/lib','/Perl/lib');
  $ENV{'NLS_LANG'} = 'Japanese_Japan.UTF8';
 }

・UTF8 で出力する

 binmode STDOUT,':utf8';
 binmode STDERR,':utf8';
 use utf8;

・UTF8 フラグを付ける

 use utf8;
 utf8::decode($str) # 破壊的

 use Encode;
 $str = Encode::decode('utf8',$str);

Perl の Unicode まわりは悪夢のようだ...
# 2008/12/08(Mon) : [Scheme] 言語仕様について
Scheme は理想的な言語だと書いたが...
実は気に入らないところもあったりする。

* マクロ
構文そのものを組み換える重要な機能だとは思うし、私もたまに使う。
けれど...何故かあまり好きになれない。
フィルタで実現できそうな気がする。
もちろん機能としてあったほうが良いとは思うけれど、
仕様としては、わざわざ入れる必要はあるんだろうか。

* eval
実行中にS式を評価する。言わばLispの奥の手ではあるが...
REPL にも大変お世話になっているが...
何故か使いたくないなぁ。なんでだろ。
これは言語の外側(外枠?)に属する機能のような気がする。

* R6RSライブラリで定義されている束縛は変更できない
この仕様は汚すぎる。
なんとかならなかったのだろうか。
ライブラリの束縛名が衝突したときにエラーが出るというのは、まぁ、ギリギリ許容範囲。
ライブラリの中も Scheme ではあるけれど、レイヤーが違うと納得できる。
しかし、プログラムの中で、特定の束縛を変更できないというのは、これはちょっと許せない。
括弧の内側は完全に自由なのが Scheme の良いところだと思う。
例えば define や if などの最も基本的な要素さえも他の束縛と同じように変更できる一貫した規則性が綺麗だと思う。
これだけは我慢ならない。なんとかしたいな。
次のR7RS(?)で文句を言えるよう英語を勉強しておこうか。
# 2008/12/06(Sat) : [Scheme] 言語仕様について
プログラミング言語の仕様というのは、純粋に数学的な理論や概念のみで構築されていてほしい。また最小の構成であってほしいと思う。

Scheme の R6RS は必要最小限の言語仕様とライブラリの仕様を分けている。それ以外の派生的なライブラリやシステム環境に依存する機能などの仕様は、処理系実装者間の緩い約束事として SRFI という仕組みでまとめている。

この仕様の階層的な構造によって、単純な綺麗さを保ったまま、多彩な機能を実現することができる。

Scheme は私にとっては理想的な言語だぁね。
# 2008/11/30(Sun) : [Scheme] [Gauche] 炬燵で写真の整頓
奮発して(?)コタツ買ってきた。
今年の冬はあったかく過ごせそうだ。

↓はデジカメで撮った写真を整頓するために作ったファイル名を変更するスクリプト。

(use file.util)
(use srfi-19)

(define (main args)
 (directory-fold "./photo"
  (lambda (path seed)
   (receive
    (d f x)
    (decompose-path path)
    (if (string=? "CIMG" (substring f 0 4))
     (let ((newpath (build-path d (string-append
         (date->string (time-utc->date
           (make-time time-utc 0 (file-mtime path)))
          "~Y~m~d~H~M~S") "." x))))
      (move-file path newpath :if-exists #f))))
   seed)
  #f)
 0)
# 2008/11/27(Thu) : [VB.NET] [ORACLE] お仕事メモ
VB.NET + ORACLE にて、接続文字列の Data Source に tnsnames.ora の中身をそのまま書いても接続できた。
これで tnsnames.ora が不要になる。

Dim conn As New OracleConnection("User ID=XXX;Password=XXX;Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=localhost)(PORT=1521)))(CONNECT_DATA=(SERVICE_NAME=orcl)))")
Try
 conn.Open()
 Dim cmd As OracleCommand = New OracleCommand("SELECT * FROM XXX", conn)
 Dim reader As OracleDataReader = cmd.ExecuteReader()
 Do While reader.Read()
  Console.WriteLine(reader.Item(0).ToString())
 Loop
Catch ex As Exception
 MessageBox.Show(ex.Message, "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
 conn.Close()
End Try
# 2008/11/26(Wed) : [Scheme] [R6RS] import で束縛名を衝突させると
↓のように簡単な二つのライブラリを作成する。

 $ cat my/lib1.ss
 #!r6rs
 (library (my lib1)
  (export test)
  (import (rnrs base) (rnrs io simple))
  (define (test) (display "LIB1") (newline)))

 $ cat my/lib2.ss
 #!r6rs
 (library (my lib2)
  (export test)
  (import (rnrs base) (rnrs io simple))
  (define (test) (display "LIB2") (newline)))

ライブラリでそれぞれ test という名前で手続きを定義している。

 $ cat test.scm
 (import (my lib1) (my lib2))
 (test)

そのまま import すると...

 $ plt-r6rs test.scm
 test.scm:2:0: module: identifier already imported from: (lib "my/lib1.ss") at: test in: (lib "my/lib2.ss")

エラーになる。(PLTの場合)

 $ cat test.scm
 (import (prefix (my lib1) lib1:) (prefix (my lib2) lib2:))
 (lib1:test)
 (lib2:test)

プレフィックスを付けると...

 $ plt-r6rs test.scm
 LIB1
 LIB2

エラーにならない。
# 2008/11/25(Tue) : [Scheme] 継続スレッド
前回(11/12)の継続を使った疑似並列処理をさらに考えてみる。
複数のループを扱えるようにしてみた。

(define loop
 (lambda (cc ls)
  (cond
   ((pair? ls)
    (display (car ls))
    (loop (and (procedure? cc) (call/cc cc)) (cdr ls)))
   ((procedure? cc) (cc #f))
   (else 'end))))

(let x ((ccs (list
   (call/cc (lambda (cc) (loop cc '(1 2 3 4 5))))
   (call/cc (lambda (cc) (loop cc '(a b c d e f g))))
   (call/cc (lambda (cc) (loop cc '(X Y Z))))))
  (result '()))
 (if (pair? ccs)
  (let ((cc (call/cc (car ccs))))
   (if (procedure? cc)
    (x (append (cdr ccs) (list cc)) result)
    (x (cdr ccs) (cons cc result))))
  result))

(newline)

もうちょっと綺麗に書けそうな気がするな。
# 2008/11/12(Wed) : どう書く?orgのお題 (215) に
継続を使った疑似並列処理なコード (#7985) を投稿した。
あれはあの条件なら動くが、よくよく考えると、
リストの長さがまちまちの場合にはうまく動かない。
修正版を考えてみた。

(define loop
 (lambda (cc ls)
  (cond
   ((pair? ls)
    (display (car ls))
    (loop (and (procedure? cc) (call/cc cc)) (cdr ls)))
   ((procedure? cc) (cc #f)))))

(let ((cc (call/cc (lambda (cc) (loop cc '(1 2 3 4 5 6 7 8 9 10))))))
 (if (procedure? cc) (loop cc '(A B C D E F G H I J)) cc))
(newline)

どう書く?のほうも修正できるといいのにね...
次からはもうちょっと慎重に考えてから投稿しよう。
# 2008/10/23(Thu) : Java SE 6 Update 10
Sun JDK を 6u10 にバージョンアップした。
Applet の起動がかなり速くなったような気がする。
これなら Flash の代わりにも使えるんじゃなかろうか。
# 2008/10/20(Mon) : 文字列操作マクロ
この前 (10/14) のマクロの続き。
汎用的に使えるものを考えてみた。

(use srfi-13) ;; string-trim

(define-syntax $str-proc
 (syntax-rules (trim-both replace-all)
  ((_ str) str)
  ((_ trim-both str) (string-trim-both str))
  ((_ replace-all str r s) (regexp-replace-all r str s))))

(define-syntax $str
 (syntax-rules ()
  ((_ str) str)
  ((_ str (proc x ...)) ($str-proc proc str x ...))
  ((_ str proc) ($str-proc proc str))
  ((_ str p1 p2 ...) ($str ($str str p1) p2 ...))))

↓こんな感じに、文字列操作関数のネストをパラメータ的に記述できる。

(display
 ($str "1234ABCD5678"
  (replace-all #/[0-9+]/ "+")
  (replace-all #/[+]/ (string #\space))
  trim-both))
(newline)

これはなかなか実用的かも。
# 2008/10/14(Tue) : 今日のマクロ
Gauche には regexp-replace-all という文字列置換の便利な手続きがあるが、
ネストするとかっこわるいので、

(regexp-replace-all #/[A-Z]/
 (regexp-replace-all #/[0-9]+/ "ABC1234GHI" "DEF")
  "abc")

まとめて書けるマクロを考えてみた。

(define-syntax $replace
 (syntax-rules ()
  ((_ str r s) (regexp-replace-all r str s))
  ((_ str r1 s1 r2 s2 ...)
   ($replace ($replace str r1 s1) r2 s2 ...))))

string-tr も組み合わせて、
文字列操作に特化したマクロを考えてみるのもいいかもしれない。

[TOP] [ALL]