# Difference between revisions of "99 questions/Solutions/93"

(categorize) |
Determinant (talk | contribs) |
||

Line 94: | Line 94: | ||

<tt>"1+(2+3) = 6"</tt> as a trivial variant of <tt>"1+2+3 = 6"</tt> (cf the function <tt>right_associative</tt>). |
<tt>"1+(2+3) = 6"</tt> as a trivial variant of <tt>"1+2+3 = 6"</tt> (cf the function <tt>right_associative</tt>). |
||

Apart from that, the Prolog solution is shorter because it uses built-in evaluation and printing of expressions. |
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) |
||

[[Category:Programming exercise spoilers]] |
[[Category:Programming exercise spoilers]] |

## Revision as of 15:29, 8 June 2017

(***) 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)