ど素人のLISP入門 / SBCLで非同期ChatGPT呼び出しをしてみる
AIderを使うと対話的にプログラムを書くことができる。
やはり非同期処理をするためだけに自分で処理系を書くとか正気じゃないので既存のLISP処理系を使って同じことをできるようにしてみる。
色々すったもんだはあったが、とりあえずMacではSBCLを使うのが正しいらしいのでSBCLをセットアップする
$ brew install sbclで、SBCLだけあってもパッケージが管理できないので、QuickLispというパッケージ管理ツールを読み込んで設定する。これがなんか原始的でわかりにくいが、これが伝統の味というやつなのだろうか。
$ wget https://beta.quicklisp.org/quicklisp.lisp
$ 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 "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-quickstart:install :path "~/.quicklisp/")
* (ql:add-to-init-file)こうするとパッケージ管理ができるようになる。
色々面倒はあったが、とりあえず欲しいコードはAIderが書いてくれた。
コードは以下
使うときには環境変数OPENAI_API_KEYにAPIキーを入れておくこと
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package :ql)
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
(user-homedir-pathname))))
(when (probe-file quicklisp-init)
(load quicklisp-init))))
(ql:quickload "drakma")
(ql:quickload "cl-json")
(ql:quickload "bordeaux-threads"))
(defpackage :chatgpt
(:use :cl :drakma :cl-json :bordeaux-threads)
(:export :send-prompts-async :get-api-key :send-prompt :handle-response :*model*))
(in-package :chatgpt)
(defvar *api-key* nil)
(defvar *model* "gpt-4o-mini")
(defclass promise ()
((value :initform nil)
(status :initform :pending)
(lock :initform (make-lock))
(condition-variable :initform (make-condition-variable))))
(defun make-promise ()
(make-instance 'promise))
(defun fulfill (promise value)
(with-slots ((promise-value value) status lock condition-variable) promise
(with-lock-held (lock)
(setf promise-value value
status :fulfilled)
(condition-notify condition-variable))))
(defun reject (promise error)
(with-slots (value status lock condition-variable) promise
(with-lock-held (lock)
(setf value error
status :rejected)
(condition-notify condition-variable))))
(defun force (promise)
(with-slots (value status lock condition-variable) promise
(with-lock-held (lock)
(loop while (eq status :pending)
do (condition-wait condition-variable lock))
(case status
(:fulfilled value)
(:rejected (error value))))))
(defun get-api-key ()
"Retrieve the API key from the environment variable."
(let ((api-key (uiop:getenv "OPENAI_API_KEY")))
(cond
((null api-key)
(error "OPENAI_API_KEY environment variable is not set."))
((string= api-key "")
(error "OPENAI_API_KEY environment variable is set but empty."))
(t
(format t "API key found: ~A...~A~%"
(subseq api-key 0 (min 4 (length api-key)))
(subseq api-key (max 0 (- (length api-key) 4))))
api-key))))
(defun handle-response (response)
"Handle the response from ChatGPT and return only the assistant's content."
(let* ((json-string (babel:octets-to-string response))
(json:*json-identifier-name-to-lisp* #'identity)
(json (json:decode-json-from-string json-string)))
(let* ((choices (cdr (assoc :|choices| json)))
(first-choice (first choices))
(message (cdr (assoc :|message| first-choice)))
(content (cdr (assoc :|content| message))))
content)))
(defun send-prompt (prompt)
"Send a single prompt to ChatGPT and return the response."
(let* ((url "https://api.openai.com/v1/chat/completions")
(api-key (get-api-key))
(headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key))))
(body (json:encode-json-to-string
`(("model" . ,*model*)
("messages" . ,(vector
(list (cons "role" "user")
(cons "content" prompt))))
("max_tokens" . 100)))))
(format t "Sending request for prompt: ~A~%" prompt)
(multiple-value-bind (response status-code)
(http-request url
:method :post
:content body
:additional-headers headers)
(if (= status-code 200)
(let ((content (handle-response response)))
(format t "Response: ~A~%" content)
content)
(error "API request failed with status ~A: ~A" status-code (babel:octets-to-string response))))))
(defun send-prompt-async (prompt)
"Send a prompt asynchronously and return a promise."
(let ((promise (make-promise)))
(make-thread
(lambda ()
(handler-case
(let ((response (send-prompt prompt)))
(fulfill promise response))
(error (e)
(reject promise e)))))
promise))
(defun send-prompts-async (prompts)
"Send multiple prompts to ChatGPT asynchronously and return the responses."
(let ((api-key (get-api-key)))
(format t "Using API key: ~A...~A~%"
(subseq api-key 0 (min 4 (length api-key)))
(subseq api-key (max 0 (- (length api-key) 4))))
(handler-case
(let ((promises (map 'vector #'send-prompt-async prompts)))
(let ((responses (map 'vector #'force promises)))
(format t "All responses:~%")
(loop for prompt across prompts
for response across responses
do (format t "Prompt: ~A~%Response: ~A~%~%" prompt response))
responses))
(error (e)
(format t "Error occurred: ~A~%" e)
(error e)))))
まーLISPはさっぱりわからないので、なんでこれで上手く動くのかわからん。コツは「エラーが出たら根気よくしつこくAIに聞くこと」もうここにだけ忍耐が必要。
「俺が欲しいのはこれじゃない」とか言いづけるとだんだん形になってくる。嬉しい。
そして手に入った、非同期で複数のプロンプトを投げて受け取るシステム。
* (load "chatgpt.lisp")
To load "drakma":
Load 1 ASDF system:
drakma
; Loading "drakma"
To load "cl-json":
Load 1 ASDF system:
cl-json
; Loading "cl-json"
To load "bordeaux-threads":
Load 1 ASDF system:
bordeaux-threads
; Loading "bordeaux-threads"
WARNING: CHATGPT also uses the following packages:
(CL-ASYNC)
See also:
The ANSI Standard, Macro DEFPACKAGE
The SBCL Manual, Variable *ON-PACKAGE-VARIANCE*
T
* (chatgpt:send-prompts-async #("Hello, ChatGPT!" "How are you today?"))
API key found: sk-k...tlvQ
Using API key: sk-k...tlvQ
API key found: sk-k...tlvQ
Sending request for prompt: Hello, ChatGPT!
API key found: sk-k...tlvQ
Sending request for prompt: How are you today?
Response: Hello! How can I assist you today?
Response: As an artificial intelligence, I don't have feelings, but I'm functioning as expected. How can I assist you today?
All responses:
Prompt: Hello, ChatGPT!
Response: Hello! How can I assist you today?
Prompt: How are you today?
Response: As an artificial intelligence, I don't have feelings, but I'm functioning as expected. How can I assist you today?
#("Hello! How can I assist you today?"
"As an artificial intelligence, I don't have feelings, but I'm functioning as expected. How can I assist you today?")
二つのプロンプト「Hello! ChatGPT」と「How are you today?」を投げて、同時並行的に実行されてその結果を「("Hello! How can I assist you today?" "As an artificial intelligence, I don't have feelings, but I'm functioning as expected. How can I assist you today?")」というリストで受け取っている。
一発で上手くいくわけではないが、俺よりLISPに詳しいAI様のことをどこまで信じることができるかがポイントだ。
さて、そもそもなんでこんなことがしたいのか?
僕は主にオープンなLLMのプロンプトチューニングをしたいと考えていて、それらのLLMはOpenAIのチャットインターフェースと互換性がある。
任意のLLMを順番に起動してプロンプトチューニングを行い、競わせ、交配させる、いわゆる「遺伝的プログラミング」をやることを考えると、LISPの構造が最も合理的なのである。
というのも、LLMが扱う「トークン」は制約できれば節約するだけ良く、LISPの場合、(関数 パラメータ1 パラメータ2…)という構造しかないので余計な記号やらでトークンを消費しないのである。
これで例えばLLM1とLLM2に違うプロンプトを投げて自動的にプロンプトをチューニングして、さらに複数の提案者LLMが投げてよこした結果を、一つまたは複数の裁定者LLMが参考にしながら意見をまとめる、まとめ方やデータの優先順位の付け方なども遺伝的プログラミングが可能になる。
遺伝的プログラミングはLISPのようにプログラムとデータ構造が一致してるような言語が向いてるので、これの応用の先にMoA(Mixture of Agents)の最適化などに使うことができるはずだ。
とりあえずLISPの知識ほぼゼロで一時間くらいでこんな面倒なプログラムが出来上がって満足している。