DouKaku?beta

Language detail: Common Lisp

Coverage: 92.14%
number of '+' ratings
 contribution for coverage

Unsolved challenges

show all

codes

Feed

Used modules

next >>

タブ区切りデータの処理 (Nested Flatten)
オブジェクト指向っぽく書いてみたつもりです…
(with-open-file (in "doukaku-209.data")
  (update-file (make-instance 'doukaku-209) in *standard-output*))
;>>>
ID Forename Surname Age
0 Taro Suzuki 19
1 Hanako Sato 18 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
(defpackage :doukaku-209 (:use :cl :split-sequence))
(in-package :doukaku-209)

(defclass file-op () ())

(defgeneric file-to-data (file-op stream))
(defgeneric swap-colum (file-op data))
(defgeneric sort-data (file-op data))
(defgeneric update-datum (file-op data))
(defgeneric format-out-data (file-op stream data))
(defgeneric update-file (file-op in-stream out-stream))

(defmethod update-file ((op file-op) (in stream) (out stream))
  (format-out-data op out
    (swap-colum op 
      (destructuring-bind (title &rest data) (file-to-data op in)
        `(,title ,@(sort-data op (loop :for line :in data 
                                       :collect (update-datum op line))))))))
                     
(defclass doukaku-209 (file-op) ())

(defmethod file-to-data ((op doukaku-209) (in stream))
  (loop :for line := (read-line in nil nil) :while line
        :collect (split-sequence #\Tab line)))

(defmethod swap-colum ((op doukaku-209) (data list))
  (loop :for xx :in (copy-list data) 
        :do (rotatef (nth 1 xx) (nth 2 xx)) 
        :collect xx))

(defmethod sort-data ((op doukaku-209) (data list))
  (sort (copy-list data) #'< :key #'first))

(defmethod format-out-data ((op doukaku-209) (out stream) (data list))
  (format out "~{~{~A~^    ~}~%~}" data))

(defmethod update-datum ((op doukaku-209) (row list))
  (destructuring-bind (id sur fore age) row
    (list (parse-integer id)
          sur
          fore
          (1+ (parse-integer age)))))
なんだか書き捨てって感じになってしまいました(^^; 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
(defpackage :doukaku-209 (:use :cl :split-sequence))
(in-package :doukaku-209)

(defun parse-integer-or-never (string &key (after #'values))
  (let ((num (parse-integer string :junk-allowed 'T)))
    (if num (funcall after num) string)))

(with-open-file (in "doukaku-209.data")
  (with-open-file (out "doukaku-209.out" :direction :output :if-exists :supersede)
    (format out "~{~{~A~^    ~}~%~}"
            (destructuring-bind (title &rest data)          
                (loop :for (id sur fore age) :=  (split-sequence #\Tab (read-line in nil nil)) 
                      :while (and id sur fore age)
                      :collect (list (parse-integer-or-never id) 
                                     fore 
                                     sur 
                                     (parse-integer-or-never age :after #'1+)))
              `(,title ,@(sort data #'< :key #'first))))))
2^i * 3^j * 5^k なる整数 (Nested Flatten)

適当に生成しながら小さい順に並べてます。動けばいい的な作りですが。考え方は 84q さんのと同じでしょうか。

計算量は時間 O(N^2) 空間 O(N) かと思いましたが、実際に試してみた感じだともっと小さいかもしれません。また balanced tree をつかうなど真面目に効率化をやればもっと速くなると思います。

1
2
3
4
5
6
7
8
9
(defun add (n list)
  (if (find n list) list (merge 'list list (list n) #'<)))

(defun h (n)
  (let ((a (list 1)) (c 0))
    (loop (let ((m (pop a)))
            (print m)
            (setf a (add (* m 2) (add (* m 3) (add (* m 5) a))))
            (if (= (incf c) n) (return))))))
文字列型日時ののN秒後時間取得 (Nested Flatten)
net-telent-dateを使ってRFC 2822形式で出力するようにしてみました。
他にも様々な形式をパーズしてくれるライブラリです。
CLの引数の順番はお題の例とは逆にしています。
(date-ex 40 "Thu, 28 Aug 2007 23:59:25 +0900")
;=> "Thu, 30 Aug 2007 00:00:05 +0900" 

(date-ex -3600)
;=> "Mon, 01 Sep 2008 17:56:51 +0900" 

see: net-telent-date 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
(require :net-telent-date)
(require :lw-compat)

(defpackage :doukaku-204 (:use :cl :date :lispworks))
(in-package :doukaku-204)

(defun date-ex (sec &optional time-string)
  (when-let (ut (if time-string
                    (parse-time time-string)
                    (get-universal-time)))
    (universal-time-to-rfc2822-date (+ ut sec))))
LL Golf Hole 8 - 横向きのピラミッドを作る (Nested Flatten)

do でカウンタを使う場合は終了判定で incf/decf すると一文字減ります。

1
2
(do*((e(read))(i(- e)))((=(incf i)e))(format t"~V@{*~}
"(- e(abs i))t))

書式パクらせてもらいました。 これは知らなかった…

1
(do*((e(read))(i(- e)(1+ i)))((= i e))(format t"~,,V,'*A~%"(- e(abs i))""))
パディング文字で描いたらいい感じかなと思ったんですが、全然短くできませんでした…。 
1
2
3
4
5
(format t "~{~,,V,'*A~%~}"
    (do ((i 1 (1+ i))
         (r () `("" ,i ,@r))
         (a () `(,i "" ,@a)))
        ((< 4 i) `(,@(nreverse r) ,@(cddr a)))))
ポリゴンを表示するプログラム (Nested Flatten)

cl-glfwを利用しています。付属のサンプルを少し改造しただけです。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
require '#:asdf)
(asdf:oos 'asdf:load-op '#:cl-glfw)
(asdf:oos 'asdf:load-op '#:cl-glfw-opengl)
(asdf:oos 'asdf:load-op '#:cl-glfw-glu)

(glfw:do-window ("A Polygon Example")
    ((gl:with-setup-projection
       (glu:perspective 45 4/3 0.1 50)))
  (gl:clear gl:+color-buffer-bit+)
  (gl:load-identity)
  (gl:translate-f 0 0 -5)
  (gl:rotate-f (* 10 (glfw:get-time)) 1 1 0)
  (gl:rotate-f (* 90 (glfw:get-time)) 0 0 1)
  (gl:with-begin gl:+line-loop+ ;+triangle-strip+
    (gl:color-3f 0 1 0) (gl:vertex-3f -1  1 0)
    (gl:color-3f 0 0 1) (gl:vertex-3f -1 -1 0)
    (gl:color-3f 0 1 0) (gl:vertex-3f -1  0 1)
    (gl:color-3f 0 1 0) (gl:vertex-3f -1  1 0)
    (gl:color-3f 1 0 0) (gl:vertex-3f  1  0 0)
    (gl:color-3f 0 1 0) (gl:vertex-3f -1  0 1)
    (gl:color-3f 1 0 0) (gl:vertex-3f  1  0 0)
    (gl:color-3f 0 0 1) (gl:vertex-3f -1 -1 0)))
LL Golf Hole 6 - 10進数を2進数に基数変換する (Nested Flatten)

標準入力から基数、数値の順で。基数は 36 までです。

1
(format t"~VR"(read)(read))
LL Golf Hole 5 - 最上位の桁を数え上げる (Nested Flatten)
標準入力から 
1
(do((a 1)(e(read)))((< e(incf a(expt 10(floor(log(print a)10)))))))
LL Golf Hole 4 - 文章から単語の索引を作る (Nested Flatten)
seriesとcl-ppcreとdrakmaを使ってみました。 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
(require :cl-ppcre)
(defpackage :doukaku-198 (:use :cl :drakma :series))
(in-package :doukaku-198)

(let* ((text (http-request "http://www.gnu.org/licenses/gpl.txt"))
       (ht (collect-hash (scan (ppcre:all-matches-as-strings "\\w+" text)) 
                         (series () )
                         :test #'equalp)))
  (iterate ((line (scan (ppcre:split "\\n" text)))
            (num (scan-range :from 1)))
    (dolist (w (ppcre:all-matches-as-strings "\\w+" line))
      (push num (gethash w ht))))
  (iterate (((k v) (scan-hash ht)))
    (format t "~A => ~A~%" k (nreverse v))))

ゴルフじゃないけど汚くならない程度に短くした版。

1
2
3
4
5
6
7
8
9
(loop with table = (make-hash-table :test 'equal)
  for i from 1 while (listen) do
  (loop with a = 0 and b = 0 and s = (read-line)
    while (and (setf a (position-if #'alpha-char-p s :start b))
               (setf b (position-if-not #'alpha-char-p s :start a)))
    do (push i (gethash (subseq s a b) table)))
  finally
  (loop for k being each hash-key of table using (hash-value v)
    do (format t "~A: ~{~D~^, ~}~%" k (nreverse v))))
LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

あんまりゴルフっぽくなりませんでした。 anarchy golf なら embed するところ。

1
2
3
4
5
6
(princ (loop for y from 2008 to 2013 sum
         (loop for m from 1 to 12
           as x = (encode-universal-time 0 0 0 13 m y)
           as a = (and (< (get-universal-time) x)
                       (= (elt (multiple-value-list (decode-universal-time x)) 6) 4))
           count a if a do (format t "~D-~D-13~%" y m))))
SERIESとMETATILITIESを利用してみました。

;>>> Friday, February 13, 2009
;>>> Friday, March 13, 2009
;>>> Friday, November 13, 2009
;>>> Friday, August 13, 2010
;>>> Friday, May 13, 2011
;>>> Friday, January 13, 2012
;>>> Friday, April 13, 2012
;>>> Friday, July 13, 2012
;>>> Friday, September 13, 2013
;>>> Friday, December 13, 2013
;==> 10 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
(use-package :series)

(defun friday13-p (ut)
  (and (= 13 (nth-value 3 (decode-universal-time ut)))
       (= 4 (nth-value 6 (decode-universal-time ut)))))

(let* ((from (get-universal-time))
       (to (encode-universal-time 59 59 23 31 12 2013))
       (uts (choose-if #'friday13-p (scan-range :from from :upto to :by (* 60 60 24)))))
  (iterate ((ut uts)) 
    (format t "~A~%" (metatilities:date-string ut)))
  (collect-length uts))
LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする (Nested Flatten)

これぐらいが限界かも。CLISP で動作確認しました。

ただし char< で大文字が小文字より小さいと判定されるかどうかは実装依存なので、言語仕様上は期待した動作をすることは保障されません。

1
(defun cap(s)(map'string(lambda(a b)(if(char< a b)a b))s(string-capitalize s)))
短いのは諦めるとしてちょっとひねった方法を思いついたので記念に投稿してみます。 
1
2
3
4
5
(defun cap (stream string &rest args)
  (princ (string-capitalize string :end 1) stream))

(format nil "~{~/cap/~^ ~}" (ppcre:split"\\s+" "LL day and night"))
;=> "LL Day And Night"
全然短くできないですね(^^;
最初の1文字だけ大文字というのなら標準でいくつか方法があるのですが…。 
1
2
(format()"~{~A~^ ~}"(mapcar(lambda(x)(string-capitalize x :end 1))(ppcre:split"\\s+""LL day and night")))
;=> "LL Day And Night"
コメントの削除 (Nested Flatten)
手抜きですいません、readしてpprintしているだけです。
一応、文字の大小位は保持するようにしてみました。 
1
2
3
4
5
6
7
8
9
(defpackage :doukaku-185 (:use :cl :series))
(in-package :doukaku-185)

(defun remove-comment (file)
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :preserve)
    (iterate ((line (scan-file file #'read)))
      (pprint line)
      (terpri))))
LL Golf Hole 1 - tinyurl.comを使ってURLを短縮する (Nested Flatten)
UNIXシェル上の一行野郎じゃないといけない雰囲気を感じたので努力してみました。
ライブラリが組み込まれたコアを利用する必要があります。
SBCLで書いていますが、他の処理系でも同じような感じになると思います。 
1
sbcl --noinform --core your.core --eval '(progn(princ(kmrcl:awhen(drakma:http-request"http://tinyurl.com/api-create.php?url=http://ll.jus.or.jp/2008/info/xgihyo")(when(ppcre:scan"http://tinyurl.com\/[a-z0-9-]+"kmrcl:it)kmrcl:it)))(terpri)(quit))'
コード圧縮 (Nested Flatten)
readで読んで、writeでプリティプリント属性をオフにして印字してみています。
入力ファイル:
;;; doukaku-189.data -*- lisp -*- 

;; 1
(let ((x 10   )
      (y 20  ))
  (list x  y  ))

;; 2
(let ((x 10)
      (y   20))
  (list x  y   ))
~~
印字結果:
(LET ((X 10) (Y 20)) (LIST X Y))(LET ((X 10) (Y 20)) (LIST X Y)) 
1
2
3
(with-open-file (str "doukaku-189.data")
  (loop :for in := (read str nil nil) :while in 
        :do (write in :pretty nil)))
next >>

Index

Feed

Other

Link

Pathtraq

loading...
Creative Commons License このサイトの内容は、 クリエイティブ・コモンズ・ライセンスの下でライセンスされています。 [詳細]