起因
起因是这样的：前一阵逛抖音，买了个预售的拼图游戏。据说是国内团队开发的，非常有趣。大概长这样：
拼图设计上故意空出三个空位，拼图的格子上印有1-12月的月份，1-31号的日期，以及周一到周日的星期。空出的三个空位，可以正好用来匹配月份-日期-星期的组合。这个可以使得你每天都可以有一道新的谜题可玩，好几年都不带重样的。
可是呢，这是个预售商品，大概研发团队找的生产厂商生产力不足吧。下单后要一个半月才发货。实属令人抓腮。
正好最近在折腾F#，干脆我来验证下是不是每种情况都有解吧。
于是，开工。
思路
暂时不需要太复杂的算法，就用最简单的DFS就可以了。
我们从左到右，从上到下搜索棋盘格，只要这个格子应放但未放入积木，我们就尝试放一个形状进去，然后继续搜索。如果无法放入我们就继续试其他形状。如果所有积木的所有形状都试过了我们就回溯。这样可以保证了搜索到某个点时，它之前的所有行、它同一行左侧的所有点都已经填满了积木。只需要搜完整个地图，说明全部积木都放进去了。
因为是函数式编程，上述的过程也被转换成了递归。
具体步骤：
- 将积木保存为大小仅为长*宽的点阵，有木头的为1，空白的为0。并把积木编上从0到10的号。
- 针对每个积木，通过旋转、翻转，产生出它的所有的变形形状，并且剔除重复的形状，作为该积木应该尝试的所有形状列表。每个形状记录第一行最左侧那块积木的位置（相对当前积木区域的x坐标）。后面的搜索要用到。
- 地图抽象为7行6列的矩阵。不可达的区域定义为-100，需要空出来的月份、日期、星期三个格子定义为100，未放置任何积木的定义为-1，放置了积木的格子记录为这个积木的编号（0-10）
- 针对棋盘开始搜索，从（0，0）处依次向右、向下搜索。注意这里的坐标采取(x,y)形式，也就是列在前，行在后。
- 遇到已经放入积木、不可达区域、需要空出来的格子则直接跳过，递归搜索下一个点。
- 遇到空白格子（为-1的格子）则针对该点遍历所有积木的所有形状。将该形状的第一行的最左侧积木块放置于此格子，并判断是否能放进该形状。如果形状能放入则放入，并继续递归，在尝试下一个形状之前删除该形状。如果无法放入，则不进行递归。
- 当搜索到达（3，6）格子时，意味着找到了一个解。此时可以选择继续搜索找出所有解，或者退出搜索完成任务。（两种我都试了，解法真的很多很多，本文只讲取一种解的情况）
那么，开工
准备工作
定义形状、积木
这里采用记录：
//积木变形形状
type Shape =
{ X: int //最大x坐标，而非length
Y: int //最大y坐标，而非length
Offset: int
Map: int[,] }
//积木单元
type Piece =
{ Shapes: list<Shape> }
生成积木
做一个积木的形状生成器，这样可以方便积木形状的生成：
- 单个积木根据有木头的点坐标自动生成积木的基本形状的map。
- 进行旋转获取4个形状，然后翻转后再旋转获取4个形状
- 对8种形状做去重
- 针对所有积木执行上述步骤，生成所有积木
//根据提供的占位坐标点序列，生成所有积木单元，并计算全部不重复的形状
let genPieces (piecesDesc: seq<seq<int * int>>) =
//生成一个积木单元
let genPiece (arr: seq<int * int>) =
//根据基础形状，生成所有不重复形状
let genAvailabeShapes shape =
//变形，f为目的地元素函数
let transShape shape f =
let cur = Array2D.create (shape.Y + 1) (shape.X + 1) 0 //(x,y)格式，先列后行
for y in 0 .. shape.X do //行列互换
for x in 0 .. shape.Y do
cur[x, y] <- f shape x y //注意，行列互换了
//取第一行的偏移
let offset =
seq { 0 .. shape.Y } //注意，列长变成了原来的行长度
|> Seq.pick (fun x ->
if cur[x, 0] = 1 then
Some x
else
None)
{ Map = cur
X = shape.Y
Y = shape.X
Offset = offset }
//旋转变形（顺时针，因此行列互换）
let rotateShape shape =
transShape shape (fun shape x y -> shape.Map[shape.X - y, x])
//翻转变形（左上、右下对角线，因此仍然是行列互换）
let turnOverShape shape =
transShape shape (fun shape x y -> shape.Map[y, x])
//重复旋转获取四种情况（含未旋转）
let getRotateShapes4 shape =
let rec rotateLoop shape n = //4、3、2、1，尾递归
match n with
| 0 -> []
| _ -> shape :: rotateLoop (rotateShape shape) (n - 1)
rotateLoop shape 4
//旋转、翻转获取变形列表
let rotatedShapes = getRotateShapes4 shape //旋转的4个形状
let turnedOverShape = turnOverShape shape //翻转形状
let turnedOverRotatedShapes = getRotateShapes4 turnedOverShape //基于翻转旋转的4个形状
let allShapes = List.append rotatedShapes turnedOverRotatedShapes //拼接全部8个形状
//判断形状相同，用于剔除旋转后重复的形状
let shapeEqual shape1 shape2 =
if shape1.X <> shape2.X then false
elif shape1.Y <> shape2.Y then false
else
seq { 0 .. shape1.Y }
|> Seq.exists (fun y ->
seq { 0 .. shape1.X }
|> Seq.exists (fun x ->
shape1.Map[x, y] <> shape2.Map[x, y]))
|> not
//去重作为结果，顺序会反过来，无所谓
allShapes
|> Seq.fold (fun next shape ->
let hasEqual =
next
|> Seq.exists(fun av -> shapeEqual av shape)
if hasEqual then next else shape :: next) []
//|> List.rev //如果不高兴，可以再正过来
//初始化
let maxX = Seq.map (fun (x, _) -> x) arr |> Seq.max
let maxY = Seq.map (fun (_, y) -> y) arr |> Seq.max
let cur = Array2D.create (maxX + 1) (maxY + 1) 0 //(x,y)格式，先列后行
//根据参数填充格子
Seq.iter (fun (x, y) -> cur[x, y] <- 1) arr
//取第一行的偏移
let offset =
seq { 0 .. maxX }
|> Seq.pick (fun x ->
if cur[x, 0] = 1 then Some x
else None)
//基础形状
let shape =
{ X = maxX
Y = maxY
Offset = offset //用于判断
Map = cur }
//计算本积木的所有可用变形并返回为一个Piece
{ Shapes = genAvailabeShapes shape }
//根据参数生成所有积木，块数越多的越早测试，有效剪枝
Seq.map (fun pieceDesc -> genPiece pieceDesc) piecesDesc
//先按照形状的多少预排（感觉用处不大）
|> Seq.sortByDescending (fun piece -> piece.Shapes.Length)
//再按照块的大小排序（后一次排序为主排序，因为sort是稳定排序，所以前一次排序会作为副排序）
|> Seq.sortByDescending (fun piece ->
seq {
for y in 0 .. piece.Shapes[0].Y do
for x in 0 .. piece.Shapes[0].X -> piece.Shapes[0].Map[x, y]
}
|> Seq.sum)
|> Array.ofSeq //采用数组，使得索引器效率变为O(1)
然后利用生成器生成全部积木：
//根据实际情况，生成积木
let pieces = genPieces [
[ (0, 0); (0, 1); (1, 1); (2, 1); (2, 0) ]
[ (0, 0); (0, 1); (1, 1) ]
[ (0, 0); (0, 1); (1, 0); (2, 0) ]
[ (0, 0); (0, 1); (0, 2); (1, 0); (1, 1) ]
[ (0, 0); (0, 1); (1, 0); (1, 1) ]
[ (0, 0); (0, 1); (0, 2); (0, 3); (1, 1) ]
[ (0, 0); (0, 1); (0, 2); (0, 3); ]
[ (0, 0); (0, 1); (0, 2); (0, 3); (1, 0) ]
[ (0, 0); (0, 1); (0, 2); (1, 0); (2, 0) ]
[ (0, 0); (1, 0); (1, 1); (2, 1) ]
[ (0, 0); (1, 0); (2, 0); (1, 1) ]
]
验证生成的积木
为了确保积木生成正确，我们简单打印一下所有积木的所有形状：
//测试函数，打印生成的积木形状
let printPieces () =
for piece in pieces do
printfn ""
for shape in piece.Shapes do
for y in 0 .. shape.Y do
for x in 0 .. shape.X do
if shape.Map[x, y] = 1 then printf "* "
else printf " "
printfn ""
printfn ""
printfn "==============="
printfn ""
printPieces ()
结果如下：
*
* *
* *
* *
* * *
* *
* *
*
* * *
* *
* *
* * *
*
* *
* *
* * *
* *
* *
* *
*
===============
*
*
* *
*
*
* * * *
*
* *
*
*
* * * *
*
*
* * * *
*
*
* *
*
* * * *
*
*
* *
*
*
===============
*
*
*
* *
*
* * * *
* *
*
*
*
* * * *
*
*
* * * *
*
*
*
* *
* * * *
*
* *
*
*
*
===============
* *
*
* *
* * *
* *
* *
*
* *
* *
* * *
===============
*
*
* * *
*
*
* * *
* * *
*
*
* * *
*
*
===============
*
* * *
*
*
* *
* * *
*
* *
*
*
*
*
* *
*
* * *
* *
*
*
* * *
*
===============
* *
* *
*
* *
*
*
* *
*
* *
* *
===============
*
* *
*
*
* * *
*
* *
*
* * *
*
===============
* * * *
*
*
*
*
===============
* *
* *
===============
*
* *
* *
*
* *
*
*
* *
===============
非常GOOD。
求解
求解函数
按照之前的算法，写出求解函数
let solve month day weekday print =
//计算位置坐标
let blankPos (month, day, weekday) =
//计算星期坐标
let weekdayPos weekdayZB =
if weekdayZB < 3 then 1 + weekdayZB, 0
else weekdayZB - 3, 1
//计算月份坐标
let monthPos monthZB =
4 + monthZB % 4, monthZB / 4
//计算日期坐标
let dayPos dayZB =
match dayZB with
| 0 | 1 | 2 | 3 -> dayZB, 2
| _ -> (dayZB - 4) % 8, 3 + (dayZB - 4) / 8
monthPos (month - 1), dayPos (day - 1), weekdayPos (weekday - 1)
let monthPos, dayPos, weekdayPos = blankPos (month, day, weekday)
//搜索时用的map
let map = Array2D.create 8 7 -1 //(x,y)格式，先列后行
//赋初值
seq { 3 .. 7 } |> Seq.iter (fun i -> map[i, 6] <- -100) //-100为地图黑域
map[fst monthPos, snd monthPos] <- 100 //100为空出位置
map[fst dayPos, snd dayPos] <- 100
map[fst weekdayPos, snd weekdayPos] <- 100
//搜索时记录积木是否已经使用的map，为了效率，元素作为变量参与算法
let pieceUsed = Array.create pieces.Length false
//打印解
let printMap () =
let showChar d =
match d with
| -100 | 100 -> ' '
| -1 -> '_' //打印中间过程时用于测试
| d -> "*#+&@$%08oD"[d] //积木打印字符集
printfn ""
for y in 0..6 do
for x in 0..7 do
printf "%c " (showChar map.[x, y])
printfn ""
printfn ""
//尝试填充shape，若失败撤销填充，若成功标记used为true
let tryShape i shape x y =
//排除出界情况
if x - shape.Offset < 0 then false
elif x - shape.Offset + shape.X > 7 then false
elif y + shape.Y > 6 then false
else
let rec tryShapeRec i shape xLoop yLoop =
match xLoop, yLoop with
| _, -1 -> true
| -1, _ -> tryShapeRec i shape shape.X (yLoop - 1)
| _ ->
//x为当前测试map位置，它减去offset是当前图形起始位置， loopx为循环遍历当前图形小坐标。 y同理
let xIndex, yIndex = x - shape.Offset + xLoop, y + yLoop
if shape.Map[xLoop, yLoop] <> 1 then tryShapeRec i shape (xLoop - 1) yLoop
elif map[xIndex, yIndex] <> -1 then false
else
map[xIndex, yIndex] <- i
let rsl = tryShapeRec i shape (xLoop - 1) yLoop
if not rsl then map[xIndex, yIndex] <- -1
rsl
let rsl = tryShapeRec i shape shape.X shape.Y
if rsl then pieceUsed[i] <- true
rsl
//回滚填充的shape
let eraseShape i shape x y =
for yLoop in 0 .. shape.Y do
for xLoop in 0 .. shape.X do
if shape.Map[xLoop, yLoop] = 1 then
map[x - shape.Offset + xLoop, y + yLoop] <- -1
pieceUsed[i] <- false
//主过程，逐级递归
let rec solveLoop x y =
match (x, y) with
| 3, 6 ->
if print then printMap ();
true
| _ ->
if map[x, y] <> -1 then //已经填充
solveLoop ((x + 1) % 8) (y + ((x + 1) / 8))
else //尝试填充
seq { 0..10 }
|> Seq.exists(fun i ->
if not pieceUsed[i] then
pieces[i].Shapes
|> List.exists (fun shape ->
if tryShape i shape x y then
//printMap () //测试，打印中间过程
let nextRsl = solveLoop ((x + 1) % 8) (y + ((x + 1) / 8))
if nextRsl then true
else eraseShape i shape x y; false
else false)
else false)
//printMap () //测试用，打印初始map
//调用
solveLoop 0 0
执行
考虑两种模式：
- 根据用户输入的月份、日期、星期求出这种情况的解。
- 自动计算所有月份、日期、星期组合的所有情况，验证每种情况的解。
以上两种我们都实现一下，通过用户输入选择不同模式。并且加入容错机制：
open System
open System.Linq
printfn "模式："
printfn "1) 根据输入求解"
printfn "2) 验证所有组合有解"
printf "请选择："
let choose = Console.ReadLine().Trim()
printfn ""
match choose with
| "1" ->
while true do //反复求解
printf "输入 月份、日期、星期："
try
let month, day, weekday =
Console.ReadLine().Trim().Split([| ' '; '\t' |]).Where(fun x -> not (String.IsNullOrEmpty(x)))
|> (fun x ->
if x.Count() = 3 then
int (Seq.item 0 x), int (Seq.item 1 x), int (Seq.item 2 x)
else
failwith "")
if
month < 1 ||
month > 12 ||
day < 1 ||
day > 31 ||
weekday < 1 ||
weekday > 7 then failwith ""
printfn ""
printfn "=== %02d.%02d-%d ===" month day weekday
//解决问题
let solved = solve month day weekday true
if not solved then printfn "此题无解"
printfn "==============="
printfn ""
with ex -> //容错，输入有误
printfn "";
printfn "输入有误，请重新输入！";
printfn ""
| "2" ->
//会在遇到第一个无解情况后终止
let allAv =
seq { 1..12 }
|> Seq.tryPick (fun month ->
seq { 1..31 }
|> Seq.tryPick (fun day ->
seq { 1..7 }
|> Seq.tryPick(fun weekday ->
if solve month day weekday false then None
else Some (month, day, weekday))))
match allAv with
| Some (month, day, weekday) -> printfn "%02d.%02d-%d 无解！" month day weekday
| _ -> printfn "恭喜！测试通过，全部有解！"
| _ -> printfn "输入有误，退出程序！"
代码码完了。
随便测试一个：
- 月份：8
- 日期：16
- 星期：三
=== 08.16-3 ===
* * # + + o o
* # # 8 + o o
* * D 8 + & & &
$ D D 8 8 8 & &
$ $ D 0 0 0 0
$ @ @ % % % % 0
$ @ @
===============
再测试一个：
- 月份：12
- 日期：31
- 星期：日
=== 12.31-7 ===
* * # + + + & &
* # # $ + & &
* * $ $ $ $ &
% 0 0 0 0 @ @ 8
% D o o 0 @ @ 8
% D D o o 8 8 8
% D
===============
随后，我测试了下用不同的积木组合来求解，只需要修改genPieces的参数即可。很是有趣。
最后看下效率，在编译为Release的情况下：
- 针对特定月份、日期、星期，算出一个解来，肉眼难以分辨延迟。
- 针对特定月份、日期、星期，算出所有解的数量，大约需要3秒。
- 针对所有的月份、日期、星期的组合，成功验证每一种至少有一个解的，总用时大约需要3秒。
- 针对所有的月份、日期、星期的组合，验证至少有一种组合不满足，大约也是3秒。（目前遇到的情况如此，不过这个可能有弹性）
发现效率还可以，就不考虑继续优化算法了。
OK。等玩具到了，想不出来解的时候，至少有个工具能用了。
PS: 完整代码已发布在Github上。
最新更新
代码已重写，现在支持自定义的map和piece。因此可以适用于大部分拼图场景。顺带实现了一个从命令行参数读取解析参数的模块，已上传Github。
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
