[Haskell-cafe] How to dynamic plan in Haskell?
Thomas DuBuisson
thomas.dubuisson at gmail.com
Sat May 18 07:03:22 UTC 2019
As an aside: I feel certain I saw a beautiful solution presented as
lecture notes and referencing a game show (around 2007). Maybe it was
in Hudak's book?
Perhaps I missed something, but the answer's I've seen posted thus far
are not dynamic programming. Certainly in the powerset case you'll
experience exponential costs. Benchmarks are good - try to solve with
numbers [1..64] in low numbers of seconds.
An explicit 98-ish solution is to have a generator that will refer to
the prior indexes in the list when computing the current index.
First the boiler plate:
```
{-# LANGUAGE OverloadedLists #-}
module Main where
import qualified Data.Set as Set
import Control.Monad (guard)
type Solution = Set.Set Int
-- A list of all sets of numbers, no duplicates and ignoring order,
-- that sum to the value @index + 1 at .
answer :: [[Solution]]
answer = fmap op [1..10]
where
```
Now for the interesting part. The recursive definition of a solution
for value `target` is `[target]` and the solutions for `x` added with
the solution for `target - x` where `x <- [0..target/2]. Some care
must be taken because solutions will overlap.
With that in mind:
```
-- Generate the entry for value @target@ (list index @target - 1@)
op :: Int -> [Solution]
op target =
([target] :: Solution) -- The target itself is an answer
: snub -- Ignore duplicate results
-- Better idea: don't
generate dups if you can...
(do let half = target `div` 2
halfRDown = (target-1) `div` 2
(ls,hs) <- zip (slice 0 half answer) -- Pair 0 .. t/2
-- with t-1, t-2 .. t/2+1
(reverse $ slice half halfRDown answer)
l <- ls -- For each solution to the lower number
h <- hs -- and the matching solution to the larger number
guard (Set.intersection l h == []) -- No repeat values! (?)
pure (l <> h) -- target = l + h
)
-- | List slice from a base and of given length
slice :: Int -> Int -> [a] -> [a]
slice base len = take len . drop base
-- | Efficient combined sort and nub
snub :: (Eq a, Ord a) => [a] -> [a]
snub = Set.toList . Set.fromList
main :: IO ()
main = print answers
```
-Thomas
On Fri, May 17, 2019 at 9:35 PM Magicloud Magiclouds
<magicloud.magiclouds at gmail.com> wrote:
>
> Hi,
>
> I solved the question. But I could not figure out a FP style solution.
>
> Question:
>
> 1 - 9, nine numbers. Show all the possible combinations that sum up to
> 10. Different orders are counted as the same.
>
> For example, [1, 4, 5].
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
More information about the Haskell-Cafe
mailing list