Hexalate是一种小游戏
如图：
Hexalate
(defparameter *disks-avail*
'((0 C V Y G R B)
(1 V R B G Y C)
(2 V B R Y C G)
(3 C Y V B G R)
(4 G R B V Y C)
(5 C V G B Y R)
(6 G C R B Y V)))
构成：
1.全图由七个小圆盘组成。
2.每个盘片上有六种颜色。
可用的操作：
1.每个盘片都可以和其它盘片交换位置（拖动）。
2.每个盘片都可以旋转60度的倍数（点击）。
目标：
把相邻的扇形区域颜色调成一样。
完成的样子
Solved:
0<=(0 B C V Y G R)
1<=(1 C V R B G Y)
2<=(6 B Y V G C R)
3<=(5 G B Y R C V)
4<=(2 Y C G V B R)
5<=(4 C G R B V Y)
6<=(3 B G R C Y V)
上面的图形是完成的样子。
这次编程选用的语言是CommonLisp。
第一步：为盘片进行编码
正中间的位置编号为0,正中间下方为1,然后顺时针方向递增，依次为2，3，4，5，6.
正上方的位置为4.
每个盘片上的六个位置也这样编码，正下方为1，顺时针方向递增，正上方为4.
颜色用Red Green Blue Yellow Cyan Violet的首字母表示。
上面的*disks-avail*就是这样表示的。前面的序号表示盘片原始的位置。
第二步：让盘片能够转动
(defun append1(L x)
(append L (list x)))
(defun rotate-list(L)
(append1 (cdr L)(car L)))
(defun next-o(disk)
(let* ((head (car disk))
(body (cdr disk)))
(cons head (rotate-list body))))
(defun all-ori(disk)
(do ((v disk (next-o v))
(count 0 (+ count 1))
(re nil (push v re)))
((= count 6) re)))
这样几个辅助的函数，能够获得一个盘片转动后的各种状态。盘片转动的方向不重要。只存储转动后的状态。
第三步：
编写检查盘片是否对齐颜色的函数
(defun show(state)
(progn (format t "Solved:~%")
(mapc #'(lambda(i disk)
(format t "~a<=~a~%" i disk))
'(0 1 2 3 4 5 6) state)))
(defparameter step-check
'(NIL
NIL
((1 4 0 1))
((2 5 0 2) (2 6 1 3))
((3 6 0 3) (3 1 2 4))
((4 1 0 4) (4 2 3 5))
((5 2 0 5) (5 3 4 6))
((6 3 0 6) (6 4 5 1) (1 5 6 2))))
(defun checkL(board L)
(let* ((first-disk (nth (first L) board))
(second-disk (nth (third L) board))
(first-color (nth (second L) first-disk))
(second-color(nth (fourth L) second-disk)))
(eql first-color second-color)))
(defun fun-and(x y)(and x y))
(defun checkboard(board)
(let ((N (length board)))
(if (= N 1)
t
(reduce #'fun-and
(mapcar #'(lambda(i)(checkL board i))
(nth N step-check))))))
(defun sidesok(new-disk cur-state)
(if (null cur-state)
't
(checkboard (append1 cur-state new-disk))))
show函数作用：假设已经完成，显示结果
step-check列表定义了操作时候要进行的检查。操作分七个步骤，每步会增加一个盘片。检查的时候只需要检查新增加的盘片与相邻的盘片能否匹配即可。顺序仍然是从中间开始，然后是下方，然后顺时针方向继续。
如其中的（2 5 0 2）表示检查第2位置盘片的第5色与第0位置盘片的第2色是否一致。
checkL函数就是完成上面的检查。
fun-and函数是特别增加的，common-lisp中的and是一个宏，不能reduce。为了能够在列表上reduce，以缩短代码，特意包装成函数fun-and.
chechboard就是对整个局面进行检查，但会根据盘面上放置了几个盘片来选择，只检查新放置的盘片和它相邻的位置。看step-check列表可以知道，放第二块盘的时候，只需要检查同第一块盘能否匹配。放最后一块盘的时候，要检查三个方向。其余的盘都要检查两个方向。
sidesok检查当前的盘能否放上去。
第四步：编码搜索
(defun try-orientation (ori cur-state unused-disks)
(if (sidesok ori cur-state)
(solve-disks
(append1 cur-state ori)
(remove-if #'(lambda(i)(= (car i)(car ori)))
unused-disks))))
(defun try-disk(disk cur-state unused-disks)
(mapc #'(lambda(o)(try-orientation o cur-state unused-disks))
(all-ori disk)))
(defun solve-disks(cur-state unused-disks)
(if (null unused-disks)
(show cur-state)
(mapc #'(lambda(disk)
(try-disk disk cur-state unused-disks))
unused-disks)))
(defun test()
(solve-disks nil *disks-avail*))
按照预定的顺序，把盘放上去，一个一个的试，不对了换一块继续试。
运行以后得到结果：
CL-USER> (test)
Solved:
0<=(0 B C V Y G R)
1<=(1 C V R B G Y)
2<=(6 B Y V G C R)
3<=(5 G B Y R C V)
4<=(2 Y C G V B R)
5<=(3 B G R C Y V)
6<=(4 C G R B V Y)
Solved:
0<=(0 B C V Y G R)
1<=(1 C V R B G Y)
2<=(6 B Y V G C R)
3<=(5 G B Y R C V)
4<=(2 Y C G V B R)
5<=(4 C G R B V Y)
6<=(3 B G R C Y V)
... ...
竟然有很多种方法可以完成一个局面，随便挑选一种就完成了。
然而，手动寻找一种方法的困难。
上图是用第二种方法完成的。
源码下载：
链接: https://pan.baidu.com/s/1BZO4MaaBDponrVWo4zp_uw
提取码: bumb
网友评论