Задача о составлении математических выражений на Хаскеле

В ЖЖ Романа Душкина не так давно был проведен конкурс на самое хорошее решение следующей задачи:
==
Даны числа 1, 5, 6 и 7. При помощи произвольного числа арифметических операций и
скобок необходимо составить такое математическое выражение из этих чисел, чтобы его
значение было равным 21. Данные числа можно использовать в выражении только по одному разу. Числа нельзя «склеивать» друг с другом (то есть из 1 и 5 получить 15).
==
Так как на конкурс я опоздал, да и решение у меня получилось наверняка не особо приятное :), опубликую его тут. Итак, в качестве языка выбираем Haskell.

Сначала подключим необходимые модули и опишем требуемые типы данных:

import Data.List
import Control.Monad

data Operation = Add | Sub | Mult | Div | Exp 
data Tree a = Node a | Branch (Operation, Tree a, Tree a) 

Будем рассматривать 5 бинарных операций. Дерево математического выражения может состоять либо из листа, который представляет собой собственно число, или ветви, которая содержит саму операцию и два поддерева: левое и правое. Пока ничего сложного.

Далее опишем функцию, которая будет вычислять математическое выражение, представленное конкретным деревом:

calcTree (Branch (op,x,y)) =
        case op of
  Add -> calcTree x + calcTree y
  Sub -> calcTree x - calcTree y
  Mult -> calcTree x * calcTree y
  Div -> calcTree x / calcTree y
  Exp -> calcTree x ** calcTree y
calcTree (Node x) = x

Следующим шагом напишем функцию, которая будет "сериализовать" дерево математического выражения.

showOp Add = "+"
showOp Sub = "-"
showOp Mult = "*"
showOp Div = "/"
showOp Exp = "^"
printTree (Branch (op, x, y)) =
 "(" ++ printTree x ++ " " ++ showOp op ++
  " " ++ printTree y ++ ")"
printTree (Node x) = show x

Здесь тоже ничего сложного нет, по идее.

Теперь переходим к самой важной части - генерации деревьев математических выражений.
Сначала опишем функцию divideLst, которая будет принимать некоторый список значений и формировать по нему список пар следующим образом:
для списка [1,2,3,4] => [([1],[2,3,4]), ([1,2],[3,4]), ([1,2,3],[4])]
То есть, исходный список делится на части разными способами.
Эта функция нам будет нужна для основной функции генерации деревьев.

divideLst xs = 
 [(x,y) | 
      (x,y) <- zip (inits xs) (tails xs),
              x /= [], y /= [] 
 ]      

Далее следует функция генерации дерева, в которой скрыта основная магия.

gen [] _  = []
gen [n] _ = [Node n]
gen l op = [ Branch (o,lb,rb) |
   o <- op,
   (lbr, rbr) <- divideLst l,
   lb <- gen lbr op,
   rb <- gen rbr op
    ]

На вход подается список чисел-листьев, для которых необходимо будет сгенерировать все возможные деревья, и список операций. Понятно, что если список чисел пуст, то и список сгенерированных деревьев будет пустым. Если во входном списке будет одно число, то и дерево будет представлять собой одиночный лист. Самый интересный случай, когда во входном списке присутствует несколько чисел. В этом случае, мы строим список ветвей, где в в качестве операции будут перебираться все операции из списка op, а левые и правые поддеревья будут строиться рекурсивно для всех комбинаций пар разбиений входного списка чисел, которые нам выдает описанная раннее функция divideLst.

Ну и, собственно, основная функция, которая решает задачу:

findTree n ops nums =
 mapM_ (\(c,t) -> print $ show c ++ " = " ++ t) 
   $ filter (\(c,_) -> c == n) 
 $ map (\t -> (calcTree t, printTree t)) 
 (concat [gen n ops | n <- nub $ permutations nums])     

Рассмотрим подробнее, что она делает.
(concat [gen n ops | n <- nub $ permutations nums]) формирует нам список все возможных вариантов деревьев для списка операций ops и списка чисел nums). Следующий map (\t -> (calcTree t, printTree t)) преобразует его к списку пар, первым значением которых будет идти вычисленное значение выражения для соответствуюшего дерева, а вторым - строчное представление этого дерева. На следующем шаге функцией фильтр мы отбираем из полученного списка только те элементы, первые элементы которых равны значению, на равенство которому мы проверяем наши математические выражения.
Ну и последний шаг просто выводит на экран необходимую информацию (значение выражения и его "сериализованный" вид).

Вызовем эту функцию так:

main =  findTree 21 [Add,Sub,Mult,Div,Exp] [1,5,6,7]

При запуске на выполнение получаем такой результат:

"21.0 = (6.0 / (1.0 - (5.0 / 7.0)))"

Дополнительно к этой задаче Роман задавал две дополнительные небольшие задачи, которые основываются на использовании основного решения.

1. Используя только пять базовых арифметических операций (+, -, *, /, ^),
определить, какие числа от 1 до 100 можно выразить четырьмя двойками?

Программа, её решающая может выглядеть так:

task1 =  [ x | x <- [1..100],  
  not $ null $ filter (\z -> calcTree z == x) 
  $ gen [2,2,2,2] [Add,Mult,Sub,Div,Exp] ] 

Само решение:

[1.0,2.0,3.0,4.0,5.0,6.0,8.0,9.0,10.0,
   12.0,14.0,16.0,18.0,32.0,36.0,64.0]

И вторая задача.
2. При помощи каких четвёрок чисел от 1 до 10 и при помощи только пяти базовых
арифметических операций можно выразить число 1488?

Программа:

task2 =  nub [ sort z | z <- replicateM 4 [1..10], 
         not $ null $ filter (\x -> calcTree x == 1488) 
         $ gen z [Add, Mult, Sub, Div, Exp] ]

И само решение:

[[2.0,6.0,8.0,8.0],[3.0,5.0,5.0,6.0],[4.0,4.0,6.0,8.0]]

Надеюсь, вам было интересно )