# 99 questions/Solutions/93

< 99 questions | Solutions

Jump to navigation
Jump to search
Revision as of 15:30, 8 June 2017 by Determinant (talk | contribs)

(***) An arithmetic puzzle

Given a list of integer numbers, find a correct way of inserting arithmetic signs (operators) such that the result is a correct equation. Example: With the list of numbers [2,3,5,7,11] we can form the equations 2-3+5+7 = 11 or 2 = (3*5+7)/11 (and ten others!).

Division should be interpreted as operating on rationals, and division by zero should be avoided.

```
module P93 where
import Control.Monad
import Data.List
import Data.Maybe
type Equation = (Expr, Expr)
data Expr = Const Integer | Binary Expr Op Expr
deriving (Eq, Show)
data Op = Plus | Minus | Multiply | Divide
deriving (Bounded, Eq, Enum, Show)
type Value = Rational
-- top-level function: all correct equations generated from the list of
-- numbers, as pretty strings.
puzzle :: [Integer] -> [String]
puzzle ns = map (flip showsEquation "") (equations ns)
-- generate all correct equations from the list of numbers
equations :: [Integer] -> [Equation]
equations [] = error "empty list of numbers"
equations [n] = error "only one number"
equations ns = [(e1, e2) |
(ns1, ns2) <- splits ns,
(e1, v1) <- exprs ns1,
(e2, v2) <- exprs ns2,
v1 == v2]
-- generate all expressions from the numbers, except those containing
-- a division by zero, or redundant right-associativity.
exprs :: [Integer] -> [(Expr, Value)]
exprs [n] = [(Const n, fromInteger n)]
exprs ns = [(Binary e1 op e2, v) | (ns1, ns2) <- splits ns,
(e1, v1) <- exprs ns1,
(e2, v2) <- exprs ns2,
op <- [minBound..maxBound],
not (right_associative op e2),
v <- maybeToList (apply op v1 v2)]
-- splittings of a list into two non-empty lists
splits :: [a] -> [([a],[a])]
splits xs = tail (init (zip (inits xs) (tails xs)))
-- applying an operator to arguments may fail (division by zero)
apply :: Op -> Value -> Value -> Maybe Value
apply Plus x y = Just (x + y)
apply Minus x y = Just (x - y)
apply Multiply x y = Just (x * y)
apply Divide x 0 = Nothing
apply Divide x y = Just (x / y)
-- e1 op (e2 op' e3) == (e1 op e2) op' e3
right_associative :: Op -> Expr -> Bool
right_associative Plus (Binary _ Plus _) = True
right_associative Plus (Binary _ Minus _) = True
right_associative Multiply (Binary _ Multiply _) = True
right_associative Multiply (Binary _ Divide _) = True
right_associative _ _ = False
-- Printing of equations and expressions
showsEquation :: Equation -> ShowS
showsEquation (l, r) = showsExprPrec 0 l . showString " = " . showsExprPrec 0 r
-- all operations are left associative
showsExprPrec :: Int -> Expr -> ShowS
showsExprPrec _ (Const n) = shows n
showsExprPrec p (Binary e1 op e2) = showParen (p > op_prec) $
showsExprPrec op_prec e1 . showString (opName op) .
showsExprPrec (op_prec+1) e2
where op_prec = precedence op
precedence :: Op -> Int
precedence Plus = 6
precedence Minus = 6
precedence Multiply = 7
precedence Divide = 7
opName :: Op -> String
opName Plus = "+"
opName Minus = "-"
opName Multiply = "*"
opName Divide = "/"
```

Unlike the Prolog solution, I've eliminated solutions like
`"1+(2+3) = 6"` as a trivial variant of `"1+2+3 = 6"` (cf the function `right_associative`).
Apart from that, the Prolog solution is shorter because it uses built-in evaluation and printing of expressions.

A solution without ShowS:

```
puzzle :: [Integer] -> [String]
puzzle l = do i <- [1..length l-1]
let (subl, subr) = splitAt i l
(sl, vl, _) <- gen subl
(sr, vr, _) <- gen subr
if vl == vr then
return (sl ++ " = " ++ sr)
else []
gen :: [Integer] -> [(String, Rational, String)]
gen (x:[]) = return (show x, fromInteger x, "_")
gen l = do i <- [1..length l-1]
let (subl, subr) = splitAt i l
(sl, vl, opsl) <- gen subl
(sr, vr, opsr) <- gen subr
(ops, op) <- [("+", (+)), ("-", (-)), ("*", (*)), ("/", (/))]
if (ops == "/" && vr == 0) ||
(ops == "+" && (opsr == "+" || opsr == "-")) ||
(ops == "*" && (opsr == "*" || opsr == "/")) then []
else
return ((if opsl /= "_" &&
(ops == "*" || ops == "/") &&
(opsl == "+" || opsl == "-") then
"(" ++ sl ++ ")"
else sl)
++ " " ++ ops ++ " " ++
(if opsr /= "_" &&
((ops == "-" && opsr /= "*" && opsr /= "/") ||
(ops == "*" && (opsr == "+" || opsr == "-")) ||
ops == "/") then
"(" ++ sr ++ ")"
else sr), op vl vr, ops)
```