Code Aquarium

minazoko's blog -*- 水底のブログ -*-

トップ > Lisp

(Gauche) 2chお題「そろばんAA」

gauche Scheme Lisp お題

2ちゃんねるプログラム板　プログラミングのお題スレ Part5 より

252 名前： デフォルトの名無しさん [sage] 投稿日： 2014/10/08(水) 21:14:41.09 ID:QOSwbYHc
お題: 
整数n(0<=n<1000000)をソロバンのAAに変換するプログラムを書け 

n=9563なら 
######## 
#oo|||o# 
#||ooo|# 
######## 
#||o|oo# 
#oooo|o# 
#oooooo# 
#ooooo|# 
#oo|ooo# 
######## 

等幅フォントじゃないとちゃんと見れないけどごめんね

Gauche で

最近、自分の中で再燃している Gaucheで。

そろばんの玉がある場所を *on*, 無い場所を*off*, 枠を*wall*としています。
マス目の三状態を、二次元のu8array配列にコードでセットしていき、最後に *mapper* でasciiに変換しprintしています。
arrayは行列演算をサポートしているので、横向きに作って最後に回転させてやろうとも思いましたが、最初から縦向きなるよう処理しても大差ないのでやめました。ランダムアクセスできるデータ構造ですからね。

(use srfi-1)
(use srfi-11)
(use gauche.array)
(use util.combinations)

(define *default-width* 8)

(define *on* 0)
(define *off* 1)
(define *wall* 2)

(define *dim-h* 0)
(define *dim-w* 1)

(define *mapper*
  `((,*on* . #\O)
    (,*off* . #\|)
    (,*wall* . #\#)))

(define *code0* (x->integer #\0))

(define (parse-digits n)
  (let1 cs (string->list (x->string n))
    (map (^c (- (x->integer c) *code0*)) cs)))

(define (so-array width)
  (let* ((h (+ 2 5 1 1 1))
         (w (+ width 2))
         (so (make-u8array (shape 0 h 0 w))))
    (for-each
     (^[pos] (array-set! so (cadr pos) (car pos) *wall*))
     (append (cartesian-product `((0 ,(- w 1)) ,(iota h)))
             (cartesian-product `(,(iota w) (0 3 9)))))
    so))

(define (so-set! so i n)
  (let*-values (((q r) (quotient&remainder n 5))
                ((q r) (values (+ 1 (logxor q 1))
                               (+ 4 r))))
    (array-set! so q i *off*)
    (array-set! so r i *off*)))

(define (so-print so)
  (let* ((w (array-length so *dim-w*))
         (cs (map (pa$ assoc-ref *mapper*)
                  (array->list so))))
    (for-each (.$ print list->string)
              (slices cs w))))

(define (solve n)
  (let* ((ns (parse-digits n))
         (ns-len (length ns))
         (so-width (max ns-len *default-width*))
         (so (so-array so-width)))
    (for-each
     (^p (apply so-set! so p))
     (zip (iota so-width so-width -1)
          (append (reverse ns)
                  (make-list (- so-width ns-len) 0))))
    (newline)
    (print #"[~n]")
    (so-print so)))

(define (main args)
  (for-each
   solve
   (map x->integer (cdr args))))
実行
$ gosh soroban.scm  0 9563 314159265358979

[0]
##########
#OOOOOOOO#
#||||||||#
##########
#||||||||#
#OOOOOOOO#
#OOOOOOOO#
#OOOOOOOO#
#OOOOOOOO#
##########

[9563]
##########
#OOOO|||O#
#||||OOO|#
##########
#||||O|OO#
#OOOOOO|O#
#OOOOOOOO#
#OOOOOOO|#
#OOOO|OOO#
##########

[314159265358979]
#################
#OOOO||O||O|||||#
#||||OO|OO|OOOOO#
#################
#OOOO|OOO|O|OOOO#
#O|O|OOO|OOOOOOO#
#OOOOOO|OOOOOO|O#
#|OOOOOOOO|O|OOO#
#OO|OO|OOOOOO|O|#
#################

(Racket) generatorでFizzBuzz

Racket Lisp Scheme

racketにもgeneratorライブラリがあるので、前回のgaucheのコードを移植……しようとした。しかしracketのgeneratorは汎用ストリームのように使うには、どうにも使いづらかった……。
steramとの相互変換が出来ればもっと楽できそうなんだけど。

#lang racket

(require racket/generator)
(require srfi/1)

(define (circular n s)
  (sequence->repeated-generator
   (cons s (make-list (- n 1) ""))))

(define (giota)
  (infinite-generator
   (let loop ((n 0))
     (yield n)
     (loop (+ n 1)))))

(define (generator->list g n)
  (unfold (λ(a)(zero? (cdr a)))
          (λ(a)((car a)))
          (λ(a)(cons (car a) (- (cdr a) 1)))
          (cons g n)))

(define (gfizzbuzz)
  (let ((g (infinite-generator
            (let loop ((gens (list (giota)
                                   (circular 3 "Fizz")
                                   (circular 5 "Buzz"))))
              (yield (match (map (λ(g)(g)) gens)
                       ((list n "" "") n)
                       ((list _ f b) (string-append f b))))
              (loop gens)))))
    (g)  ; drop 1
    g))


;; usage example
;; (generator->list (gfizzbuzz) 100)

追記 (2014/10/7)

for系syntaxや、シーケンスライブラリ in-xxx を使うともう少し綺麗に書けそう。

#lang racket
(require racket/generator)

(define (circular n s)
  (sequence->repeated-generator
   (cons s (make-list (- n 1) ""))))

(define (generator->list g n)
  (for/list ((i (in-naturals)) #:break (>= i n))
    (g)))

(define (gfizzbuzz)
  (define gens (list (circular 3 "Fizz")
                     (circular 5 "Buzz")))
  (let ((g (generator ()
            (for ((i (in-naturals)))
              (yield (match (map (λ(g)(g)) gens)
                       ((list "" "") i)
                       ((list f "") f)
                       ((list "" b) b)
                       ((list f b) (string-append f b))))))))
    (g)  ; drop 1
    g))

(generator->list (gfizzbuzz) 100)

(Gauche)generatorでFizzBuzz

Scheme Lisp Gauche

毎度似たような FizzBuzzを書いていますが、gaucheでgeneratorを使ったバージョン。

無限リストを３本作ってマージするこの方式は、n f b を受け取った後、n をとるか f b をとるかの判定部分が泥臭くなります。
今回はパターンマッチを使って多少はすっきりしたかな～という感じです。

gauche特有の機能としては、^によるラムダ式構築と、#string-literal の文字列内変数展開を使っています。

(use gauche.generator)
(use util.match)

(define (circular n s)
  (apply circular-generator
         s (make-list (- n 1) "")))

(define (gfizzbuzz)
  (let1 g (gmap (^[n f b] (match `(,n ,f ,b)
                                 ((_ "" "") n)
                                 (else #"~|f|~b")))
                (giota)
                (circular 3 "Fizz")
                (circular 5 "Buzz"))
        (gdrop g 1)))


;; usage example
;; (generator->list (gfizzbuzz) 100)