読者です 読者をやめる 読者になる 読者になる

Code Aquarium

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

(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|#
#################