Haskell "to add or multiply" (slow version)

Today I'm rewriting this entire post (minus the code - it's very ugly code in retrospect).  So I'm trying to solve the "to add or multiply" problem from the ACM 2011 finals.  My hunch last week was that it could be solved in linear time.  This week I explored what I thought would be a linear solution and came back with some interesting notes.

Before I jump into the subject; the problem gives two ranges of integers (start and end), and two constants 'a' and 'm'.  Find arbitrary positive integers [i1, i2, i3, ... in] such that the following is contained within the range 'end':
(((start+i1*a)*m^i2 + i3*a)*m^i4 + i5*a) ....

(where arithmetic on ranges is identical to operations on a 2-vector.  a range consists of a start-value and end-value)

First, I now believe that there is no linear-time solution.  Intuitively, the reason is because there is a destination range and not a destination number.

Consider the inclusive range [a,b].  Now, there's a number 'x' that I can multiply an integer 'j' to get a value between a and b.  I also want 'j' to be minimal.  This is quite simple - if 'a mod x = 0' then the answer is a/x else it is 1+a/x.  Recall the computer always floors integer data, we would want the ceiling.

Within the problem, there's a point at which both j=a/x and j=1+a/x should be explored.  Below I'll try to informally explain this:

For the problem, it is possible to find a value 'a' that is the maximum number of multiplications that may be applied to [p,q] (the start range) until the values exceed [r,s] or the number of integers within the range of [p,q] exceeds that of [r,s].

The maximum number of multiplications is invariant no matter how many addition operators are present.  Simple example ('x' is a starting value, 'a' and 'm' are integers):
(x+a)m = xm + am

'am' will shift values a constant amount regardless of the starting value 'x'.  This is important, look at a range [2,3] -- [2,3] has 3 digits, [2,3]*4 = [8,12] has 5 digits.  We can add integers before the multiplication and the number of digits will not change.  This allows us to compute another value -- the minimum number of additions needed until a solution.

If it is not possible to find a series of additions that satisfies the start range and end range, then we can not conclude that there is no solution.  Consider that the increments of addition is 100,000 and multiplication is 2 with start range [1,2] to [5,20].

Neither is it possible to rely solely on multiplication.  Consider addition of 1 and multiplication of 7, start range [1,2] and end range [14,21].  The following is contained within the range: ([1,2]+1)*7

Knowing these two values helps us when searching for a solution.  The solution becomes:
x*m^j + i1*a*m^0 + i2*a*m^1 + ...

It's a matter of finding i1, i2, i... (j-1 unknowns).  If multiplication is 1 or 0, or if addition is 0 then the solution can be directly computed in constant time (depending upon your implementation of log - or if you decide to loop over values for multiplication -- which makes it O(n)).

Anyhow, a good strategy is to attempt to maximize the i for the m with the largest exponents.  Think of this as a heuristic.  When the number of integers can be in the tens of thousands, doing a brute-force search will be slow and memory consuming (simple arithmetic, just it will look like a mess here).

I'll continue playing with the numbers, maybe something interesting will pop out.

For historical purposes, here's a very slow / bad implementation of "to add or multiply":

import Data.Monoid
import Data.Char


-- AddOrMultiply
-- Given the ability to add 'a' or multiply 'm', see if there is a sequence
-- that starts in range [p,q] and ends in range [r,s]


data Operation = A Integer | M Integer


instance Show (Operation) where
show (A v) = " " ++ (show v) ++ "A"
show (M v) = " " ++ (show v) ++ "M"


apply :: Operation -> Integer -> Integer
apply (A v) a = (v+a)
apply (M v) a = (v*a)


data Partial = Partial (Integer,Integer,Integer) [Operation] deriving (Show)


applyl :: (Integer,Integer) -> [Operation] -> Partial
applyl (min,max) os = Partial (foldr apply min os,foldr apply max os,0) os


incrementMul :: Operation -> Integer -> Integer
incrementMul (M m) v = 1
incrementMul _ v = v


combineOps :: Operation -> [Operation] -> [Operation]
combineOps o [] = [o]
combineOps (A a) ((A as):xs) = (A $ a+as):xs
combineOps (M m) ((M ms):xs) = (M $ m+ms):xs
combineOps o xs = o:xs


add :: Operation -> Partial -> Partial
add o (Partial (min,max,mul) os) = Partial (apply o min, apply o max, incrementMul o mul) $ combineOps o os


validAdd :: (Integer,Integer)->Partial -> Bool
validAdd _ (Partial (_,_,0) _) = True
validAdd (a,m) (Partial _ ((A a1):_)) = a1 < (a*m)
validAdd _ _ = True


valid :: (Integer,Integer) -> (Integer,Integer) -> Partial -> Bool
valid am (r,s) (Partial (min,max,mul) os) = if (max <= s && max-min <= s-r && (validAdd am $ Partial (min,max,mul) os)) then True else False


iteration :: (Integer,Integer) -> (Integer,Integer) -> Partial -> [Partial]
iteration (a,m) rs ptl = filter (valid (a,m) rs) [add (A a) ptl, add (M m) ptl]


-- concatMap :: (a -> [b]) -> [a] -> [b]


startCondition :: (Integer,Integer) -> [Partial]
startCondition (p,q) = [Partial (p,q,0) []]


success :: (Integer,Integer) -> Partial -> Bool
success (r,s) (Partial (min,max,_) _) = if (min >= r && max <= s) then True else False


iterationl :: (Integer,Integer) -> (Integer,Integer) -> [Partial] -> [Partial]
iterationl (a,m) rs ps = concatMap (iteration (a,m) rs) ps


everything :: (Integer,Integer) -> (Integer,Integer) -> [Partial] -> [Partial]
everything _ _ [] = []
everything am rs ps = ps ++ (everything am rs $ iterationl am rs ps)


solutions :: (Integer,Integer) -> (Integer,Integer) -> (Integer,Integer) -> [Partial]
solutions am pq rs = filter (success rs) $ everything am rs $ startCondition pq


type Ampqrs = (Integer,Integer,Integer,Integer,Integer,Integer)


reformat :: (Integer,Integer) -> [Operation] -> [Operation]
reformat _ [] = []
reformat am ((A a1):(A a2):xs) = reformat am $ (A $ a1+a2):xs
reformat am ((M m1):(M m2):xs) = reformat am $ (M $ m1+m2):xs
reformat (a,m) ((A a1):xs) = ((A $ a1 `div` a):(reformat (a,m) xs))
reformat (a,m) ((M m1):xs) = ((M $ m1 `div` m):(reformat (a,m) xs))


solutionPartial :: Ampqrs -> [Partial]
solutionPartial (a,m,p,q,r,s) = take 1 $ solutions (a,m) (p,q) (r,s)


operationFromPartial :: Partial -> [Operation]
operationFromPartial (Partial _ o) = o


solution' :: (Integer,Integer) -> [Partial] -> Maybe [Operation]
solution' _ [] = Nothing
solution' am xs = Just . reverse . (reformat am) . operationFromPartial . head $ xs


solutionOp :: Ampqrs -> Maybe [Operation]
solutionOp (a,m,p,q,r,s) = solution' (a,m) $ solutionPartial (a,m,p,q,r,s)


solutionOp' :: [String] -> Maybe [Operation]
solutionOp' [a,m,p,q,r,s] = solutionOp (read a, read m, read p, read q, read r, read s)


parseLine :: String -> Maybe [Operation]
parseLine s = solutionOp' $ words s


display :: Integer -> [String] -> String
display _ [] = []
display _ [a] = []
display i (x:xs) = ("Case " ++ (show i) ++ ": " ++ (show $  parseLine x)) ++ ['\n'] ++ (display (i+1) xs)


main = do
contents <- getContents
putStr . (display 1) $ lines contents