Let's write β

プログラミング中にできたことか、思ったこととか

Lisp

三目並べのMinMax AIをLipsで

三目並べのMinMaxAIを書くという課題が出まして、 言語は不問ということだったのでとりあえずLispで書きました。 探索空間のサイズ 三目並べは最初がAIの手番だとすると、最大9! = 362880のパターンが有るのでしょうか? 最初に9マスの内にどこを打つのか?…

Business Card Raytracer in CL.

Redditを眺めていたらHaskellでRayTracingをしてみたよ的な記事が流れてきました。 So I (kind of) made a Haskell clone of the business card Ray Tracer : haskellその説明を眺めてみると何やら名刺サイズのレイトレーシングというものが話題になっていた…

SECD Machine in Lisp

;; List Utilities (defun head (lst) (car lst)) (defun tail (list) (cdr list)) ;; Lambda Expression (defun lam-expr (var body) `(lambda ,var ,body)) (defun is-lambda (list) (and (listp list) (eql 'lambda (car list)))) (defun bv (lam) (cadr …

SuffixArrayを使った簡易検索エンジンやってみた。

文字列の検索アルゴリズムについてしらべていたら、良いチュートリアルを発見したので やってみました。 簡単なWebサーチエンジンの作り方 (defun all-suffix-node (str) (loop for s from 1 to (length str) collect (cons s (subseq str (1- s))))) (defun…

特定のパターンでクラスを継承した時に発動する機能を設定したい

タイトルの通り、あるクラスが特定のクラス(複数可)を継承した時になにか処理を実行させたいのです(たとえば、メソッドを定義したり、ログに出力したり..) で、CLOSならなんとかなるんじゃないかと、ちょっと作ってみています。 (eval-when (:load-toplevel …

CL向けのCSSセレクターベースのテンプレートエンジン Caramelを作った(作っている)

ClojureのEnliveというテンプレートエンジンはClojureのWeb開発界では有名だとおもいます。 そのEnliveのAPIが綺麗でCommon Lispでも同じようなテンプレートエンジンがあったらなぁ とおもってました。 そこで調べてみるとcss-selectorsというcssセレクタを…

大津の閾値判別法

大津の閾値判別法 (ql:quickload :iterate) (ql:quickload :lispbuilder-sdl) (ql:quickload :lispbuilder-sdl-gfx) (use-package :iterate) (defclass <data> () ((max :initform (error "max must specified") :reader data-max :initarg :max) (min :initform (</data>…

迷路解答もLispで

cl-mazeという名前でgithubに置くことにした、前の迷路を構築するプロジェクトをいくつかアップデートしました。 部屋をroomというstructで管理する事にした Dijkstra法をもちいて解答を計算するようにした 以下は、そのメソッドと表示される結果 (defmethod…

ローマ字からひらがなへの変換

ローマ字入力の文字をひらがなの文字に変換してみました。 まだ異常入力への対応やら小文字への変換やら濁音拗音促音などの対応とかはしてませんけど 基礎的な変換はできてます。 (defparameter *boin-table* '(("a" . "あ") ("i" . "い") ("u" . "う") ("e"…

迷路生成をLispでPart2

LispbuilderSDLを利用しての可視化をしました、 あと、アルゴリズムの実装にミスがあったのでそちらも修正してちゃんとした迷路ができるようになりました。 (ql:quickload :lispbuilder-sdl) (ql:quickload :lispbuilder-sdl-gfx) ;;迷路のデータ構造 (defcl…

迷路生成をLispで

迷路を生成したいとおもい、Lispで簡単なクラスタリング法で生成してみました。 ;;迷路のデータ構造 (defclass <maze> () ((width :initarg :w :accessor w) (height :initarg :h :accessor h) (rooms :initarg :rooms :accessor rooms))) ;;部屋の情報を管理する</maze>…

チューリングマシンのエミュレート(2) 定義の厳密化

停止性を保証する必要はないという事で最終状態はacceptになるかどうかだけで良いという 事でerror状態を削減したり、メモリーというのはそもそも無いという事でメモリーを削除したり make-machine時に利用可能な記号列を渡す事で先に定義がただしいかチェッ…

チューリングマシンのシミュレート

昨日帰省から帰ってきていましたが飛行機の中で特にする事がなく、コンパイラの本を読んですこしつかれたのでコードを書く事にしました。そこでチューリングマシンでもつくってみたらおもしろいだろうなぁとおもい 書いてみたいのが以下です。 ;; ;; Infinit…

実行時間の計測レポート

(defmacro report-to-file (filename repeat &body form) (let ((report-out (gensym)) (idx (gensym))) `(with-open-file (,report-out ,filename :direction :output) (let ((*trace-output* ,report-out)) (loop for ,idx from 1 upto ,repeat do (format…

ランダムドットをつかった立体視画像作成

今日は休み時間に暇だったので、立体視の画像を作成するアルゴリズムを実装し 指定した文字列が見える、指定したサイズの画像を生成する関数を作成しました。 (ql:quickload :vecto) (ql:quickload :flexi-streams) (ql:quickload :opticl) (defun create-ra…

暇潰しのミニゲームは自作しよう

暇潰しの時にしたいミニゲームがあっても、手元にある事は稀です。 そんなときは、ちょっとしたミニゲームなら自作して遊んでしまうのが一番です。 自分がプレイするのでインターフェイスに凝る必要もないので、簡単です。 糸通し (ql:quickload :lispbuilde…

GCの可視化をしようとしている。

GCでのメモリの様子などを可視化するとおもしろいかもなぁとおもい とりあえず一時間ほどで書いてみました。Mark&Sweepをしています。(かなり初歩的な部分しかしていませんが) (defclass <lobject> () ((mark :initform nil :initarg :mark :accessor mark) (next :</lobject>…

バイナリサーチ

(defun kv (key val) (cons key val)) (defun make-table (&rest kv-pairs) (make-array (length kv-pairs) :initial-contents kv-pairs)) (defun aridx1 (array idx) (aref array (1- idx))) (defun bin-search (key table) (let ((lo 1) (hi (length table…

二分探索木

(defun kv (key val) (cons key val)) (defun tree (val left right) (list val left right)) (defun tree->val (tree) (car tree)) (defun tree->left (tree) (cadr tree)) (defun tree->right (tree) (caddr tree)) (defun leafp (tree) (and (null (tree-…

一次元セルオートマトンギャラリー

(ql:quickload :lispbuilder-sdl) (ql:quickload :lispbuilder-sdl-gfx) (defclass <world> () ((cells :initform () :initarg :cells :accessor cells) (rules :initform () :initarg :rules :accessor rules))) (defun make-world (len) (make-instance '<world> :cells </world></world>…

円形グラフプロット

角度と値を元にした円形のグラフを書く必要がある場面があったので、 とりあえずの出力結果を確認するためにlispbuilder-sdlをつかって書いてみました。 (ql:quickload :lispbuilder-sdl) (ql:quickload :lispbuilder-sdl-gfx) (defun read-plot-data (file-…

SBCLのdisassembleの結果を比較する

SBCLでdisassembleを用いてアセンブラ(?)を出力した時に番地などの詳細情報がでてきて diffをとって比較するのが困難なので、ちょっと必要な部分だけを抽出してくれるawkスクリプトを書いてみました。 { if(NF >= 5 && $3 ~ /.*:/) { print $3,$5,$6,$7 }…

CLでmetaclassでdispatchするdefmethodはできない?

素朴な疑問なのですが、CommonLispでdefmethodするにあたって、meta-classレベルでdispatchできるのでしょうか? http://coding.derkeiler.com/Archive/Lisp/comp.lang.lisp/2007-06/msg01042.html ここを見るかぎり、できないとの回答でした。 しかし、Post…

ダメだった..

できると、おもっていた.できなかった。 (defpartial main-layout (&rest contents) (:html (:head (:link :href "/static/css/bootstrap.css" :rel "stylesheet" :type "text/css") (:script :src "/static/js/bootstrap.min.js")) (:body contents))) CL-A…

勘違いしてた。

どうやって部分テンプレートみたいなのつくってそれを連鎖させれば良いんだろうとかいってたけど、普通にできた。勘違いしてた (ql:quickload :cl-markup) (defmacro defpartial (name args &body body) `(defun ,name ,args (markup:markup ,@body))) (defp…

正規表現でmatchをつかってcond

正規表現でマッチしたときだけ、式を実行したいときってありますよね。 ただ、二回チェックするのは冗長なので、cond風に書きたいですね。 そこでマクロです。 (defmacro aif-match (regex str then-expr &optional (else-expr nil)) (if (stringp regex) `(…

Vectoをつかってマークを自動生成

ちょっとしたマークやフラグを大量生成するならVectoをつかってみるのも手かもしれません。 (ql:quickload :vecto) (defpackage :vecto-user (:use :cl :vecto)) (in-package :vecto-user) (defun radiant-lambda (num file) (with-canvas (:width 90 :heigh…

QuickLispコマンドライン

Quicklispをコマンドラインから利用できれば便利です(?) まぁいずれにせよ、なんとなくライブラリ管理と処理系は別にしておきたいのです 本当は処理系依存をはずしたいのですが、今はこれだけ #!/usr/local/bin/sbcl --script ;;; The following lines ad…

CLでねじれヒープ

何かしらコードを書いていないと元々無い腕がなまるので、「関数プログラミングの楽しみ」を読みながらねじれヒープをHaskellからLispに移植してみました。 ;;Define basic types (defclass <tree> () ()) (defclass <null> (<tree>) ()) (defclass <fork> (<tree>) ((item :initarg :item </tree></fork></tree></null></tree>…

CommonLispではてなブックマークAPI

ちょっと情報を抽出したい事があったので、片手間ですが、つくってみました。 (ql:quickload :drakma) (ql:quickload :cl-json) (setq drakma:*text-content-types* (cons '("application" . "json") drakma:*text-content-types*)) (setq drakma:*header-st…

CLでClojure風関数ディスパッチメソッド

プログラムを書いているときに、Clojure風のメソッドのディスパッチに引数にたいして関数を適応した 結果を利用して実行するメソッドをディスパッチする機構がほしいなぁとおもいました。 そこで、MOPをつかってちょっとした実装をしてみました。 (ql:quickl…

円周率を画像に..

円周率は完全にランダムな数列なので、探索していけば原理的には可能な有限列はすべてその中に部分列として発見できるはずです。 そこで、とりあえず円周率を画像にするという事をしてみたくなりました(突発的に) そこで、簡易なスクリプトを書いてみて先…

JAG2009 ProblemA

Luck Manipulator (defun next-rand (a b c x) (mod (+ (* a x) b) c)) (defun manip-slot (y-list a b c x) (labels ((%manup-slot (y-list a b c x frm) (cond ((null y-list) ;;前のフレームでゲームが終了していたという事なので (1- frm)) ;;達成不能 (…

JAG2007ProblemD

Square Route (defun read-town (n m) (list (loop for i from 1 upto n collect (read)) (loop for i from 1 upto m collect (read)))) (defun collect-cdr (list) (loop for lst = list then (cdr lst) until (null lst) collect lst)) (defun count-squar…

JAG2010ProblemB

Moonlight Farm (defstruct seed name p a b c d e f s m) (defmethod calc-max-time ((s seed)) (+ (seed-a s) (seed-b s) (seed-c s) (seed-d s) (seed-e s) (loop for i from 1 upto (1- (seed-m s)) sum (+ (seed-d s) (seed-e s))))) (defmethod calc-m…

JAG2010ProblemA

Sum of Consecutive (defun iota (num) (loop for n from 1 upto num collect n)) (defun get-all-pattern (num) (let ((seq (iota (1+ (floor num 2))))) (loop for pat in (loop for i from 0 upto (1- (length seq)) append (loop for j from (+ 2 i) upt…

JAG2008 ProblemA

Princess's Gamble (defun ticket (m p votes) (let ((sum-of (* (/ (- 100 p) 100) (* 100 (apply #'+ votes))))) (if (zerop (nth (1- m) votes)) 0 (floor (/ sum-of (nth (1- m) votes)))))) (defun main () (loop for n = (read) for m = (read) for p …

JAG2011 ProblemA

koukyoukoukokukikou (defvar *qwarty-right* (coerce "yuiophjklnm" 'list)) (defvar *qwarty-left* (coerce "qwretasdfgzxcvb" 'list)) (defun count-hand-change (string) (let ((ch-list (coerce string 'list))) (labels ((%count-hand-change (ch-list…

ICPC2011ProblemA

チェビシェフの定理 (defun sieve-of-erathostenes (num) (let ((sieve (make-array num :initial-element 1))) (setf (aref sieve 0) 0) (loop for i from 1 upto (sqrt num) when (= 1 (aref sieve i)) do (loop for j from (1+ i) until (> (* (1+ i) j) …

ICPC2011 ProblemB

ちょっと時間がとれないので簡単な物ですみません。 (defun balancingp (str) (let ((ch-list (coerce str 'list))) (labels ((%balancing-p (ch-list stack) (if (char= #\. (car ch-list)) (null stack) (cond ((or (char= #\[ (car ch-list)) (char= #\( …

PKU Common Subsequence

さき程のコードをつかって PKU Common Subsequence http://poj.org/problem?id=1458 (defun create-lcs-table (i j) (make-array `(,(1+ i) ,(1+ j)))) (defun last1 (sequence) (typecase sequence (string (aref sequence (1- (length sequence)))) (list …

LCS With Common Lisp

LispでLCS (defun create-lcs-table (i j) (make-array `(,(1+ i) ,(1+ j)))) (defun last1 (sequence) (typecase sequence (string (aref sequence (1- (length sequence)))) (list (nth (1- (length sequence)) sequence)) (vector (aref sequence (1- (le…

ICPC2005 ProblemC

Numerial Systemです。 (defun num-char-p (char) (when (typep char 'character) (<= (char-code #\0) (char-code char) (char-code #\9)))) (defun num-char-to-num (num-char) (- (char-code num-char) (char-code #\0))) (defun num-to-num-char (num) (…

ICPC2005 ProblemB

Make Purse Light! (defun calc-return (money) (multiple-value-bind (500-yen rem) (floor money 500) (multiple-value-bind (100-yen rem) (floor rem 100) (multiple-value-bind (50-yen rem) (floor rem 50) (multiple-value-bind (10-yen rem) (floor …

ICPC2005 ProblemA

Ohgas' Fortune もちろんLis(ry (defun fukuri (money year nenri tesuuryou) (if (zerop year) money (fukuri (- (+ money (floor (* money nenri))) tesuuryou) (1- year) nenri tesuuryou))) (defun tanri (money year nenri tesuuryou) (labels ((%tanri…

ICPC2004 Problem A

Hanafuda Shuffle もちろんLispで (defun create-deck (num) (loop for card from num downto 1 collect card)) (defun cut (cards p c) (let ((head (loop for idx from 1 upto (1- p) collect (nth (1- idx) cards))) (selected (loop for idx from p upto…

ICPC2012 Problem B

さて、ひきつづき、問題Bです。 こちらも、乱暴な事ができるLispの出番です。 (defun convert-to-zero-filled-str (num len) (format nil "~v,'0,,D" len num)) (defun next-num (num len) (let* ((num-str (convert-to-zero-filled-str num len)) (max-num …

ICPC2012 Problem A

ICPC2012の問題が公開になりました。 http://www.psg.cs.titech.ac.jp/icpc/icpc2012/contest/all_ja.html というわけでLispで解いてみましょう。 さて、ProblemAですが、こんな感じですかね。 (defun calc-year-day (year) (if (zerop (mod year 3)) (* 20 …

ICPC2005 ProblemA

Keitai Message これもまぁ素直な実装ね。再帰でやるのがたのしい (defvar *button-table* '((#\. #\, #\! #\? #\Space) (#\a #\b #\c) (#\d #\e #\f) (#\g #\h #\i) (#\j #\k #\l) (#\m #\m #\o) (#\p #\q #\r #\s) (#\t #\u #\v) (#\w #\x #\y #\z))) (def…

MCCLIMのメニューの動作を変更

MCCLIMではメニューバーのメニューはマウスを押している間だけ表示され、メニューのアイテムの上でマウスをリリースするとそのメニューのコマンドが実行されるという仕様になっています。 クリックすると表示され、もういちどクリックするまではつねに表示さ…

僕が働いているAzit.incでは一緒に働けるエンジニアを募集しています!
採用情報 — 株式会社アジット|Azit Inc.