C Magazine 2005/2月号の「Cマガ電能クラブ」の問題から。 でもやっぱり Scheme で組んでみる。 ちなみに下の初期画面は私が勝手に作ったもので、 出題としては作れと書いてるわけじゃないです。 絵が無いとイメージしづらかろうということで。 C Magazineの方にはもっと分かりやすい絵が書かれてます。
初期画面
---- A ----- B ----- C ----
1 2 3
R R R
\ 4 5 /
/ R R \
6 7 8
R R R
------------EXT------------
規則
- 画面の上には A B C の三箇所のボール投入口がある。
- 一番下に EXT というボールの排出口があり、上から下に向かってアンカーにぶつかりながら落ちて行く。
- 今 R って書いてあるのがアンカーで、全部で８つある。 上に書いてあるのがアンカーの番号だ。
- ボールがアンカーに当たるとアンカーは R <=> L と右左に傾く。 これはトグルのようなもので、初期状態は R つまり右状態。 次に当たれば L になり、また当たれば R になる。
- ボールがアンカーに当たって R -> L に傾いたらボールは L つまり左に流されて 下に落ちる。L -> R に傾いたら R つまり右に流されて落ちる。
- 左右の端には壁があり、跳ね返るので 3 から右に流れた場合には壁パスから 8 へ、 また、 1 から左に流れた場合には壁パスで 6 へ当たることになる。
問題
ここで全てのアンカーを反対側に倒した状態にするには、 どこに何回玉を落とす必要があるか？ このパズルの解答を導き出すプログラムをCで作成せよ。
さらに続きがあって投入口が A,B,C,D と４箇所あってアンカーが 4,3,4,3,4 と、 全部で 18 個ならんだパチンコ画面でもやってみろという課題だ。
例えば、 B から一個ボールを投入すると、 2->4->6 と当たり、次の様になる。
gosh> (entB 'ball)
---- A ----- B ----- C ----
1 2 3
R L R
\ 4 5 /
/ L R \
6 7 8
L R R
------------EXT------------
さらに B からもう一個ボールを投入すると、 2->5->7 と当たり、次のようになる。
gosh> (entB 'ball)
---- A ----- B ----- C ----
1 2 3
R R R
\ 4 5 /
/ L L \
6 7 8
L L R
------------EXT------------
一番最初に A から投入したらこうなる。
gosh> (entA 'ball)
---- A ----- B ----- C ----
1 2 3
L R R
\ 4 5 /
/ R R \
6 7 8
L R R
------------EXT------------
というもので、動きを良く見ればある法則がわかってくるので、 そうなればそんなに難しい問題ではないとコメントされている。
Cでこれだけのプログラムをさっと書けるだけのスキルも根性もない私は
当り前みたいな顔して scheme で。
まずはその法則とやらを考えてみようと対話的に遊べるアンカーパチンコを作成してみたが…ちょっと遊んだ感じでは、まだ分からんす。
;; C Magazine 2005/2 Cマガ電能クラブ
;; アンカーパチンコ
;;
(use srfi-1) ;; for every
(define (make-anchor)
(let ((pos 'right)
(left #f)
(right #f))
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (if (eq? pos 'left)
(begin (set! pos 'right)
(right 'ball))
(begin (set! pos 'left)
(left 'ball))))
((eq? cmd 'bind) (begin (set! left (car arg))
(set! right (cadr arg))
'done))
((eq? cmd 'view) (if (eq? pos 'left) 'L 'R))
(else (error "ERROR: anchor has no such message" cmd)))))))
(define (bind anchor left . right)
(apply anchor 'bind left right))
(define (make-entry)
(let ((below #f))
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (below 'ball))
((eq? cmd 'bind) (set! below (car arg)))
(else (error "ERROR: entry has no such message" cmd)))))))
(define (make-exit disp)
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (disp))
(else (error "ERROR: exit has no such message" cmd))))))
;; single make to multiple defines
;;
(define-macro (smake->mdef multiple single)
`(define-macro (,multiple . args)
`(begin
,@(map (lambda (name)
`(define ,name (,',single)))
args))))
(smake->mdef make-anchors make-anchor)
(smake->mdef make-entrys make-entry)
;; Bootstrap for anchor pachinco game.
;;
(define (display-anchors)
(format #t "---- A ----- B ----- C ----~%")
(newline)
(format #t " 1 2 3 ~%")
(format #t " ~a ~a ~a ~%"
(anc1 'view) (anc2 'view) (anc3 'view))
(format #t "\\ 4 5 /~%")
(format #t "/ ~a ~a \\~%"
(anc4 'view) (anc5 'view))
(format #t " 6 7 8 ~%")
(format #t " ~a ~a ~a ~%"
(anc6 'view) (anc7 'view) (anc8 'view))
(newline)
(format #t "------------EXT------------~%")
(if (every (lambda (a) (eq? 'L (a 'view)))
(list anc1 anc2 anc3 anc4 anc5 anc6 anc7 anc8))
(format #t "C L E A R ! !~%"))
)
(make-anchors anc1 anc2 anc3 anc4 anc5 anc6 anc7 anc8)
(make-entrys entA entB entC)
(define ext (make-exit display-anchors))
(bind entA anc1)
(bind entB anc2)
(bind entC anc3)
(bind anc1 anc6 anc4)
(bind anc2 anc4 anc5)
(bind anc3 anc5 anc8)
(bind anc4 anc6 anc7)
(bind anc5 anc7 anc8)
(bind anc6 ext ext)
(bind anc7 ext ext)
(bind anc8 ext ext)
;; Local variables:
;; mode: scheme
;; end:
とりあえず、最初のは対話的に遊べるだけ。 解を探索するところには至ってないです。
gosh> (load "./anc.scm")
#t
gosh> (display-anchors)
---- A ----- B ----- C ----
1 2 3
R R R
\ 4 5 /
/ R R \
6 7 8
R R R
------------EXT------------
#<undef>
gosh> (entA 'ball)
---- A ----- B ----- C ----
1 2 3
L R R
\ 4 5 /
/ R R \
6 7 8
L R R
------------EXT------------
#<undef>
gosh> (entB 'ball)
---- A ----- B ----- C ----
1 2 3
L L R
\ 4 5 /
/ L R \
6 7 8
R R R
------------EXT------------
#<undef>
;; C Magazine 2005/2 Cマガ電能クラブ
;; アンカーパチンコ
;;
(use srfi-1) ;; for every
(use util.combinations)
(define (make-anchor name)
(let ((pos 'right)
(left #f)
(right #f))
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (if (eq? pos 'left)
(begin (set! pos 'right)
(right 'ball))
(begin (set! pos 'left)
(left 'ball))))
((eq? cmd 'bind) (begin (set! left (car arg))
(set! right (cadr arg))
'done))
((eq? cmd 'view) (if (eq? pos 'left) 'L 'R))
((eq? cmd 'name) name)
((eq? cmd 'init) (set! pos 'right))
(else (error "ERROR: anchor has no such message" cmd)))))))
(define (bind anchor left . right)
(apply anchor 'bind left right))
(define (make-entry name)
(let ((below #f))
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (below 'ball))
((eq? cmd 'bind) (set! below (car arg)))
((eq? cmd 'name) name)
(else (error "ERROR: entry has no such message" cmd)))))))
(define (make-exit disp)
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) #t) ;;
(else (error "ERROR: exit has no such message" cmd))))))
;; single make to multiple defines
;;
(define-macro (smake->mdef multiple single)
`(define-macro (,multiple . args)
`(begin
,@(map (lambda (name)
`(define ,name (,',single ',name)))
args))))
(smake->mdef make-anchors make-anchor)
(smake->mdef make-entrys make-entry)
;; Bootstrap for anchor pachinco game.
;;
(define (initialize)
(for-each (lambda (name) (name 'init))
*anchors*))
(define (display-anchors)
(format #t "---- A ----- B ----- C ----~%")
(newline)
(format #t " 1 2 3 ~%")
(format #t " ~a ~a ~a ~%"
(anc1 'view) (anc2 'view) (anc3 'view))
(format #t "\\ 4 5 /~%")
(format #t "/ ~a ~a \\~%"
(anc4 'view) (anc5 'view))
(format #t " 6 7 8 ~%")
(format #t " ~a ~a ~a ~%"
(anc6 'view) (anc7 'view) (anc8 'view))
(newline)
(format #t "------------EXT------------~%")
(if (every (lambda (a) (eq? 'L (a 'view)))
*anchors*)
(begin
(format #t "C L E A R ! !~%") #t)
#f)
)
(make-anchors anc1 anc2 anc3 anc4 anc5 anc6 anc7 anc8)
(define *anchors* (list anc1 anc2 anc3 anc4 anc5 anc6 anc7 anc8))
(make-entrys entA entB entC)
(define *ents* (list entA entB entC))
(define *ext* (make-exit display-anchors))
(bind entA anc1)
(bind entB anc2)
(bind entC anc3)
(bind anc1 anc6 anc4)
(bind anc2 anc4 anc5)
(bind anc3 anc5 anc8)
(bind anc4 anc6 anc7)
(bind anc5 anc7 anc8)
(bind anc6 *ext* *ext*)
(bind anc7 *ext* *ext*)
(bind anc8 *ext* *ext*)
;; automatic
;;
(define (make-seq lst n)
(combinations*
(apply append (make-list n lst))
n))
(define (clear? seq)
(for-each (lambda (ent) (ent 'ball)) seq)
(let1 result (every (lambda (a) (eq? 'L (a 'view))) *anchors*)
(initialize)
(if result #t #f)))
(define (main args)
(call/cc
(lambda (c)
(let loop ((i 1))
(for-each (lambda (s)
(if (clear? s)
(c (map (lambda (a) (a 'name)) s))))
(make-seq *ents* i))
(loop (+ i 1))))))
;;
;; first answer
;;(1 0 1 1 1 1 2)
;; => (B A B B B B C) でやるとできる。
;;
;; Local variables:
;; mode: scheme
;; end:
;; C Magazine 2005/2 Cマガ電能クラブ
;; アンカーパチンコ 2
;;
(use srfi-1) ;; for every
(use util.combinations)
(define (make-anchor name)
(let ((pos 'right)
(left #f)
(right #f))
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (if (eq? pos 'left)
(begin (set! pos 'right)
(right 'ball))
(begin (set! pos 'left)
(left 'ball))))
((eq? cmd 'bind) (begin (set! left (car arg))
(set! right (cadr arg))
'done))
((eq? cmd 'view) (if (eq? pos 'left) 'L 'R))
((eq? cmd 'name) name)
((eq? cmd 'init) (set! pos 'right))
(else (error "ERROR: anchor has no such message" cmd)))))))
(define (bind anchor left . right)
(apply anchor 'bind left right))
(define (make-entry name)
(let ((below #f))
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) (below 'ball))
((eq? cmd 'bind) (set! below (car arg)))
((eq? cmd 'name) name)
(else (error "ERROR: entry has no such message" cmd)))))))
(define (make-exit disp)
(lambda args
(let ((cmd (car args))
(arg (cdr args)))
(cond ((eq? cmd 'ball) #t) ;;
(else (error "ERROR: exit has no such message" cmd))))))
;; single make to multiple defines
;;
(define-macro (smake->mdef multiple single)
`(define-macro (,multiple . args)
`(begin
,@(map (lambda (name)
`(define ,name (,',single ',name)))
args))))
(smake->mdef make-anchors make-anchor)
(smake->mdef make-entrys make-entry)
;; Bootstrap for anchor pachinco game.
;;
(define (initialize)
(for-each (lambda (name) (name 'init))
*anchors*))
(define (display-anchors)
(format #t "---- A ----- B ----- C ----- D ----~%")
(newline)
(format #t " 1 2 3 4 ~%")
(format #t " ~a ~a ~a ~a ~%"
(anc1 'view) (anc2 'view) (anc3 'view) (anc4 'view))
(format #t "\\ 5 6 7 /~%")
(format #t "/ ~a ~a ~a \\~%"
(anc5 'view) (anc6 'view) (anc7 'view))
(format #t " 8 9 10 11 ~%")
(format #t " ~a ~a ~a ~a ~%"
(anc8 'view) (anc9 'view) (anc10 'view) (anc11 'view))
(format #t "\\ 12 13 14 /~%")
(format #t "/ ~a ~a ~a \\~%"
(anc12 'view) (anc13 'view) (anc14 'view))
(format #t " 15 16 17 18 ~%")
(format #t " ~a ~a ~a ~a ~%"
(anc15 'view) (anc16 'view) (anc17 'view) (anc18 'view))
(newline)
(format #t "----------------EXT----------------~%")
(if (every (lambda (a) (eq? 'L (a 'view)))
*anchors*)
(begin
(format #t "C L E A R ! !~%") #t)
#f)
)
(make-anchors anc1 anc2 anc3 anc4 anc5 anc6
anc7 anc8 anc9 anc10 anc11 anc12
anc13 anc14 anc15 anc16 anc17 anc18)
(define *anchors* (list anc1 anc2 anc3 anc4 anc5 anc6
anc7 anc8 anc9 anc10 anc11 anc12
anc13 anc14 anc15 anc16 anc17 anc18))
(make-entrys entA entB entC entD)
(define *ents* (list entA entB entC entD))
(define *ext* (make-exit display-anchors))
(bind entA anc1)
(bind entB anc2)
(bind entC anc3)
(bind entD anc4)
(bind anc1 anc8 anc5)
(bind anc2 anc5 anc6)
(bind anc3 anc6 anc7)
(bind anc4 anc7 anc11)
(bind anc5 anc8 anc9)
(bind anc6 anc9 anc10)
(bind anc7 anc10 anc11)
(bind anc8 anc15 anc12)
(bind anc9 anc12 anc13)
(bind anc10 anc13 anc14)
(bind anc11 anc14 anc18)
(bind anc12 anc15 anc16)
(bind anc13 anc16 anc17)
(bind anc14 anc17 anc18)
(bind anc15 *ext* *ext*)
(bind anc16 *ext* *ext*)
(bind anc17 *ext* *ext*)
(bind anc18 *ext* *ext*)
;; automatic
;;
(define (make-seq lst n)
(combinations*
(apply append (make-list n lst))
n))
(define (clear? seq)
(for-each (lambda (ent) (ent 'ball)) seq)
(let1 result (every (lambda (a) (eq? 'L (a 'view))) *anchors*)
(initialize)
(if result #t #f)))
(define (main args)
(call/cc
(lambda (c)
(let loop ((i 1))
(for-each (lambda (s)
(if (clear? s)
(c (map (lambda (a) (a 'name)) s))))
(make-seq *ents* i))
(loop (+ i 1))))))
;;
;; first answer
;; (entA entB entC entD entA entB entC entA entB entC entA entB entC entA
;; entB entC entA entB entA entB entA entB entA entB entA entA entA entA)
;; A 13 回 B 9 回 C 5 回 D 1 回
;;
;; Local variables:
;; mode: scheme
;; end:
簡単化したパチンコ台の解だ。
(use srfi-1)
(use util.combinations)
(define (froml left)
(if (even? left)
(/ left 2)
(/ (- left 1) 2)))
(define (fromr right)
(if (odd? right)
(/ (+ right 1) 2)
(/ right 2)))
(define (set-of sum hole)
(let ((set (filter odd? (iota sum 1))))
(filter
(lambda (lst)
(if (= sum (apply + lst))
#t #f))
(combinations
(apply append
(make-list hole set)) hole))))
(define (anchors a b c)
(let ((a1 a)
(a2 b)
(a3 c))
(let ((a4 (+ (froml a1) (fromr a2)))
(a5 (+ (froml a2) (fromr a3))))
(let ((a6 (+ (fromr a1) (fromr a4)))
(a7 (+ (froml a4) (fromr a5)))
(a8 (+ (froml a3) (froml a5))))
(list a1 a2 a3 a4 a5 a6 a7 a8)))))
(define (main args)
(call/cc
(lambda (c)
(let loop ((sum 3))
(for-each
(lambda (s)
(if (every odd? (apply anchors s)) (c s)))
(set-of sum 3))
(loop (+ sum 2))))))
同じく。高速化手段としては lazy にするってのがある。 なんせパターン生成がいまいちだ。
(use srfi-1)
(use util.combinations)
(define (froml left)
(if (even? left)
(/ left 2)
(/ (- left 1) 2)))
(define (fromr right)
(if (odd? right)
(/ (+ right 1) 2)
(/ right 2)))
(define (set-of sum hole)
(let ((set (filter odd? (iota sum 1))))
(filter
(lambda (lst)
(if (= sum (apply + lst))
#t #f))
(combinations
(apply append
(make-list hole set)) hole))))
(define (anchors a b c d)
(let ((a1 a)
(a2 b)
(a3 c)
(a4 d))
(let ((a5 (+ (froml a1) (fromr a2)))
(a6 (+ (froml a2) (fromr a3)))
(a7 (+ (froml a3) (fromr a4))))
(let ((a8 (+ (fromr a1) (fromr a5)))
(a9 (+ (froml a5) (fromr a6)))
(a10 (+ (froml a6) (fromr a7)))
(a11 (+ (froml a7) (froml a4))))
(let ((a12 (+ (froml a8) (fromr a9)))
(a13 (+ (froml a9) (fromr a10)))
(a14 (+ (froml a10) (fromr a11))))
(let ((a15 (+ (fromr a8) (fromr a12)))
(a16 (+ (froml a12) (fromr a13)))
(a17 (+ (froml a13) (fromr a14)))
(a18 (+ (froml a14) (froml a11))))
(list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18)))))))
(define (main args)
(call/cc
(lambda (c)
(let loop ((sum 4))
(for-each
(lambda (s)
(if (every odd? (apply anchors s)) (c s)))
(set-of sum 4))
(loop (+ sum 2))))))
とりあえず
ていう知見を得て組んでみた。べたべただけど。 やっぱりmapやらcombinationでざっくざっく試せるschemeとはちょっと違う。
#include <stdio.h>
#include <stdlib.h>
#define CYCLIC_LIMIT 8
#define ANCHORS 8
#define LEFT 0
#define RIGHT 1
#define ext (struct anchor *)NULL
typedef struct anchor {
int state;
struct anchor *l;
struct anchor *r;
}anchor;
struct anchor anc[ANCHORS];
void bind(anchor *anc, anchor *left, anchor *right)
{
anc->l = left;
anc->r = right;
}
void init_anchors(int state)
{
int i;
for(i=0; i<ANCHORS; i++)
anc[i].state=state;
}
void setup()
{
init_anchors(RIGHT);
bind(&anc[0], &anc[5], &anc[3]);
bind(&anc[1], &anc[3], &anc[4]);
bind(&anc[2], &anc[4], &anc[7]);
bind(&anc[3], &anc[5], &anc[6]);
bind(&anc[4], &anc[6], &anc[7]);
bind(&anc[5], ext, ext);
bind(&anc[6], ext, ext);
bind(&anc[7], ext, ext);
}
/* for debug */
void display_anchors()
{
int i;
for(i=0; i<ANCHORS; i++){
printf("%d ", i+1);
}
printf("\n");
for(i=0; i<ANCHORS; i++){
if (anc[i].state == LEFT) {
printf("L ");
} else {
printf("R ");
}
}
printf("\n");
}
void throwin(anchor *anc)
{
anchor *p;
for(p=anc; p != ext;) {
p->state = (p->state==LEFT) ? RIGHT : LEFT;
p = (p->state==LEFT) ? p->l : p->r;
}
}
#define PASS 0
#define FAIL 1
int all_statep(int state)
{
int i;
for(i=0; i<ANCHORS; i++) {
if (anc[i].state!=state) return FAIL;
}
return PASS;
}
void throw_sequence(int a, int b, int c)
{
int i;
init_anchors(RIGHT);
for(i=a; i>0; i--){
throwin(&anc[0]);
}
for(i=b; i>0; i--){
throwin(&anc[1]);
}
for(i=c; i>0; i--){
throwin(&anc[2]);
}
}
int main()
{
int a, b, c;
int found=0;
int min[4];
min[0]=CYCLIC_LIMIT*3;
min[1]=CYCLIC_LIMIT;
min[2]=CYCLIC_LIMIT;
min[3]=CYCLIC_LIMIT;
setup();
for(a=1;a<CYCLIC_LIMIT;a+=2) {
for(b=1;b<CYCLIC_LIMIT;b+=2) {
for(c=1;c<CYCLIC_LIMIT;c+=2) {
throw_sequence(a, b, c);
if (all_statep(LEFT)==PASS) {
found++;
if(min[0] > (a+b+c)) {
min[0]=(a+b+c);
min[1]=a;min[2]=b;min[3]=c;
}
}
}
}
}
if(found!=0)
printf("Total:%d A:%d B:%d C:%d\n",
min[0], min[1], min[2], min[3]);
exit(0);
}
ちっちゃい方のパチンコ台との違いは循環する上限値を３２としている。 やっぱり、この知見を用いることで試行パターンの生成を単純にして逃げた。 はい、逃げましたとも。
#include <stdio.h>
#include <stdlib.h>
#define CYCLIC_LIMIT 32
#define ANCHORS 18
#define LEFT 0
#define RIGHT 1
#define ext (struct anchor *)NULL
typedef struct anchor {
int state;
struct anchor *l;
struct anchor *r;
}anchor;
struct anchor anc[ANCHORS];
void bind(anchor *anc, anchor *left, anchor *right)
{
anc->l = left;
anc->r = right;
}
void init_anchors(int state)
{
int i;
for(i=0; i<ANCHORS; i++)
anc[i].state=state;
}
void setup()
{
init_anchors(RIGHT);
bind(&anc[0], &anc[7], &anc[4]);
bind(&anc[1], &anc[4], &anc[5]);
bind(&anc[2], &anc[5], &anc[6]);
bind(&anc[3], &anc[6], &anc[10]);
bind(&anc[4], &anc[7], &anc[8]);
bind(&anc[5], &anc[8], &anc[9]);
bind(&anc[6], &anc[9], &anc[10]);
bind(&anc[7], &anc[14], &anc[11]);
bind(&anc[8], &anc[11], &anc[12]);
bind(&anc[9], &anc[12], &anc[13]);
bind(&anc[10], &anc[13], &anc[17]);
bind(&anc[11], &anc[14], &anc[15]);
bind(&anc[12], &anc[15], &anc[16]);
bind(&anc[13], &anc[16], &anc[17]);
bind(&anc[14], ext, ext);
bind(&anc[15], ext, ext);
bind(&anc[16], ext, ext);
bind(&anc[17], ext, ext);
}
/* for debug */
void display_anchors()
{
int i;
for(i=0; i<ANCHORS; i++){
printf("%d ", i+1);
}
printf("\n");
for(i=0; i<ANCHORS; i++){
if (anc[i].state == LEFT) {
printf("L ");
} else {
printf("R ");
}
}
printf("\n");
}
void throwin(anchor *anc)
{
anchor *p;
for(p=anc; p != ext;) {
p->state = (p->state==LEFT) ? RIGHT : LEFT;
p = (p->state==LEFT) ? p->l : p->r;
}
}
#define PASS 0
#define FAIL 1
int all_statep(int state)
{
int i;
for(i=0; i<ANCHORS; i++) {
if (anc[i].state!=state) return FAIL;
}
return PASS;
}
void throw_sequence(int a, int b, int c, int d)
{
int i;
init_anchors(RIGHT);
for(i=a; i>0; i--){
throwin(&anc[0]);
}
for(i=b; i>0; i--){
throwin(&anc[1]);
}
for(i=c; i>0; i--){
throwin(&anc[2]);
}
for(i=d; i>0; i--){
throwin(&anc[3]);
}
}
int main()
{
int a, b, c, d;
int found=0;
int min[5];
min[0]=CYCLIC_LIMIT*4;
min[1]=CYCLIC_LIMIT;
min[2]=CYCLIC_LIMIT;
min[3]=CYCLIC_LIMIT;
min[4]=CYCLIC_LIMIT;
setup();
for(a=1;a<CYCLIC_LIMIT;a+=2) {
for(b=1;b<CYCLIC_LIMIT;b+=2) {
for(c=1;c<CYCLIC_LIMIT;c+=2) {
for(d=1;d<CYCLIC_LIMIT;d+=2) {
throw_sequence(a, b, c, d);
if (all_statep(LEFT)==PASS) {
found++;
if (min[0] > (a+b+c+d)) {
min[0]=(a+b+c+d);
min[1]=a;min[2]=b;min[3]=c;min[4]=d;
}
}
}
}
}
}
if (found!=0)
printf("Total:%d A:%d B:%d C:%d D:%d\n",
min[0], min[1], min[2], min[3], min[4]);
exit(0);
}
実際 C で組むには結構大変だと思うんだけど、 Scheme なら約 1Hr でここまで書ける。 しかも多分探索するロジックも方針さえ分かれば、 比較的簡単にできるんじゃないかと思ってる。 その時には非決定性を使えれば恰好良いんだけどなぁ。
収穫はとりあえず実践ではじめてマクロを定義するマクロを書いたってとこくらい?
現時点で気づいているのはABCのどの穴にも奇数回ずつ投入することになるってこと。 なぜなら直下のアンカーを反対にするにはそれしか無いからだ。 あとは、どのアンカーも奇数回当たらないとダメだってのも確か。
ブルートフォースアタックでやったら B->A->B->B->B->B->Cが最初に見付かった解だ。 ちなみに１８個アンカーがある台で総当りで走らせると朝までたっても解答でてないし。 出題意図としてはそりゃそうかと。 その法則とやらを理解して効率的な探索をせにゃならんのだろう。
もしかしたらある法則とやらが分かったかも。
どうやら同じ穴から連続８回投入したら元に戻るのではなかろうか。
あと、Ａ−Ｂ−Ｃ−Ａ−Ｂ−Ｃと巡回を２周しても元に戻るな。
これは全部確認してないが、６回の内にＡＢＣが２回ずつ現れても元に戻る
という規則になるのではないだろうか。
一応Ｃ版も作ってみた。
Lisp(scheme)で実験・開発してＣで実装とかって聞くこともあるけど、
…んー、微妙。
行数では比較できない。やってる内容が全然違うしね。
ただ、Schemeで実装していろいろ簡単に試したりできたからこそ
Ｃで組む時には結構いー加減にやれたってことなんだろうけど。
共通部分はライブラリにするか、この程度なら ifdef とかで切り分けてもいいかも。
cut-sea:2005/02/24 20:20:38 PST
teranishi(2005/02/23 22:39:20 PST): 問題文をよく読むと、「どこに何回玉を落とす必要があるか？」とは書いてありますが、 「どのような順番で玉を落とす必要があるか？」とは書いてありません。 実は、この問題は、それぞれの穴に玉を落とす回数が同じであれば、 どのような順番で玉を落としても結果は同じになるのです。
なるほど。ってことはABCの奇数回出現の組み合わせで順次試せばいいだけか。 この試行パターンの生成をするっていう問題に置き換わりますね。 しかも同じ穴から８回投入すれば元に戻るんなら 絶対に 7 × 3 以下の投入に絞られるし。 ちなみに大きい方のパチンコ台は32回同じ穴に落とすと元にもどる。 結構でかい。cut-sea:2005/02/24 02:02:24 PST
一応両方解けたみたい。 圧倒的にパターンが減ったので結構さくっと答えがでました。 実はまだそれほどパターンを厳選してないのでまだまだ高速化の余地あり。 とりあえず、順序は関係ないという規則のみに頼っている。 Pentium 4 (686-class), 2205.10 MHz,メモリ 1Gbyte なマシンです。
cut-sea@mokili> time ./anc.scm ;; ちっちゃい方のパチンコ台 0.063u 0.010s 0:00.07 100.0% 0+0k 0+3io 0pf+0w cut-sea@mokili> time ./anc2.scm ;; でっかい方のパチンコ台 18.277u 0.019s 0:18.40 99.3% 0+0k 0+0io 0pf+0w
Cで組んでやればもっと高速に解いてくれちゃうんだろうけど。cut-sea:2005/02/24 04:15:16 PST
teranishi(2005/02/25 15:26:28 PST): 「それぞれの穴に奇数回」 という規則を加えれば、さらに速くなります。 make-seq を以下の定義で置き換えてみてください。 (main の i は 0 からに変更)
(define (make-seq lst n)
(map (lambda (x) (append lst x x))
(combinations*
(apply append (make-list n lst))
n)))
((0 0 0) (0 0) (0 0 0))なリストでパチンコ台をつくって ループで回してできそうだけど。
teranishi(2005/02/25 14:37:46 PST): はい、できます。 というか、データの表現方法の違いだけなので、できるのは当然な気もします。
teranishi(2005/02/25 17:25:43 PST): あっ、要素が数字というところがみそなのか。 一個ずつ玉を落とさなくても、一度に結果が分かると。
うーーん。どうも、よく分かんない。(^^;
とりあえず、ちっこいパチンコ台に関しては各投入口にボールを投入した回数と
各アンカーへの当たり回数の関係式はこんな感じになるみたい。
あくまで順番関係ないってのを信じてるので、線形結合(要は和)をとってる。
あとはこの関係式に対してA,B,Cの数の組み合わせを順次試して、
全アンカーが奇数になるものの内最小のを探せばいいわけだ。
実際 A-1 B-5 C-1 回でちゃんと全アンカーが奇数になっとる。
(define (anc1 a b c) a)
(define (anc2 a b c) b)
(define (anc3 a b c) c)
(define (anc4 a b c) (+ (- (- a 1) (quotient (- a 1) 2))
(- b (quotient b 2))))
(define (anc5 a b c) (+ (- (- b 1) (quotient (- b 1) 2))
(- c (quotient c 2))))
(define (anc6 a b c) (+ (- a (quotient a 4))
(quotient (+ b 3) 4)))
(define (anc7 a b c) (+ (quotient a 4)
(+ (quotient (+ b 1) 4) (quotient (+ b 2) 4))
(quotient (+ c 3) 4)))
(define (anc8 a b c) (+ (quotient b 4)
(- c (quotient (+ c 3) 4))))
;; これは確認ね
(map (lambda (a) (a 1 5 1))
(list anc1 anc2 anc3 anc4 anc5 anc6 anc7 anc8))
ただ、ここまで脳力をつかっちゃうのはどうもよろしく無いですが、 この数式まで来たらHaskellとかが得意そう。 しかし、でっかいパチンコ台に拡張すんのが面倒くさそ。 関係式に規則がありそうな感じではあるんだが。cut-sea:2005/02/26 08:06:43 PST
あー、もっと簡単だ。うん。なんであんな難しく考えたんだろ。
(define (froml left)
(if (even? left)
(/ left 2)
(/ (- left 1) 2)))
(define (fromr right)
(if (odd? right)
(/ (+ right 1) 2)
(/ right 2)))
(define (anc1 a b c) a)
(define (anc2 a b c) b)
(define (anc3 a b c) c)
(define (anc4 a b c) (+ (froml (anc1 a b c))
(fromr (anc2 a b c))))
(define (anc5 a b c) (+ (froml (anc2 a b c))
(fromr (anc3 a b c))))
(define (anc6 a b c) (+ (fromr (anc1 a b c))
(fromr (anc4 a b c))))
(define (anc7 a b c) (+ (froml (anc4 a b c))
(fromr (anc5 a b c))))
(define (anc8 a b c) (+ (froml (anc3 a b c))
(froml (anc5 a b c))))
;; やはりこれ確認ね
(map (lambda (a) (a 1 5 1)) (list anc1 anc2 anc3 anc4 anc5 anc6 anc7 anc8))
これだけのことだ。これならでっかい方のパチンコ台に拡張するのも簡単だ。 (ancN a b c) は各A,B,Cの投入口からの投入回数a b cがあった時に Nのアンカーが何回ボールに当たるかの回数を返す。 fromlとfromrは基本的には注目しているアンカーの 左上からボールが来たか右上からボールが来たかだけど、 壁パスで受け取るところはちょっと注意が必要になる。 これで、あとは a b c を奇数の組み合わせで生成して 全アンカーが奇数になる最小の値を探せば良いわけだ。 なんだ。めちゃめちゃつまらない問題に帰着してしまった。 まー高速化のポイントはせいぜい同じ計算をしないようにするために letで各段の対応を入れ子にする位か。 てことで別解による実装してみた。cut-sea:2005/02/26 09:05:28 PST
teranishi(2005/02/26 19:51:17 PST):パターンの生成ですが、 算譜の記2004-04-27 で話題になっている格子点を 2 倍して 1 を足せば良さげです。
teranishi(2005/02/27 05:49:30 PST):
ボールの投入数を最小にするパターンを見つける場合、各穴への投入数を
4 で割った余りが 1 になるパターンのみ調べれば良い事に気づいた。
ついでに、穴が n 個の場合、右端から 1,5,9,..,4n-3 個を投入すれば、
必ず全てのアンカーが切り替わる事も分かった。
(これがボールの投入数最小になるとは限らないが)
teranishi(2005/03/01 19:14:06 PST): これ以上法則が見えないので、とりあえず現状の情報だけで作ってみました。
(use srfi-1)
(define (check pat height)
(let loop ((fst #f) (pat pat) (lst #f) (rest height))
(cond ((any even? pat) #f)
((= rest 1) #t)
(else
(let* ((right (map (cut quotient <> 2) pat))
(left (map (pa$ + 1) right)))
(if fst
(loop #f (map + (cons fst right) (append left lst)) #f (- rest 1))
(loop (car left) (map + right (cdr left)) (last-pair right) (- rest 1))))))))
(define (ntuples d)
(if (= d 1)
(let loop ((n 0))
(cons (list n) (delay (loop (+ n 1)))))
(let loop ((stream (ntuples (- d 1))))
(let ((top (car stream)))
(append (list-tabulate (+ (car top) 1)
(lambda (n) (list* (- (car top) n) n (cdr top))))
(delay (loop (force (cdr stream)))))))))
(define (patterns width)
(let loop ((stream (ntuples width)))
(cons (map (lambda (n) (+ (* n 4) 1)) (car stream))
(delay (loop (force (cdr stream)))))))
(define (solve width height)
(let loop ((stream (patterns width)))
(if (check (car stream) height)
(car stream)
(loop (force (cdr stream))))))
Tag: Puzzle