Solving recursion/performance problem

razcore-rad · May 24, 2020, 9:08am

Hello there.

I’m new to this discourse and really Purescript. I took a few tries at learning FP, first with Haskell, then with Purescript and I think I’m finally making headway in a substantial way.

To put the skills into practice I took adventofcode as a playground. Not long into the puzzles and I can’t seem to solve a problem due to recursion and I’m not there yet with different monads to be able to solve it with State/ST/Ref yet so I’d really appreciate some pointers.

The problem is:

— Day 7: Some Assembly Required —

This year, Santa brought little Bobby Tables a set of wires and bitwise logic gates! Unfortunately, little Bobby is a little under the recommended age range, and he needs help assembling the circuit.

Each wire has an identifier (some lowercase letters) and can carry a 16-bit signal (a number from 0 to 65535 ). A signal is provided to each wire by a gate, another wire, or some specific value. Each wire can only get a signal from one source, but can provide its signal to multiple destinations. A gate provides no signal until all of its inputs have a signal.

The included instructions booklet describes how to connect the parts together: x AND y -> z means to connect wires x and y to an AND gate, and then connect its output to wire z .

For example:

123 -> x means that the signal 123 is provided to wire x .
x AND y -> z means that the bitwise AND of wire x and wire y is provided to wire z .
p LSHIFT 2 -> q means that the value from wire p is left-shifted by 2 and then provided to wire q .
NOT e -> f means that the bitwise complement of the value from wire e is provided to wire f .

Other possible gates include OR (bitwise OR) and RSHIFT (right-shift). If, for some reason, you’d like to emulate the circuit instead, almost all programming languages (for example, C, JavaScript, or Python) provide operators for these gates.

For example, here is a simple circuit:

123 -> x
456 -> y
x AND y -> d
x OR y -> e
x LSHIFT 2 -> f
y RSHIFT 2 -> g
NOT x -> h
NOT y -> i

After it is run, these are the signals on the wires:

d: 72
e: 507
f: 492
g: 114
h: 65412
i: 65079
x: 123
y: 456

In little Bobby’s kit’s instructions booklet (provided as your puzzle input), what signal is ultimately provided to wire a ?

And my solution is https://github.com/razcore-art/adventofcode/blob/master/src/AOC2015/D07.purs. Which I’m also pasting here for easier access:

module AOC2015.D07 where

import Prelude

import Data.Array (catMaybes)
import Data.Function.Memoize (memoize)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (fromString)
import Data.Int.Bits (complement, shl, shr, (.&.), (.|.))
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.String (Pattern(..), split, trim)
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))


data Wire
  = Constant Int
  | Link String
  | And String String
  | Or String String
  | Not String
  | LShift String Int
  | RShift String Int

derive instance genericWire :: Generic Wire _

instance showWire :: Show Wire where
  show = genericShow


input :: String
input = """
...
"""

input' :: Map String Wire
input' = M.fromFoldable <<< catMaybes $ sequence <$> catMaybes do
  arr <- map trim <<< split (Pattern "->") <$> (split (Pattern "\n") $ trim input)
  pure case arr of
            [expr, key] -> Just (Tuple key $ wireExpr expr)
            _           -> Nothing
  where wireExpr :: String -> Maybe Wire
        wireExpr s = case split (Pattern " ") s of
                          [a,     "AND",    b] -> Just $ And (trim a) (trim b)
                          [a,     "OR",     b] -> Just $ Or  (trim a) (trim b)
                          [a,     "LSHIFT", b] -> LShift (trim a) <$> fromString b
                          [a,     "RSHIFT", b] -> RShift (trim a) <$> fromString b
                          ["NOT", a          ] -> Just $ Not (trim a)
                          [a                 ] -> case fromString a of
                                                       Just i  -> Just $ Constant i
                                                       Nothing -> Just $ Link a
                          _                    -> Nothing

eval :: Map String Wire -> String -> Int
eval m k = case memoize (flip M.lookup m) k of
              Just (Constant i  ) -> i
              Just (Link     a  ) -> eval m a
              Just (And      a b) -> eval m a .&. eval m b
              Just (Or       a b) -> eval m a .|. eval m b
              Just (Not      a  ) -> complement $ eval m a
              Just (LShift   a i) -> shl (eval m a) i
              Just (RShift   a i) -> shr (eval m a) i
              Nothing             -> 0

part1 :: Int
part1 = memoize (eval input') "a"


part2 :: String
part2 = "TODO"

Which works fine on made-up “instruction” input and the example. But on the long puzzle input, it takes forever. As you can see I tried using memoize, but it doesn’t seem to improve anything. I also tried using trace from the debug module, but it didn’t print out anything in the eval recursive function, instead it pushes Purescript to error out, I didn’t save the error.

So, I’m pretty sure this is because Purescript is not a lazy language, I just don’t know how to make it work so any help is appreciated.

Thanks!

f-f · May 24, 2020, 1:24pm

I had a bried look at your source, but I don’t see evident perf issues - have you tried profiling the source to try to pin down the bottleneck?

razcore-rad · May 24, 2020, 1:31pm

I haven’t tried profiling cause I haven’t done too much node/javascript development anyway, I’m just interested in purescript really. But I don’t know what yo umean by “evident perf issues”. Have you tried to run the code from github? On my PC it just hangs and doesn’t seem to ever finish. I tried running it over night and it didn’t finish in 8h so I think that’s a bit of a problem.

Sorry I wasn’t specific when I posted. The performance issue is that… it never seem to finish running. And the puzzle has a solution, it’s not like there’s never-ending recursive calls.

jy14898 · May 24, 2020, 3:28pm

You’re currently memoizing the map lookup, which should already be fast. The following modified code terminates:

eval :: Map String Wire -> String -> Int
eval m k' = eval' k'
  where
    eval' = memoize \k -> case M.lookup k m of
      Just (Constant i  ) -> i
      Just (Link     a  ) -> eval' a
      Just (And      a b) -> eval' a .&. eval' b
      Just (Or       a b) -> eval' a .|. eval' b
      Just (Not      a  ) -> complement $ eval' a
      Just (LShift   a i) -> shl (eval' a) i
      Just (RShift   a i) -> shr (eval' a) i
      Nothing             -> 0

razcore-rad · May 24, 2020, 3:36pm

Looks like it does. Could you please elaborate a bit more on why my solution doesn’t finish but yours does? I tried memoize on M.lookup as a last resort in despair, but I tried before without as well cause I knew Map should be fast enough.

Oh I think I kind of guess why it works. Because you memoize the body of the recursive function, but in my case I was memoize-ing externally in part1 = memoize (eval "a") input'. Am I right?

jy14898 · May 24, 2020, 3:42pm

I’m not sure how memoize is implemented (feels like black magic), but I think you’re right in that memoizing the first external call is not enough, every recursive call must also pass through the memoize function, similar to the fibonacci example in the memoize docs

razcore-rad · May 24, 2020, 3:43pm

Thanks anyway, now I just need to find the bug

razcore-rad · May 24, 2020, 4:30pm

If anyone else gets to read this. I would like to know as to why the solution without memoize never finishes. If you have any ideas. I mean I know it’s a deeply nested recursive call, but still, I would expect that in this case, the input doesn’t seem insanely long and Map should be fast enough.

And in my case, on my first try, without memoize, or with the wrongly-placed memoize, it ran for 8 hours at least and didn’t finish, but it didn’t error out because of stack overflow either.

So any further insight into this would be really cool.

razcore-rad · May 24, 2020, 4:57pm

For completness I’m including the solution which works, after a few tweaks, cause there was a bug in how I translated the instructions from the puzzle and some other minor corrections:

module AOC2015.D07 where

import Prelude

import Data.Array (catMaybes)
import Data.Function.Memoize (memoize)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (fromString)
import Data.Int.Bits (shl, shr, (.&.), (.|.))
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..), maybe)
import Data.String (Pattern(..), split, trim)
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))


data Input = Constant Int | Link String

derive instance genericInput :: Generic Input _

instance shwoInput :: Show Input where
  show = genericShow

data Gate
  = Wire Input
  | And Input Input
  | Or Input Input
  | Not Input
  | LShift Input Int
  | RShift Input Int

derive instance genericWire :: Generic Gate _

instance showGate :: Show Gate where
  show = genericShow


input :: String
input = """
...
"""

input' :: Map String Gate
input' = M.fromFoldable <<< catMaybes $ sequence <$> catMaybes do
  arr <- map trim <<< split (Pattern "->") <$> (split (Pattern "\n") $ trim input)
  pure case arr of
            [expr, key] -> Just (Tuple key $ wireExpr expr)
            _           -> Nothing
  where parseInput :: String -> Input
        parseInput s = maybe (Link s) (Constant) $ fromString s

        wireExpr :: String -> Maybe Gate
        wireExpr s = case split (Pattern " ") s of
                          [a,     "AND",    b] -> Just $ And (parseInput a) (parseInput b)
                          [a,     "OR",     b] -> Just $ Or  (parseInput a) (parseInput b)
                          [a,     "LSHIFT", b] -> LShift (parseInput a) <$> fromString b
                          [a,     "RSHIFT", b] -> RShift (parseInput a) <$> fromString b
                          ["NOT", a          ] -> Just $ Not (parseInput a)
                          [a                 ] -> case fromString a of
                                                       Just i  -> Just $ Wire $ Constant i
                                                       Nothing -> Just $ Wire $ Link a
                          _                    -> Nothing

eval :: String -> Int
eval = memoize \k -> case M.lookup k input' of
                          Just (Wire   a  ) -> valueI a
                          Just (And    a b) -> valueI a .&. valueI b
                          Just (Or     a b) -> valueI a .|. valueI b
                          Just (Not    a  ) -> word16Max - valueI a
                          Just (LShift a i) -> valueI a `shl` i
                          Just (RShift a i) -> valueI a `shr` i
                          Nothing           -> 0
  where word16Max = 65535
        valueI (Constant x) = x
        valueI (Link     a) = eval a

part1 :: Int
part1 = eval "a"

Feel free to let me know how you’d improve this solution or what could I do to make it better. Thanks.

milesfrain · May 24, 2020, 5:27pm

A link to the diff would be a good way to share exactly which changes affect performance.

But there’s a bit more noise in there with some other edits.

Could you make another commit (or commit pair with revert) that just shows the minimum change between the fast and slow versions?

razcore-rad · May 24, 2020, 5:36pm

It’s simpler just to paste here the relevant parts. And it’s not that the “slow” version is slow really, it just doesn’t seem to complete.

Anyway, here’s the “slow” version:

eval :: Map String Wire -> String -> Int
eval m k = case M.lookup k m of [...]

part1 = memoize (eval input') "a"

VS

eval :: String -> Int
eval = memoize \k -> case M.lookup k input' of [...]

part1 = eval "a"

Also notice that this also is “slow”:

eval :: Map String Wire -> String -> Int
eval m = memoize \k -> case M.lookup k m of

Where the recursion is then given by eval m k.

The problem with the diff is that I also had a couple of bugs so I had to change the input' preparation and evaluation. So even if it would complete the computation would be wrong. I hope the above explanation is enough to showcase the difference though.

You can think of the case without memoize at all to be the “default” case. This “default” case, on my machine seems to not even complete. I mean 8 hours should be enough even with a large input… I would expect.

edit: But thanks for the diff idea, I’ll keep it in mind for the future.