- # 2011/09/15(Thu) : 素数遅延リスト
- 20110910 のつづき。
Haskell では素数リストを以下のような短いコードで書く事ができる(らしい)。
primes = 2 : sieve [3, 5 ..]
where sieve (p : xs) = p : sieve [x | x <- xs, rem x p /= 0]
main = print $ take 1000 $ primes
これを Scheme になおすと(だいたい)以下のようになる。
(define (take n ls)
(if (positive? n)
(cons (car (force ls)) (take (- n 1) (cdr (force ls))))
'()))
(define (make-delay-list n)
(delay (cons n (make-delay-list (+ n 1)))))
(define (filter-delay-list p ls)
(if (p (car (force ls)))
(delay (cons (car (force ls)) (filter-delay-list p (cdr (force ls)))))
(filter-delay-list p (cdr (force ls)))))
(define (sieve ls)
(delay (cons (car (force ls))
(sieve (filter-delay-list
(lambda (x) (not (zero? (modulo x (car (force ls))))))
(cdr (force ls)))))))
(define primes (sieve (make-delay-list 2)))
(print (take 1000 primes))
遅延リストから再帰的に遅延リストを作ってるのが面白いですね。
- # 2011/09/10(Sat) : 素数遅延リスト
- 20110905 のつづき。
Scheme のコードをそのまま Haskell にするとこうなる。
primeStream = 2 : makePrimeStream 3 [2]
where
makePrimeStream a ls
| any ((==) 0 . mod a) ls = makePrimeStream (a + 2) ls
| otherwise = a : makePrimeStream (a + 2) (a : ls)
main = print $ take 1000 $ primeStream
何もしてないのに遅延されてるのが Haskell の凄いところ。
※無駄に長いので真似してはいけません。
- # 2011/09/05(Mon) : 素数遅延ストリーム
- 素数遅延ストリーム書けた。
(use srfi-1)
(define (make-prime-stream n ls)
(if (any (lambda (x) (zero? (modulo n x))) ls)
(make-prime-stream (+ n 2) ls)
(cons n (delay (make-prime-stream (+ n 2) (cons n ls))))))
(define (prime-stream)
(cons 2 (delay (make-prime-stream 3 '(2)))))
(define (head s n)
(if (zero? n) '()
(cons (car s) (head (force (cdr s)) (- n 1)))))
(display (head (prime-stream) 1000))
(newline)
※効率はあまり良くないので真似してはいけません。
- # 2011/02/13(Sun) : Gauche で OAuth 認証
- Gauche から OAuth 認証で Twitter につぶやくプログラムを書いた。
既にGauche作者のShiroさんとか他の方々が実装しているのは知っているが、
OAuth についてちゃんと理解しておきたいと思い、
自分も実装してみむとてするなり。
以下、作業手順メモとコード。
1. アプリケーションを登録する
まず開発者ページから辿れるアプリケーション登録ページでアプリケーションの名前などの情報を入力する。
http://dev.twitter.com/apps/new
Application Name: アプリケーション名。適当に。
Description: アプリケーションの説明文。適当に。
Application Website: アプリケーションのサイト。適当に。
Organization: 組織？適当に。
Application Type: Client ※今回はクライアントアプリケーション。
Default Access type: Read&Write ※読み書きできるように。
Application Icon: アイコン ※後からでも登録できる。
入力できたら "Register application" ボタンを押す。
CAPTCHA がなかなか通らないけど辛抱強く挑戦すること。
うまく登録できるとコンシューマーキーなどの必要な情報が表示される。
API key : XXXXX
Consumer key : XXXXX
Consumer secret : XXXXX (秘密鍵)
Request token URL : https://api.twitter.com/oauth/request_token
Access token URL : https://api.twitter.com/oauth/access_token
Authorize URL : https://api.twitter.com/oauth/authorize
2. リクエストトークンを取得する
次に先程取得した Consumer key と Consumer secret を使ってリクエストトークンを取得する。
取得に必要なパラメータは以下の６つ。
* 必要なパラメータ
oauth_consumer_key=コンシューマーキー
oauth_signature_method="HMAC-SHA1"
oauth_signature=署名
oauth_timestamp=UNIX時間
oauth_nonce=適当な長さのユニークな文字列。かぶらなければ何でも良い。
oauth_version="1.0"
署名は署名以外のパラーメータを元にコンシューマキー (秘密鍵のほう) をキーに作る。
具体的な作り方はコードを見てほしい。
作ったパラメータで HTTP GET する。
うまくいくとリクエストトークンが返ってくる。
oauth_token=XXXXX
oauth_token_secret=XXXXX (秘密鍵)
oauth_callback_confirmed=true
3. アプリを承認してPINコードを取得する
次はブラウザで。
リクエストトークンをURLにくっつけて承認ページを表示する。
https://api.twitter.com/oauth/authorize?oauth_token=XXXXX
"Allow" (許可) ボタンを押すと７桁の数値が表示される。これがPINコード。
<div id="oauth_pin">
1234567
</div>
4. アクセストークンを取得する
リクエストトークンとPINを使ってアクセストークンを取得する。
署名のキーにはコンシューマーキー(秘密鍵)とリクエストトークン(秘密鍵)を使う。
* 必要なパラメータ
oauth_consumer_key=コンシューマーキー
oauth_token=リクエストトークン
oauth_verifier=PIN
oauth_signature_method="HMAC-SHA1"
oauth_signature=署名
oauth_timestamp=UNIX時間
oauth_nonce=適当な長さのユニークな文字列。かぶらなければ何でも良い。
oauth_version="1.0"
このパラメータでリクエストトークンの時と同様に HTTP GET する。
もたもたしてると "Invalid / expired Token" ってエラーが出るみたい。
うまくいくとアクセストークンが返ってくる。
oauth_token=XXXXX
oauth_token_secret=XXXXX (秘密鍵)
user_id=XXXXX
screen_name=XXXXX
このアクセストークンで認証を通過できるようになる。
5. つぶやく
(5.1) 署名(oauth_signature)以外のパラメータ(つぶやき含む)で署名を作成。
(5.2) つぶやき(status)以外のパラメータ(署名含む)で HTTP Authorization ヘッダを作成。
(5.3) HTTP Authorization ヘッダを付けて status を HTTP POST する。
* 必要なパラメータ
status=つぶやき
oauth_consumer_key=コンシューマーキー
oauth_token=アクセストークン
oauth_signature_method="HMAC-SHA1"
oauth_signature=署名
oauth_timestamp=UNIX時間
oauth_nonce=適当な長さのユニークな文字列。かぶらなければ何でも良い。
oauth_version="1.0"
以下、コード。
;(use rfc.uri) ; uri-encode-string
(use rfc.sha) ; <sha1>
(use rfc.hmac) ; hmac-digest-string
(use rfc.base64) ; base64-encode-string
(use rfc.http) ; http-get http-post
(use srfi-11) ; let-values
(define *CONSUMER-KEY* "XXXXX")
(define *CONSUMER-SECRET* "XXXXX")
(define *REQUEST-TOKEN-URL* "http://api.twitter.com/oauth/request_token")
(define *ACCESS-TOKEN-URL* "http://api.twitter.com/oauth/access_token")
(define *AUTHORIZE-URL* "http://api.twitter.com/oauth/authorize")
(define *REQUEST-TOKEN* "XXXXX")
(define *REQUEST-TOKEN-SECRET* "XXXXX")
(define *PIN* "XXXXXXX")
(define *ACCESS-TOKEN* "XXXXX")
(define *ACCESS-TOKEN-SECRET* "XXXXX")
(define *STATUSES-UPDATE-URL* "http://api.twitter.com/1/statuses/update.xml")
(define (uri-encode-string str)
(call-with-string-io str
(lambda(in out)
(port-for-each
(lambda (b)
(cond
;((= b #x20) (write-byte #x2B out)) ;; space -> +
((= b #x2D) (write-byte b out)) ;; -
((= b #x2E) (write-byte b out)) ;; .
((= b #x5F) (write-byte b out)) ;; _
((= b #x7E) (write-byte b out)) ;; ~
((<= #x30 b #x39) (write-byte b out)) ;; 0-9
((<= #x41 b #x5A) (write-byte b out)) ;; A-Z
((<= #x61 b #x7A) (write-byte b out)) ;; a-z
(else (format out "%~2,'0X" b))))
(lambda () (read-byte in))))))
(define (make-signature-key consumer-secret token-secret)
(string-append consumer-secret "&" token-secret))
(define (make-signature-body http-method base-uri params)
(string-append http-method "&"
(uri-encode-string base-uri) "&"
(uri-encode-string
(string-join
(map (lambda (name)
(string-append
(uri-encode-string name) "="
(uri-encode-string (cadr (assoc name params)))))
(sort (map car params))) "&"))))
(define (make-signature key body)
(base64-encode-string
(hmac-digest-string body :key key :hasher <sha1>)))
(define (make-http-authorization-header params)
(string-append "OAuth "
(string-join
(map (lambda (x)
(string-append (car x) "=\"" (uri-encode-string (cadr x)) "\""))
params)
",")))
(define (parse-body str)
(map (lambda (s) (string-split s #\=)) (string-split str #\&)))
(define (request-token
oauth-consumer-key
oauth-consumer-secret
oauth-signature-method
oauth-timestamp
oauth-nonce
oauth-version)
(let* ((params `(("oauth_consumer_key" ,oauth-consumer-key)
("oauth_signature_method" ,oauth-signature-method)
("oauth_timestamp" ,oauth-timestamp)
("oauth_nonce" ,oauth-nonce)
("oauth_version" ,oauth-version)))
(signature-key (make-signature-key oauth-consumer-secret ""))
(signature-body (make-signature-body "GET" *REQUEST-TOKEN-URL* params))
(signature (make-signature signature-key signature-body)))
(let-values (((code header body)
(http-get "api.twitter.com"
(cons "/oauth/request_token"
(cons (list "oauth_signature" signature) params)))))
(let ((result (parse-body body)))
(for-each
(lambda (ls) (print (car ls) "=\"" (cadr ls) "\""))
result)
(print *AUTHORIZE-URL* "?oauth_token=" (cadr (assoc "oauth_token" result)))))))
(define (access-token
oauth-consumer-key
oauth-consumer-secret
request-token
request-token-secret
oauth-verifier
oauth-signature-method
oauth-timestamp
oauth-nonce
oauth-version)
(let* ((params `(("oauth_consumer_key" ,oauth-consumer-key)
("oauth_token" ,request-token)
("oauth_verifier" ,oauth-verifier)
("oauth_signature_method" ,oauth-signature-method)
("oauth_timestamp" ,oauth-timestamp)
("oauth_nonce" ,oauth-nonce)
("oauth_version" ,oauth-version)))
(signature-key (make-signature-key oauth-consumer-secret request-token-secret))
(signature-body (make-signature-body "GET" *ACCESS-TOKEN-URL* params))
(signature (make-signature signature-key signature-body)))
(let-values (((code header body)
(http-get "api.twitter.com"
(cons "/oauth/access_token"
(cons (list "oauth_signature" signature) params)))))
(for-each
(lambda (ls) (print (car ls) "=\"" (cadr ls) "\""))
(parse-body body)))))
(define (statuses-update
status
oauth-consumer-key
oauth-consumer-secret
access-token
access-token-secret
oauth-signature-method
oauth-timestamp
oauth-nonce
oauth-version)
(let* ((params `(("status" ,status)
("oauth_consumer_key" ,oauth-consumer-key)
("oauth_token" ,access-token)
("oauth_signature_method" ,oauth-signature-method)
("oauth_timestamp" ,oauth-timestamp)
("oauth_nonce" ,oauth-nonce)
("oauth_version" ,oauth-version)))
(signature-key (make-signature-key oauth-consumer-secret access-token-secret))
(signature-body (make-signature-body "POST" *STATUSES-UPDATE-URL* params))
(signature (make-signature signature-key signature-body))
(authorization (make-http-authorization-header
(cons (list "oauth_signature" signature) (cdr params)))))
(http-post "api.twitter.com" "/1/statuses/update.xml"
(string-append "status=" (uri-encode-string status))
:Authorization authorization
:sink (current-output-port) :flusher (lambda _ #t))))
(define (tweet status)
(if (< 140 (string-length status))
(print "Over 140 characters.")
(statuses-update status
*CONSUMER-KEY*
*CONSUMER-SECRET*
*ACCESS-TOKEN*
*ACCESS-TOKEN-SECRET*
"HMAC-SHA1"
(number->string (sys-time))
(number->string (sys-time))
"1.0")))
;; リクエストトークンを取得する。
(request-token
*CONSUMER-KEY*
*CONSUMER-SECRET*
"HMAC-SHA1"
(number->string (sys-time))
(number->string (sys-time))
"1.0")
;; アクセストークンを取得する。
(access-token
*CONSUMER-KEY*
*CONSUMER-SECRET*
*REQUEST-TOKEN*
*REQUEST-TOKEN-SECRET*
*PIN*
"HMAC-SHA1"
(number->string (sys-time))
(number->string (sys-time))
"1.0")
;; つぶやく。
(statuses-update
"TEST"
*CONSUMER-KEY*
*CONSUMER-SECRET*
*ACCESS-TOKEN*
*ACCESS-TOKEN-SECRET*
"HMAC-SHA1"
(number->string (sys-time))
(number->string (sys-time))
"1.0")
(tweet "てすてす")
(newline)
- # 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 にした。
評判通りのなかなか良い音に満足。
- # 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)
