見出し画像

ど素人のLisp入門#2 MacでTanukiのローカルLLMを呼び出して結果を取得する

進化計算のためにいよいよ40年のときを超えてLispを多少真面目にやろうかなと思っている今日この頃。

なぜ#1がないのに#2からやるのかというと、#1であるべき入門について書くのは本当に面倒なので、前回の記事を参考にしていただきたい。

このマガジンではsbclとMacを基本的に使うものとする。
まず、吾輩は世界を放浪中のため、できれば電波のいい環境でローカルLLMでやりたい。そこで東大松尾研が作った日本最高峰(現在)のオープンかつローカル動作するLLMであるtanuki-8Bを使う。

この記事は40年間にわたってLispに憧れを抱きながら結局一度も実用的なコードを書けなかった僕が、AIの助けを借りてLispで自分のやりたいとをやらせながらLispに入門していく過程をまとめたものである。

MLXとSBCLのセットアップ

Mac(M1以降)ではMLXというApple Sillicon専用のツールが使える。MLXとMLX-LMをインストールしておこう。

基本的に、MLXは最新版出ないといけない。Tanuki-8BはMLX-LMは0.18.1以降出ないと動かない。参考までに僕のローカル環境はこちら

$ pip list|grep mlx
mlx                                      0.17.1
mlx-lm                                   0.18.1

MLXが入ってる状態で以下のコマンドを実行するとmlx_lmサーバーが立ち上がる。

$ mlx_lm.server --model mlx-community/Tanuki-8B-dpo-v1.0-8bit

これはOpenAI APIと互換性のあるサーバーなので、非常に簡単に呼び出せる。

とりあえずLisp環境もインストールしよう。

HomeBrewがあるMacなら、以下のコマンドでSBCLというLisp環境をインストールできる。SBCLはMacだけでなく色々なOSで動くのでおすすめ。

$ brew info sbcl

HomeBrewが入ってない人は、自分でインストールして欲しい。

こいつを呼び出すための最低限のコードを書く必要があるのだが、そのためにはまずLispのパッケージ管理システムであるquicklispをインストールする必要がある。

Lispは歴史が二番目に古い言語なので、まあ色々と原始的なところがあるのだが慣れれば忘れてしまうのでモダンな環境になれた人は少し我慢してほしい。

Lispのパッケージ管理システムは非常に野蛮なことに、直接wgetでダウンロードする。

$ wget https://beta.quicklisp.org/quicklisp.lisp  

次に、sbclを起動する

$ sbcl
This is SBCL 2.4.7, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* 

sbclのプロンプトは「*」である。
*に続けてコマンドなどを入力する。

ここでquicklispを読み込む。

* (load "quicklisp.lisp")

  ==== quicklisp quickstart 2015-01-28 loaded ====

    To continue with installation, evaluate: (quicklisp-quickstart:install)

    For installation options, evaluate: (quicklisp-quickstart:help)

T

次にインストールする。
インストール先は~/.quicklispにしよう。
quicklisp-quickstart:install関数に続けて、ql:add-to-init-file関数を呼び出す。

* (quicklisp-quickstart:install :path "~/.quicklisp/")
* (ql:add-to-init-file)

ちなみにプロンプト上でctrl+DでOSのプロンプトに落ちることができる。
この辺りはPythonのREPLと同じだ。

ただ、sbclのシェルはPythonのREPLみたいに上下カーソルキーや左右カーソルキーが使えなくて不便なので、LIspに慣れてきたらVS CodeとかのLisp環境を構築することをお勧めする。

ちなみに俺はまだ全然慣れてないのでしばらくこの不便なsbclで行くことにする。なんでかというと、最終的にサーバーとかcronとかでスクリプトを実行するときにLinuxのコマンドラインから実行させたいからだ。Lispは歴史が長いので色々と便利なものがたくさん揃っているのだが、慣れないうちは逆にそれが余計に混乱を招くことになる。

そこでPythonを使ったくらいの経験がある人が手軽にPythonの代替としてLispを使うところから入門していきたい。

超超最初のLisp入門

sbclのコンソールで簡単な計算をしてみる。

* (+ 1 2)
3

とりあえずPythonの簡単なプログラムをLispに変える練習をしてみよう。

例えばPythonで以下のようなプログラムがあるとする。

>>> a = 10
>>> b = 20
>>> a + b
30

これをLispで簡単に書くとこうなる。

* (setf a 10)
* (setf b 20)
* (+ a b)
30

実際には「(setf a 10)」とか書くたびにゴチャゴチャ出てくるがとりあえず無視していい(いつも言うがプログラミング言語を学ぶ時にどうでもいいことをとりあえず無視するのは非常に重要である)。

「なんで=じゃなくてsetfっていうわけわかんねえ命令なんだよ」と思う人が多いだろうが、そもそも「=で代入する」ことが数式の記法としては異常なのであったことをどうか思い出していただきたい。

何度もいうがLispは歴史が長い言語なので、長い歴史の中で無数の方言が生まれ、それが統一されてCommon Lispという方言に纏まっっている。しかしCommon Lispにまとまったのも1980年、つまり40年前である。

少し余談になるが、「setf」の元ネタとして実は「set」という関数がある(もっというとsetfは本当は関数ではなくマクロだったりする)。ただし、set関数はsetfよりも遥かに自由度が高いので説明するためにLispの色々なお約束を先に覚えなければならない。ややこしいのでここでは無視する。

さて、とにかく=ではなくsetfを使う、とここではおぼえよう。

わかんないことやエラーがあったら、躊躇なくClaude-3やChatGPTに聞くといい。昔はこれがなかったのでLispを勉強するのは絶望的に難しかった。今はAIがあるからものすごく簡単だ。

次に、ファイルにプログラムを書いてそれを読み込ませてコマンドラインから実行するという、いわゆるPythonやRubyでよくやるスクリプト言語の書き方でLispを書いてみよう。このほうがなじみが多い人が多いだろうからだ。

まず、こんなファイルを作ってみる。

$ cat - > test.lisp
(setf a 10)
(setf b 20)
(print (+ a b))

このtest.lispを読み込ませて実行するには以下のようなコマンドを書く

$ sbcl --script test.lisp 

; file: /Users/shi3z/projects/evollm/test.lisp
; in: SETF A
;     (SETF A 10)
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::A
; 
; compilation unit finished
;   Undefined variable:
;     A
;   caught 1 WARNING condition

; file: /Users/shi3z/projects/evollm/test.lisp
; in: SETF B
;     (SETF B 20)
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::B
; 
; compilation unit finished
;   Undefined variable:
;     B
;   caught 1 WARNING condition

30

色々ゴチャゴチャ出てくるが、結論として30が出ている。
このゴチャゴチャ出てくるのが鬱陶しいのでとりあえずおまじないを入れる。test.lispをエディタで開いてこんな感じで一行目におまじないを入れよう。

(declaim (sb-ext:muffle-conditions warning)) ;おまじない

(setf a 10)
(setf b 20)
(print (+ a b))

Lispでは;で始まった部分以降は行末までコメントとして扱われる。
複数行のコメントを書く場合は「#|」と「|#」で囲む。

このおまじないは「とりあえずうるさいから黙ってろ」という意味である。
(もっと詳しい意味が知りたい場合はAIに聞いて欲しい)

この上で再度実行すると余計な警告が出なくなる。

$ sbcl --script test.lisp

30

これでとりあえず計算をして何かを表示する、ということができるようになった。

LispからLLMを呼び出す

さて、いよいよLispからLLMを呼び出してみよう。
もちろん細かいことは僕にはわからん。ただ、Claud-3に聞けば簡単にそういう関数を書いてくれる。

「sbclでOpenAI API互換サーバーにアクセスして返答をとってくるLispコードを書け」というような指示を与えた後、トライ&エラーを繰り返して得られたコードが以下である。僕とAIの合作ではあるが、とりあえず動くことは確認している。

このコードをcallllm.lispと呼ぶことにする。

(declaim (sb-ext:muffle-conditions warning)) ;おまじない

(let ((quicklisp-init (merge-pathnames "~/.quicklisp/setup.lisp"
                                       (user-homedir-pathname))))
  (if (probe-file quicklisp-init)
      (load quicklisp-init)
      (error "Quicklisp is not installed. Please install Quicklisp first.")))

(defun quiet-load (systems)
  (let ((quicklisp-quickload-verbose nil)
        (*standard-output* (make-broadcast-stream))
        (*error-output* (make-broadcast-stream)))
    (ql:quickload systems :silent t)))

(quiet-load '("dexador" "jsown" "cl-ppcre"))

;(ensure-quicklisp-libraries)

(defun decode-unicode-escapes (string)
  (with-output-to-string (out)
    (loop with i = 0
          while (< i (length string))
          do (let ((char (char string i)))
               (if (and (char= char #\\)
                        (< (+ i 1) (length string))
                        (char= (char string (+ i 1)) #\u))
                   (progn
                     (write-char (code-char (parse-integer string :start (+ i 2) :end (+ i 6) :radix 16)) out)
                     (incf i 6))
                   (progn
                     (write-char char out)
                     (incf i)))))))

(defun parse-json-safely (json-string)
  (handler-case
      (jsown:parse json-string)
    (error (e)
      (format t "Error parsing JSON: ~A~%" e)
      nil)))

(defun extract-json-until-eod (string)
  (let* ((json-start (position #\{ string))
         (eod-pos (search "<EOD>" string :start2 json-start))
         (json-end (if eod-pos
                       (position #\} string :from-end t :end eod-pos)
                       (position #\} string :from-end t))))
    (when (and json-start json-end)
      (subseq string json-start (1+ json-end)))))

(defun extract-message-content (json-obj)
  (handler-case
      (let* ((choices (jsown:val json-obj "choices")))
        ;(format t "Choices: ~A~%" choices)
        (if (listp choices)
            (let* ((first-choice (first choices))
                   (message (jsown:val first-choice "message"))
                   (content (extract-json-until-eod (jsown:val message "content"))))
              ;(format t "Extracted content: ~A~%" content)
              content)
            (progn
              (format t "Warning: Unexpected 'choices' structure~%")
              nil)))
    (error (e)
      (format t "Error extracting message content: ~A~%" e)
      nil)))

(defun extract-json-from-content (content)
  ;(format t "Extracting JSON from content: ~A~%" content)
  (let ((json-start (search "{" content))
        (json-end (search "}" content :from-end t)))
    (if (and json-start json-end (< json-start json-end))
        (let ((json-string (subseq content json-start (1+ json-end))))
          ;(format t "Extracted JSON string: ~A~%" json-string)
          json-string)
        (progn
          (format t "No complete JSON object found in content~%")
          nil))))



(defun extract-result-from-json (json-obj)
  ;(format t "Extracting result from JSON: ~A~%" json-obj)
  (if (jsown:keyp json-obj "result")
      (jsown:val json-obj "result")
      json-obj))


(defun access-llm-server (message &key (temperature 0.7) (max-tokens 500))
  (let ((url "http://localhost:8080/v1/chat/completions")
        (headers '(("Content-Type" . "application/json")))
        (payload (jsown:to-json
                   `(:obj ("messages" . #((:obj ("role" . "user")
                                               ("content" . ,message))))
                          ("temperature" . ,temperature)
                          ("max_tokens" . ,max-tokens)))))
    (handler-case
        (multiple-value-bind (body status headers uri stream must-close reason-phrase)
            (dex:post url :headers headers :content payload)
          (declare (ignore headers uri stream must-close reason-phrase))
          ;(format t "Server response status: ~A~%" status)
          ;(format t "Decoded server response: ~A~%" (decode-unicode-escapes body))
          (if (= status 200)
              (let* ((json-obj (parse-json-safely body))
                     (content (when json-obj (extract-message-content json-obj))))
                (if content
                    (let* ((json-string (extract-json-from-content content)))
                      (if json-string
                          (let* ((inner-json-obj (parse-json-safely json-string)))
                            (if inner-json-obj
                                (let ((result (extract-result-from-json inner-json-obj)))
                                  (values result content))
                                (values nil "Failed to parse inner JSON")))
                          (values nil "No JSON found in content")))
                    (values nil "No content found in message")))
              (values nil (format nil "Error: HTTP status ~A" status))))
      (error (e)
        (values nil (format nil "Error accessing LLM server: ~A" e))))))

(defun retry-for-answer (message &key (max-attempts 5) (delay 2) (temperature 0.7) (max-tokens 500))
  (loop for attempt from 1 to max-attempts
        do (multiple-value-bind (answer content)
               (access-llm-server message :temperature temperature :max-tokens max-tokens)
             ;(format t "Attempt ~A: Result = ~A, Content = ~A~%" attempt answer content)
             (cond
               (answer
                (return (values answer content)))
               (t
                ;(format t "Attempt ~A: No valid answer found. Retrying in ~A seconds...~%" attempt delay)
                (sleep delay))))
        finally (return (values nil (format nil "Failed to get a valid answer after ~A attempts" max-attempts)))))

(defun get-score (prompt)
  ;(format t "~A~%" prompt)
  (labels ((try-get-score (attempts)
             (if (> attempts 10)
                 (error "Maximum retry attempts reached")
                 (let ((x (retry-for-answer prompt :max-attempts 1 :max-tokens 500)))
                   (handler-case
                       (jsown:val x "score")
                     (error (e)
                       (format t "Attempt ~A failed: ~A. Retrying...~%" attempts e)
                       (try-get-score (1+ attempts))))))))
    (try-get-score 1)))

(print 
  (get-score "ドラえもんののび太くんはしずかちゃんをどの程度好きか、100点満点で評価してJSON形式で結果を返してください。JSONに入れる結果は数値のみでscoreプロパティに入れてください。"))

このようなコードが書けるようになったのもtanukiのおかげと言ってもいい。

というのも、数ヶ月前までのローカルLLMではちゃんとJavaScriptを返してくれないことが多かったからだ。

このコードを実行すると以下のようになる。

$ sbcl --script callllm.lisp
Attempt 1 failed: Key score is not available in the given object. Retrying...

85

「Attempt〜」で始まる行はリトライする度に表示されるので、これはLLMが乱数で動いているため、欲しい結果が得られない時は自動的に10回までリトライするようになっているので仕方ない。

これをsbclのプロンプトから呼び出して使ってみよう。

$ sbcl
This is SBCL 2.4.7, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* (load "callllm.lisp")

85 
T
* 

sbclを起動して最初に(load "callllm.lisp")を呼ぶと、callllm.lispが読み込まれて実行され、85というスコアが返ってくる。

ここで実際に戻ってきた値を操作してみよう。
callllm.lispではget-score関数にプロンプトを与えると、LLMに投げてスコアが得られる。

例えばラブレターに点数をつけてもらおう。

* (get-score "「君死にたもう事勿れ」という文章はラブレターとして相手をどの程度感動させることができるか、ラブレターを受け取る相手の気持ちになって100点満点で評価してJSON形式で結果を返してください。JSONに入れる結果は数値のみでscoreプロパティに入れてください。")

100
* 

これは数値なのでsetfで保存することができる。

* (setf score 
(get-score "「君死にたもう事勿れ」という文章はラブレターとして相手をどの程度感動させることができるか、ラブレターを受け取る相手の気持ちになって100点満点で評価してJSON形式で結果を返してください。JSONに入れる結果は数値のみでscoreプロパティに入れてください。")

* score
85

この「get-score」という関数のなかを見てみると、内部でretry-for-answerという関数を呼んでいる。retry-for-answer関数を直接呼び出してみよう。

* (retry-for-answer"「君死にたもう事勿れ」という文章はラブレターとして相手をどの程度感動させることができるか、ラブレターを受け取る相手の気持ちになって100点満点で評価してJSON形式で結果を返してください。JSONに入れる結果は数値のみでscoreプロパティに入れてください。")

Attempt 1: Result = (OBJ (score . 85)), Content = {
 "score": 85
}
(:OBJ ("score" . 85))
"{
 \"score\": 85
}"
* 

これでscoreが含まれたJSONオブジェクトが得られた。
score以外の答えが欲しい場合はプロンプトを変えてみる。例えばscoreではなくてanswerみたいなこともできる。

* (retry-for-answer"日本における都道府県の数は?JSON形式で結果を返してください。JSONに入れる結果は数値のみでanswerプロパティに入れてください。")
Attempt 1: Result = (OBJ (answer . 47)), Content = {
 "answer": 47
}
(:OBJ ("answer" . 47))
"{
 \"answer\": 47
}"
* 

JSONデータをLispから操作する

この受け取ったデータを操作してみよう。
まずsetfでxという変数に結果を保存する。

* (setf x (retry-for-answer"日本における都道府県の数は?JSON形式で結果を返してください。JSONに入れる結果は数値のみでanswerプロパティに入れてください。"))
(:OBJ ("answer" . 47))
* 

ここで得られた変数の中身は、jsownというパッケージのオブジェクトであることを意味している。

この変数を処理するにはjsownパッケージを使う必要がある。
例えば、xの中にあるanswerというプロパティを参照するにはこうする。

* (jsown:val x "answer")
47

このxにPythonやJavaScriptのオブジェクトのように別のプロパティを追加するにはsetfを使う。

* (setf (jsown:val x "hoge") "fuga")

"fuga"

xに新しく「hoge」というプロパティが追加されたか確認すると追加される。

* x
(:OBJ ("answer" . 47) ("hoge" . "fuga"))

自分好みに言語を拡張する / いきなりマクロを作る

さて、まあできることはわかったけれども、「なんだか気持ち悪い」と思わなかっただろうか。僕は思った。

しかし、Lispのいいところはこの先なのである(モノの本によれば)。
Lispで守らなければならないルールはただ一つ、「(関数 引数1 引数2 …)」という形を守ること。プロパティを呼び出す時にいちいち「jsown:val」とか書くのもいやだし、プロパティを設定するときにもっとややこしいことを書くのも嫌だ。せめて同じような感じで取得したい。

そういう時に普通の言語なら関数を書くのだが、Lispではマクロを書くのである。

このマクロを自分で書くのはしんどかったのでClaude-3に書いてもらった。
プロンプトは「「(setf (jsown:val x "hoge") "fuga")」を「(setval x (("hoge" "fuga"))」でできるようなマクロを書け」

(defmacro setval (object &rest key-value-pairs)
  `(progn
     ,@(loop for (key value) in key-value-pairs
             collect `(setf (jsown:val ,object ,key) ,value))
     ,object))

これでsetvalを呼ぶだけで簡単にプロパティを設定できるようになる。

* (setval x ("moge" "moga"))
(:OBJ ("answer" . 47) ("hoge" . "fuga") ("moge" . "moga"))

嬉しい!なんて便利なんだ。
さらに同じようにgetvalマクロも作ってみよう。
getvalもClaude-3に書かせてもいいが、せっかくだから自分で書いてみる。

(defmacro getval (object key)
  `(progn
      (jsown:val ,object ,key)
      ))

このプログラムには見慣れない記法が二つ出てくる「`(バッククォート)」と、「,object」「,key」のように頭に「,」がついてる引数だ。

これはなんなのか。俺もよくわかんないのでClaude-3に説明してもらう。

ちなみにmacroexpandでマクロがどのように展開されるか確認できる。

* (macroexpand '(getval x "hoge"))
(PROGN (JSOWN:VAL X "hoge"))
T
* (macroexpand '(setval x ("hoge" "fuga")))
(PROGN (SETF (JSOWN:VAL X "hoge") "fuga") X)
T
* 

なるほどー。
PROGNって何なのかうろ覚えなのでこれもClaude-3に聞いてみる。

PROGNはCommon Lispの特殊形式の一つで、複数の式を順番に評価し、最後の式の結果を返すために使用されます。PROGNの特徴と使用方法を詳しく説明します:

ああそうなんだ。ただ順番に式を実行するだけじゃなくて最後の式の値を結果として返すところがポイントなのね。

つまりPythonとかJavaScriptでは「return」という命令で返す返り値が、Lispでは最後の式の結果の値になると。なるほどー。

なんかわかんなかったことが少しずつわかってくるって嬉しいなー。
次回はLLMと進化計算を組み合わせてみたい。