About

起因是在 b 站 看到 超级代数大战 Super Algebrawl 的一个介绍. 对里面的结果是否可能一定有解感到比较好奇.

(毕竟要是为了学算数而给孩子做的这个游戏, 结果最终发现没法解, 那么孩子估计一定非常高兴吧. )

不过作者并没有给出具体的实现方法或是相关的技术说明 (很合理), 但是作为一个吃饱了闲的的人, 我觉得可以自己试试看.

Algorithm

核心的思路

维护一个参数列表 leaves-list, 对于给定的运算符 op-plist, 从参数列表中任意挑选满足给定运算符参数数量的元素作为参数, 以抽象语法树 AST 的形式重新添加到参数列表中去.

使用代码来描述就是:

(defun leaves-reduce (leaves-list op-plist)
  "使用 `op-plist' 对 `leaves-list' 进行缩减.
返回新的参数列表."
  (let ((arg-size (getf op-plist :arg)))
    (multiple-value-bind (picked rest)
        (rand-identity-pick leaves-list arg-size)
      (cons `((:depth ,(apply #'ast-depth-max picked) ,@op-plist)
              ,@picked)
            rest))))

这样是单步的计算, 如果要对一组的运算符进行计算, 就可以通过反复使用来实现:

(defun leaves-full-reduce (leaves-list op-list)
  "根据 `op-list' 的结果对 `leaves-list' 进行缩减,
返回一个包含所有 AST 结果的列表."
  (loop with ast = leaves-list
        for op in op-list
        do (setf ast (leaves-reduce ast op))
        finally (return ast)))

Misc

数据结构

以树的数据结构来储存一个 AST, leaves-list 则为元素为 AST 的列表.

(declaim (inline #:leaf?
                 #:node-properity
                 #:node-children
                 #:ast-depth))
(defun leaf? (ast)
  "测试 `ast' 是否为叶子节点. "
  (not (listp ast)))

(defun node-properity (ast &optional key)
  "返回 `ast' 的属性. "
  (unless (leaf? ast)
    (if key
        (getf (car ast) key)
        (car ast))))

(defun node-children (ast)
  "返回 `ast' 的参数."
  (unless (leaf? ast) (cdr ast)))

(defun ast-depth (ast)
  "测试 `ast' 的深度, 对于 `leaf' 深度为 `0'."
  (if (leaf? ast) 0 (node-properity ast :depth)))

(defun ast-depth-max (&rest ast)
  "返回 `ast' 中最小的深度的大小."
  (apply #'max (mapcar #'ast-depth ast)))

有了数据结构, 历遍 AST 树就比较轻松了, 以计算 AST 为例:

(defun ast-eval (ast)
  "计算 `ast' 最终对应的值."
  (if (leaf? ast)
      ast
      (apply (node-properity ast :fn)
             (mapcar #'ast-eval (node-children ast)))))

随机算法

主要的就是:

  • rand-identity-pick (list n): 从 list 中随机提取 n 个不同的元素
  • rand-list (length min max)rand-op (length &optional op-set): 产生长度为 length 的随机列表.
这个具体的实现不是很难, 就折叠了…
(defun rand (min max)
  "生成大小在 `min', `max' 之间的随机数."
  (+ (random (- max min)) min))

(defun luck-in (&optional (p 0.5))
  "根据 `p' 的概率大小返回 `t' 或 `nil'."
  (if (< (random 1.0) p) t nil))

(defun rand-identity-pick (list n)
  "从 `list' 中不重复随机挑选 `n' 个元素.
返回挑出的元素和剩下的元素. "
  (loop for len from (length list) downto 1        
        for elem in list
        with pick = n
        if (and (> pick 0) (luck-in (/ pick len)))
          do (decf pick) and collect elem into picked
        else collect elem into rest
        finally (return (values picked rest))))

(defun rand-op (&optional (op-set *default-op-set*))
  "返回 `op-set' 中随机的运算符对应的 plist."
  (cdar (rand-identity-pick op-set 1)))

(defun isotropy-list (length fn &rest fn-args)
  "使用 `fn' 生成长度为 `length' 的各向同性链表, 可以额外提供 `fn' 参数."
  (loop for i below length collect (apply fn fn-args)))

(defun rand-list (length min max)
  "生成长度为 `length', 大小在 `min', `max' 之间的随机数链表."
  (isotropy-list length #'rand min max))

(defun rand-op-list (length &optional (op-set *default-op-set*))
  "根据 `op-set' 生成长度为 `length' 的运算符列表."
  (isotropy-list length #'rand-op op-set))

可视化

诶, 感觉写 Graphviz 的代码实在是太多了, 总有一天要写一个 wrapper 把这个工作给简化一下.
(defun ast-format (stream ast &optional (node (gensym "AST-ROOT")))
  "以 Graphviz 的形式输出 `ast' 到 `stream' 中.
需要注意的是: `ast' 为一个 AST 元素."
  (cond ((leaf? ast)
         (format stream
                 "~&\"~a\" [shape=circle,label=\"~a\"];"
                 node ast))
        (t
         (format stream
                 "~&\"~a\" [shape=doublecircle,label=\"~a\"];"
                 node (node-properity ast :name))
         (loop for next in (node-children ast)
               for next-node = (gensym "AST-NODE")
               do (ast-format stream next next-node)
               collect next-node into next-nodes
               finally (format stream
                               "~&\"~a\" -> {~{\"~a\"~^, ~}};"
                               node next-nodes)))))

(defun leaves->graphviz (leaves &optional (header ""))
  "将包含多个 AST 元素的列表 `leaves' 输出为 Graphviz 的代码."
  (with-output-to-string (out)
    (format out "digraph {~%~a" header)
    (loop for ast in leaves
          for ans-node = (gensym "AST-ANS")
          for root-node = (gensym "AST-ROOT")
          for ans-val = (ast-eval ast)
          do (format out "~&\"~a\" [shape=square,label=\"~a\"];"
                     ans-node ans-val)
          do (format out "~&\"~a\" -> \"~a\" [dir=back];"
                     ans-node root-node)
          do (ast-format out ast root-node))
    (format out "~&}")))

(defun leaves->svg (leaves output &key debug)
  (with-input-from-string (in (if debug
                                  (print (leaves->graphviz leaves))
                                  (leaves->graphviz leaves)))
    (uiop:run-program '("dot" "-Tsvg")
                      :input in
                      :output output)
    output))

效果类似于如下:

(let ((numbers (rand-list 10 3 10))
      (ops     (rand-op-list 10)))
  (leaves->svg (leaves-full-reduce numbers ops)
               output))

/_img/lisp/misc/calculator-game/test.svg

Dynamics

不平衡在哪里?

随机不一定全是好事

实际上如果只是使用上面的 (几乎是完全) 随机的算法, 很容易出现一些 “坏” 的结果, 比如:

/_img/lisp/misc/calculator-game/tooo-deep-example.svg

AST 的深度太深了 (难度太大了), 而类似于下图的形式, 则可能有点太简单了?

/_img/lisp/misc/calculator-game/tooo-shallow-example.svg

即: 全靠随机, 没法保证游戏的一个难度的均衡性.

那么一个简单的做法就是: 我不随机了, 我用规则来制定. 比如说在 rand-identity-pick 这个函数里面加一个拒取条件, 或者是在 rand-op 里面加一个分布, 让不同的算符被取到有不同的概率等级, 这样就会让这个游戏变得稍微更加有 “规律” 一些.

(defun rand-identity-pick (list n &key test (retry 3))
  "从 `list' 中随机取 `n' 个元素, 元素需满足 `test' 函数, 最大重试次数 `retry'.
+ `test' 应为一个接受并判断 `list' 中单个元素的函数;
+ `retry' 应为一个表示重试次数的非负整数"
  (declare (integer retry))
  (if (functionp test)
      (loop for len from (length list) downto 1
            for elem in list
            with pick = n
            if (and (> pick 0)
                    (luck-in (/ pick len))
                    (funcall test elem))
              do (decf pick)
              and collect elem into picked
            else collect elem into rest
            finally
               (return
                 (if (and (not (zerop pick)) ; 取的元素数量不够
                          (> retry 0))       ; 且还可以继续重试
                     ;; 重取的方式为在 `rest' 列表中随机取剩下的 `pick' 元素
                     (multiple-value-bind (more remain)
                         (rand-identity-pick rest pick
                                             :test test
                                             :retry (- retry 1))
                       (values (nconc picked more) remain))
                     ;; 若放弃, 则返回 `picked' 和 `rest'
                     (values picked rest))))
      ;; 若 `test' 不是一个函数, 则默认返回 `t'
      (rand-identity-pick list n
                          :test (lambda (elem) (declare (ignore elem)) t)
                          :retry retry)))

而对于 rand-op, 则可以对运算符进行人为评分, 比较难度, 然后给一个拒取函数来实现.

是否可以多解

嘛, 有一种数学上的奇妙 xp 就是一题多解. 但是很可惜, 我暂时还没有一个很好的方法, 如果要考虑同一组数在同一组运算符下的不同 AST 分解 (分解到同一组叶子节点), 总觉得用递归配合深搜复杂度有点大.

卧槽, 突然感觉这个可能会是一个比较好的加密方法, 就像 RSA 算法一样, 大质数的乘法很容易, 但是其分解并不轻松, 如果… (感觉有点跑题)

更多的算符和更加复杂的规则?

没错, 算算加减乘除什么的有点太轻松了吧? 我觉得, 对于纯正数p, (啊, 先叠个甲, 俺就是一臭学物理的, 还是搞实验方向的菜逼), 估计是抽象代数才能些许挑起一些兴趣?

啊, 蟪蛄莫言春秋, 我还是先别想这些东西先. 还是看 视频 里面的游戏, 里面有一个会分裂的史莱姆, 会毒杀所有奇数怪物的 (平等扣血) 的中毒巫师, 会攻击后自动叛变的队友 (如果血量大于敌人). 这种时候就感觉更像是一种回合制策略游戏了.

为什么要加入这样超过四则运算的规则? 实际上并没有, 分裂就是 /, 毒杀更像是 -1, 但是它们的表现又有些不同, 所以让这个游戏在另一个程度上来说增加了随机性.

这种随机性的来源, 我认为是在于因为不容易被单一机械地实现, 所以会让人有一些感兴趣的地方.

那么这样该如何设计?

我觉得可能需要修改 leaves-reduce 函数以及对 op-set 添加更多的描述特性, 来支持更多的操作, 比如说分裂的操作 (但是感觉这样可能就不是很容易画出 AST 了).

Aesthetic

(注: 虽然这部分应当被放在后记中的, 因为我有点不是那么想继续写这个东西了…)

这能怎么有趣起来?

原始游戏 中, 给数字画了一个好看的立绘, 并且还有一个还算简单好用的交互… 在 视频 中所展示的, 通过在基本规则上添加肉鸽的随机性, 来让这个更加有趣一些.

当然, 美术肯定是重要的, 但是这个暂时不是我们讨论的重点, 毕竟我现在不想画画.

一些阴暗的想法:

  • 这个可以直接变成换皮美少女游戏呢… 只要立绘改一改, 甚至还可能可以有收集属性, 这样就可以抽卡, 氪金…
  • 这个还可以直接出动画收割一波粉丝, 然后骗氪佬入场
  • 甚至还可以变成 PVP, 然后整一个排行榜, 卧槽, 社交属性一下子就上来了

太恶心了.

玩这游戏的人都是什么成分…

虽然我不理解为什么就是会有人喜欢玩 24 点, 但是既然它存在, 就应当是有这么一部分人喜欢的. 也许是策略性? 也许是随机性?

但是 24 点有时候也会有一些不一样的地方, 比如小孩子可能并不知道阶乘 (bushi) 或者说括号, 指标之类的东西, 但是长大了之后, 可能就会学刁了, 喜欢用上一些自己觉得花里胡哨的运算来解决问题 – 嗯, 成就感.

但是如果换一个角度来看, 如果增加一个类似于 Steam 的创意工坊, 比如说加上自定义卡组函数之类的功能, 会不会更加好玩呢? 因为你可以自己造函数了呢. (就是不知道会不会图灵完备呢? )

后记

大概就这样?