Memoize a Double function in Haskell - haskell

I have a function
slow :: Double -> Double
which gets called very often (hundreds of millions of times), but only gets called on about a thousand discrete values. This seems like an excellent candidate for memoization, but I can't figure out how to memoize a function of a Double.
The standard technique of making a list doesn't work, since it's not an integral type. I looked at Data.MemoCombinators, but it doesn't natively support Doubles. There was a bits function for handling more data types, but Double isn't an instance of Data.Bits.
Is there an elegant way to memoize `slow?

You could always use ugly-memo. The internals are impure, but it's fast and does what you need (except if the argument is NaN).

I think StableMemo should do exactly what you want, but I don't have any experience with that.
There are two main approaches: use the Ord property to store the keys in a tree structure, like Map. That doesn't require the integral property you'd need for e.g. a MemoTrie approach; it is thus slower but very simple.
The alternative, that works with yet much more general types, is to map unorderedly onto a large integral domain with a Hash function, in order to, well, store the keys in a hash map. This is going to be substantially faster but pretty much just as simple since the interface of HashMap largely matches that of Map, so you probably want to go that way.
Now, sadly neither is quite as simple to use as MemoCombinators. That builds directly on IntTrie, which is specialised for offering a lazy / infinite / pure interface. Both Map and particularly HashMap, in contrast, can be used very well for impure memoisation, but are not inherently able to do it purely. You may throw in some UnsafePerformIO (uh oh), or just do it openly in the IO monad (yuk!). Or use StableMemo.
But it's actually easy and safe if you already know which values it's going to be, at least most of the calls, at compile-time. Then you can just fill a local hash map with those values in the beginning, and at each call look up if it's there and otherwise simply call the expensive function directly:
import qualified Data.HashMap.Lazy as HM
type X = Double -- could really be anything else
notThatSlow :: Double -> X
notThatSlow = \v -> case HM.lookup v memo of
Just x -> x
Nothing -> slow v
where memo = HM.fromList [ (v, x) | v<-expectedValues, let x = slow v ]

Related

Monotonic sequence type in haskell

I would like to define a type for infinite number sequence in haskell. My idea is:
type MySeq = Natural -> Ratio Integer
However, I would also like to be able to define some properties of the sequence on the type level. A simple example would be a non-decreasing sequence like this. Is this possible to do this with current dependent-type capabilities of GHC?
EDIT: I came up with the following idea:
type PositiveSeq = Natural -> Ratio Natural
data IncreasingSeq = IncreasingSeq {
start :: Ratio Natural,
diff :: PositiveSeq}
type IKnowItsIncreasing = [Ratio Natural]
getSeq :: IncreasingSeq -> IKnowItsIncreasing
getSeq s = scanl (+) (start s) [diff s i | i <- [1..]]
Of course, it's basically a hack and not actually type safe at all.
This isn't doing anything very fancy with types, but you could change how you interpret a sequence of naturals to get essentially the same guarantee.
I think you are thinking along the right lines in your edit to the question. Consider
data IncreasingSeq = IncreasingSeq (Integer -> Ratio Natural)
where each ratio represents how much it has increased from the previous number (starting with 0).
Then you can provide a single function
applyToIncreasing :: ([Ratio Natural] -> r) -> IncreasingSeq -> r
applyToIncreasing f (IncreasingSeq s) = f . drop 1 $ scanl (+) 0 (map (s $) [0..])
This should let you deconstruct it in any way, without allowing the function to inspect the real structure.
You just need a way to construct it: probably a fromList that just sorts it and an insert that performs a standard ordered insertion.
It pains part of me to say this, but I don't think you'd gain anything over this using fancy type tricks: there are only three functions that could ever possibly go wrong, and they are fairly simple to correctly implement. The implementation is hidden so anything that uses those is correct as a result of those functions being correct. Just don't export the data constructor for IncreasingSeq.
I would also suggest considering making [Ratio Natural] be the underlying representation. It simplifies things and guarantees that there are no "gaps" in the sequence (so it is guaranteed to be a sequence).
If you want more safety and can take the performance hit, you can use data Nat = Z | S Nat instead of Natural.
I will say that if this was Coq, or a similar language, instead of Haskell I would be more likely to suggest doing some fancier type-level stuff (depending on what you are trying to accomplish) for a couple reasons:
In systems like Coq, you are usually proving theorems about the code. Because of this, it can be useful to have a type-level proof that a certain property holds. Since Haskell doesn't really have a builtin way to prove those sorts of theorems, the utility diminishes.
On the other hand, we can (sometimes) construct data types that essentially must have the properties we want using a small number of trusted functions and a hidden implementation. In the context of a system with more theorem proving capability, like Coq, this might be harder to convince theorem prover of the property than if we used a dependent type (possibly, at least). In Haskell, however, we don't have that issue in the first place.

getting and testing a random item in a list in Haskell

Lets say there is a list of all possible things
all3PStrategies :: [Strategy3P]
all3PStrategies = [strategyA, strategyB, strategyC, strategyD] //could be longer, maybe even infinite, but this is good enough for demonstrating
Now we have another function that takes an integer N and two strategies, and uses the first strategy for N times, and then uses the second strategy for N times and continues to repeat for as long as needed.
What happens if the N is 0, I want to return a random strategy, since it breaks the purpose of the function, but it must ultimatley apply a particular strategy.
rotatingStrategy [] [] _ = chooseRandom all3PStrategies
rotatingStrategy strategy3P1 strategy3P2 N =
| … // other code for what really happens
So I am trying to get a rondom strategy from the list. I Think this will do it:
chooseRandom :: [a] -> RVar a
But how do I test it using Haddock/doctest?
-- >>> chooseRandom all3PStrategies
-- // What goes here since I cant gurauntee what will be returned...?
I think random functions kind of goes against the Haskell idea of functional, but I also am likely mistaken. In imperative languages the random function uses various parameters (like Time in Java) to determine the random number, so can't I just plug in a/the particular parameters to ensure which random number I will get?
If you do this: chooseRandom :: [a] -> RVar a, then you won't be able to use IO. You need to be able to include the IO monad throughout the type declaration, including the test cases.
Said more plainly, as soon as you use the IO monad, all return types must include the type of the IO monad, which is not likely to be included in the list that you want returned, unless you edit the structure of the list to accommodate items that have the IO Type included.
There are several ways to implement chooseRandom. If you use a version that returns RVar Strategy3P, you will still need to sample the RVar using runRVar to get a Strategy3P that you can actually execute.
You can also solve the problem using the IO monad, which is really no different: instead of thinking of chooseRandom as a function that returns a probability distribution that we can sample as necessary, we can think of it as a function that returns a computation that we can evaluate as necessary. Depending on your perspective, this might make things more or less confusing, but at least it avoids the need to install the rvar package. One implementation of chooseRandom using IO is the pick function from this blog post:
import Random (randomRIO)
pick :: [a] -> IO a
pick xs = randomRIO (0, (length xs - 1)) >>= return . (xs !!)
This code is arguably buggy: it crashes at runtime when you give it the empty list. If you're worried about that, you can detect the error at compile time by wrapping the result in Maybe, but if you know that your strategy list will never be empty (for example, because it's hard-coded) then it's probably not worth bothering.
It probably follows that it's not worth testing either, but there are a number of solutions to the fundamental problem, which is how to test monadic functions. In other words, given a monadic value m a, how can we interrogate it in our testing framework (ideally by reusing functions that work on the raw value a)? This is a complex problem addressed in the QuickCheck library and associated research paper, Testing Monadic Code with QuickCheck).
However, it doesn't look like it would be easy to integrate QuickCheck with doctest, and the problem is really too simple to justify investing in a whole new testing framework! Given that you just need some quick-and-dirty testing code (that won't actually be part of your application), it's probably OK to use unsafePerformIO here, even though many Haskellers would consider it a code smell:
{-|
>>> let xs = ["cat", "dog", "fish"]
>>> elem (unsafePerformIO $ pick xs) xs
True
-}
pick :: [a] -> IO a
Just make sure you understand why using unsafePerformIO is "unsafe" (it's non-deterministic in general), and why it doesn't really matter for this case in particular (because failure of the standard RNG isn't really a big enough risk, for this application, to justify the extra work we'd require to capture it in the type system).

Haskell: `Map (a,b) c` versus `Map a (Map b c)`?

Thinking of maps as representations of finite functions, a map of two or more variables can be given either in curried or uncurried form; that is, the types Map (a,b) c and Map a (Map b c) are isomorphic, or something close to it.
What practical considerations are there — efficiency, etc — for choosing between the two representations?
The Ord instance of tuples uses lexicographic order, so Map (a, b) c is going to sort by a first anyway, so the overall order will be the same. Regarding practical considerations:
Because Data.Map is a binary search tree splitting at a key is comparable to a lookup, so getting a submap for a given a in the uncurried form won't be significantly more expensive than in the curried form.
The curried form may produce a less balanced tree overall, for the obvious reason of having multiple trees instead of just one.
The curried form will have a bit of extra overhead to store the nested maps.
The nested maps of the curried form representing "partial applications" can be shared if some a values produce the same result.
Similarly, "partial application" of the curried form gives you the existing inner map, while the uncurried form must construct a new map.
So the uncurried form is clearly better in general, but the curried form may be better if you expect to do "partial application" often and would benefit from sharing of Map b c values.
Note that some care will be necessary to ensure you actually benefit from that potential sharing; you'll need to explicitly define any shared inner maps and reuse the single value when constructing the full map.
Edit: Tikhon Jelvis points out in the comments that the memory overhead of the tuple constructors--which I did not think to account for--is not at all negligible. There is certainly some overhead to the curried form, but that overhead is proportional to how many distinct a values there are. The tuple constructor overhead in the uncurried form, on the other hand, is proportional to the total number of keys.
So if, on average, for any given value of a there are three or more distinct keys using it you'll probably save memory using the curried version. The concerns about unbalanced trees still apply, of course. The more I think about it, the more I suspect the curried form is unequivocally better except perhaps if your keys are very sparse and unevenly distributed.
Note that because arity of definitions does matter to GHC, the same care is required when defining functions if you want subexpressions to be shared; this is one reason you sometimes see functions defined in a style like this:
foo x = go
where z = expensiveComputation x
go y = doStuff y z
Tuples are lazy in both elements, so the tuple version introduces a little extra laziness. Whether this is good or bad strongly depends on your usage. (In particular, comparisons may force the tuple elements, but only if there are lots of duplicate a values.)
Beyond that, I think it's going to depend on how many duplicates you have. If a is almost always different whenever b is, you're going to have a lot of small trees, so the tuple version might be better. On the other hand, if the opposite is true, the non-tuple version may save you a little time (not constantly recomparing a once you've found the appropriate subtree and you're looking for b).
I'm reminded of tries, and how they store common prefixes once. The non-tuple version seems to be a bit like that. A trie can be more efficient than a BST if there's lots of common prefixes, and less efficient if there aren't.
But the bottom line: benchmark it!! ;-)
Apart from the efficiency aspects, there's also a pragmatic side to this question: what do you want to do with this structure?
Do you, for instance, want to be able to store an empty map for a given value of type a? If so, then the uncurried version might be more practical!
Here's a simple example: let's say we want to store String-valued properties of persons - say the value of some fields on that person's stackoverflow profile page.
type Person = String
type Property = String
uncurriedMap :: Map Person (Map Property String)
uncurriedMap = fromList [
("yatima2975", fromList [("location","Utrecht"),("age","37")]),
("PLL", fromList []) ]
curriedMap :: Map (Person,Property) String
curriedMap = fromList [
(("yatima2975","location"), "Utrecht"),
(("yatima2975","age"), "37") ]
With the curried version, there is no nice way to record the fact that user "PLL" is known to the system, but hasn't filled in any information. A person/property pair ("PLL",undefined) is going to cause runtime crashes, since Map is strict in the keys.
You could change the type of curriedMap to Map (Person,Property) (Maybe String) and store Nothings in there, and that might very well be the best solution in this case; but where there's a unknown/varying number of properties (e.g. depending on the kind of Person) that will also run into difficulties.
So, I guess it also depends on whether you need a query function like this:
data QueryResult = PersonUnknown | PropertyUnknownForPerson | Value String
query :: Person -> Property -> Map (Person, Property) String -> QueryResult
This is hard to write (if not impossible) in the curried version, but easy in the uncurried version.

ST Monad == code smell?

I'm working on implementing the UCT algorithm in Haskell, which requires a fair amount of data juggling. Without getting into too much detail, it's a simulation algorithm where, at each "step," a leaf node in the search tree is selected based on some statistical properties, a new child node is constructed at that leaf, and the stats corresponding to the new leaf and all of its ancestors are updated.
Given all that juggling, I'm not really sharp enough to figure out how to make the whole search tree a nice immutable data structure à la Okasaki. Instead, I've been playing around with the ST monad a bit, creating structures composed of mutable STRefs. A contrived example (unrelated to UCT):
import Control.Monad
import Control.Monad.ST
import Data.STRef
data STRefPair s a b = STRefPair { left :: STRef s a, right :: STRef s b }
mkStRefPair :: a -> b -> ST s (STRefPair s a b)
mkStRefPair a b = do
a' <- newSTRef a
b' <- newSTRef b
return $ STRefPair a' b'
derp :: (Num a, Num b) => STRefPair s a b -> ST s ()
derp p = do
modifySTRef (left p) (\x -> x + 1)
modifySTRef (right p) (\x -> x - 1)
herp :: (Num a, Num b) => (a, b)
herp = runST $ do
p <- mkStRefPair 0 0
replicateM_ 10 $ derp p
a <- readSTRef $ left p
b <- readSTRef $ right p
return (a, b)
main = print herp -- should print (10, -10)
Obviously this particular example would be much easier to write without using ST, but hopefully it's clear where I'm going with this... if I were to apply this sort of style to my UCT use case, is that wrong-headed?
Somebody asked a similar question here a couple years back, but I think my question is a bit different... I have no problem using monads to encapsulate mutable state when appropriate, but it's that "when appropriate" clause that gets me. I'm worried that I'm reverting to an object-oriented mindset prematurely, where I have a bunch of objects with getters and setters. Not exactly idiomatic Haskell...
On the other hand, if it is a reasonable coding style for some set of problems, I guess my question becomes: are there any well-known ways to keep this kind of code readable and maintainable? I'm sort of grossed out by all the explicit reads and writes, and especially grossed out by having to translate from my STRef-based structures inside the ST monad to isomorphic but immutable structures outside.
I don't use ST much, but sometimes it is just the best solution. This can be in many scenarios:
There are already well-known, efficient ways to solve a problem. Quicksort is a perfect example of this. It is known for its speed and in-place behavior, which cannot be imitated by pure code very well.
You need rigid time and space bounds. Especially with lazy evaluation (and Haskell doesn't even specify whether there is lazy evaluation, just that it is non-strict), the behavior of your programs can be very unpredictable. Whether there is a memory leak could depend on whether a certain optimization is enabled. This is very different from imperative code, which has a fixed set of variables (usually) and defined evaluation order.
You've got a deadline. Although the pure style is almost always better practice and cleaner code, if you are used to writing imperatively and need the code soon, starting imperative and moving to functional later is a perfectly reasonable choice.
When I do use ST (and other monads), I try to follow these general guidelines:
Use Applicative style often. This makes the code easier to read and, if you do switch to an immutable version, much easier to convert. Not only that, but Applicative style is much more compact.
Don't just use ST. If you program only in ST, the result will be no better than a huge C program, possibly worse because of the explicit reads and writes. Instead, intersperse pure Haskell code where it applies. I often find myself using things like STRef s (Map k [v]). The map itself is being mutated, but much of the heavy lifting is done purely.
Don't remake libraries if you don't have to. A lot of code written for IO can be cleanly, and fairly mechanically, converted to ST. Replacing all the IORefs with STRefs and IOs with STs in Data.HashTable was much easier than writing a hand-coded hash table implementation would have been, and probably faster too.
One last note - if you are having trouble with the explicit reads and writes, there are ways around it.
Algorithms which make use of mutation and algorithms which do not are different algorithms. Sometimes there is a strightforward bounds-preserving translation from the former to the latter, sometimes a difficult one, and sometimes only one which does not preserve complexity bounds.
A skim of the paper reveals to me that I don't think it makes essential use of mutation -- and so I think a potentially really nifty lazy functional algorithm could be developed. But it would be a different but related algorithm to that described.
Below, I describe one such approach -- not necessarily the best or most clever, but pretty straightforward:
Here's the setup a I understand it -- A) a branching tree is constructed B) payoffs are then pushed back from the leafs to the root which then indicates the best choice at any given step. But this is expensive, so instead, only portions of the tree are explored to the leafs in a nondeterministic manner. Furthermore, each further exploration of the tree is determined by what's been learned in previous explorations.
So we build code to describe the "stage-wise" tree. Then, we have another data structure to define a partially explored tree along with partial reward estimates. We then have a function of randseed -> ptree -> ptree that given a random seed and a partially explored tree, embarks on one further exploration of the tree, updating the ptree structure as we go. Then, we can just iterate this function over an empty seed ptree to get a list of increasingly more sampled spaces in the ptree. We then can walk this list until some specified cutoff condition is met.
So now we've gone from one algorithm where everything is blended together to three distinct steps -- 1) building the whole state tree, lazily, 2) updating some partial exploration with some sampling of a structure and 3) deciding when we've gathered enough samples.
It's can be really difficult to tell when using ST is appropriate. I would suggest you do it with ST and without ST (not necessarily in that order). Keep the non-ST version simple; using ST should be seen as an optimization, and you don't want to do that until you know you need it.
I have to admit that I cannot read the Haskell code. But if you use ST for mutating the tree, then you can probably replace this with an immutable tree without losing much because:
Same complexity for mutable and immutable tree
You have to mutate every node above the new leaf. An immutable tree has to replace all nodes above the modified node. So in both cases the touched nodes are the same, thus you don't gain anything in complexity.
For e.g. Java object creation is more expensive than mutation, so maybe you can gain a bit here in Haskell by using mutation. But this I don't know for sure. But a small gain does not buy you much because of the next point.
Updating the tree is presumably not the bottleneck
The evaluation of the new leaf will probably be much more expensive than updating the tree. At least this is the case for UCT in computer Go.
Use of the ST monad is usually (but not always) as an optimization. For any optimization, I apply the same procedure:
Write the code without it,
Profile and identify bottlenecks,
Incrementally rewrite the bottlenecks and test for improvements/regressions,
The other use case I know of is as an alternative to the state monad. The key difference being that with the state monad the type of all of the data stored is specified in a top-down way, whereas with the ST monad it is specified bottom-up. There are cases where this is useful.

Memoization in Haskell using premade data structures

I find this answer and this wiki page to be excellent introductions to memoization in Haskell. They do, however, still leave me with a question that I hope to get answered:
It seems to me that the technique used requires you to "open up" (as in "access the internals of") the data structure you use to store your memoization. For example, 1 implements a table structure and 2 implements a tree in section 3. Is it possible to do something similar with a pre-made data structure? Suppose, for example, that you think that Data.Map is really awesome, and would like to store your memoized values in such a Map. Can one approach memoization with a pre-made data structure such as this, where one does not implement the structure itself, but rather use a pre-made one?
Hopefully someone will give me a hint on how to think, or, perhaps more likely, correct my misunderstanding of functional memoization in general.
Edit: I can think of one way to do it, but it's not at all elegant: If f :: a -> b, then one can probably easily make a memoized version f' :: Map a b -> a -> (Map a b, b), where the first argument is the memoization storage, and the output pair contains a potentially updated storage and the computed value. This state-passing is certainly not what I want (although I guess it could be wrapped in a monad, but it's several orders of magnitudes uglier than the approach in 1 and 2).
Edit 2: Maybe it helps to try and express my current way of (incorrect) thought. Currently, I seem to repeatedly pull myself, against my will, into the non-solution
import qualified Data.Map as Map
memo :: (Ord a) => [a] -> (a -> b) -> (a -> b)
memo domain f = (Map.!) storage
where
storage = Map.fromList (zip domain (map f domain))
The more I stare at this, the more I realize I've misunderstood something basic. You see, it feels to me that my memo [True, False] is equivalent to the bool memoizer of 1.
If you notice, Data.Memocombinators actually relies on the "pre-made" Data.IntTrie. I'm sure you could take the same code and replace uses of the IntTrie with another data structure, though it may not be as efficient.
The general idea of memoization is to save computed results. In Haskell, the easiest way to do this is to map your function onto a table where the table has one dimension per parameter. Since Haskell is lazy (well, most data structures in Haskell are), it will only evaluate the value of a given cell when you specifically ask for it. "table" basically means "map" since it takes you from key(s) to value.
[edit] Additional thoughts regarding Example 2
If I'm not mistaken, then the first time (Map.!) storage is forced to evaluate for a given key, the storage structure will be entirely wrung out (though the computation f won't happen for anything but the given key). So the first lookup will cause an additional O(n) operation, n being length domain. Subsequent lookups would not, afaik, incur this cost.
Lazier structures like typical int-indexed lists or the IntTrie similarly need to manifest their structure when a lookup is invoked, but unlike a Map, they need not do so all at once. Lists are wrung out until the indexed key is accessed. IntTries wring out only the integer keys that are "prefixes" (or suffixes? not sure. could be implemented either way) of the desired key. Index 11, (1011) would wring out 1 (1), 2 (10), 5 (101), and 11 (1011). Data.Memocombinators simply transforms all keys into Ints (or "bits") so that an IntTrie can be used.
p.s. is there a better phrase than "wring out" for this? The words "force", "spine", and "manifest" come to mind, but I can't quite think of the right word/phrase for this.

Resources