Let's write β

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

Lisp

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

続)続)CLでハフマン木

先ほどのグラフだけではハフマン符号を確認するのは大変です。ちょっと時間がそろそろ なくなってきたので、本当は葉でなく節は二重線にするなど、ちょっと工夫をしたいのですが 今はとりあえず、木の左右に0,1をふるだけにしておきます。続きはのちほど (de…

続)CLでハフマン木

とりあえず、先程の関数を変更しまして返り値を 最終結果 途中の各段階のリスト ノード間の接続 という3つのリストを返却するようにしました。 そして、そのノード間の接続から、DOTを吐きだすようにしまして、graphvizで視覚化できるように してみました。 …

CLでハフマン木

寝起きにはプログラミングが一番!というわけで、とりあえず起きてから寝むたかったので 眠けをさますために5分くらいで片手間に書いてみました。 (defun last1 (list) (car (reverse list))) (defun but-last (list) (reverse (cdr (reverse list)))) (defu…

CLで指定バイトでバイナリデータ出力

ちょっとバイナリストリームとたわむれる必要がありまして、 数値を指定したbyteで入出力する必要がありました (defun read-bytes (in number-of-bytes &key (big-endian nil)) (if big-endian (loop for idx downfrom (1- number-of-bytes) downto 0 sum (*…

Lispでdefmodel

Railsのmodelの定義が非常にうらやましかったので、ちょっとやってみました。 (defmacro defmodel (mname parent slots &rest options) (let ((indexed-slots-names (loop for slot in slots when (getf (cdr slot) :index) collect (car slot)))) `(progn (…

Lispでテケトーにhtmlのレイアウトシステムなど(2)

ちょっと修正しました、これで関数を指定できるので実行時に親のレイアウトを決定できるとおもいます。 (defclass layout () ((parent-layout :initform nil :initarg :parent :accessor parent) (layout-func :initform (error "You must specitic layout f…

Lispでテケトーにhtmlのレイアウトシステムなど

railsのレイアウトってうらやましいなぁとおもっていたので、もうちょっと親の指定に関数をつかえるようにするなどの強化はしたいですが とちゅう経過ということでここはひとつ (defclass layout () ((parent-layout :initform nil :initarg :parent :access…

色づけ、雪をふらせた

とりあえず、色をつけるのと、雪をふらせるオプションをつけてみました (defun mkstr (list) (with-output-to-string (s) (dolist (a list) (princ a s)))) (defvar foreground-color-list '(:black 30 :red 31 :green 32 :yellow 33 :blue 34 :magenta 35 :…

クリスマスツリー by Common Lisp

とりあえず、とくに祝いもなかったので寝惚けまなこで5分ぐらいで適当に書いてみました。 (defun mkstr (list) (with-output-to-string (s) (dolist (a list) (princ a s)))) (defvar foreground-color-list '(:black 30 :red 31 :green 32 :yellow 33 :blue…

Nikki

最近、パソコンで日記を書きたいなぁとおもってました。 しかしネットで検索したところあまりLinux向けには良さそうな日記ソフトが存在しないようでした。どうしたものかとおもっていたのですが、とりあえず自分でつくってしまえば良いだろうという事で自分…