I was recently tasked with creating a function that could generate a "varied" version of some collection of parameters. As in, it should take in a list of parameters, and then vary the value of the first one while leaving the rest fixed -- thus creating some variations.
We then move on to the next parameter, and repeat the same process (vary the one we are focusing on, leave other parameters fixed). This continues until we run out of parameters.
Parameters are "varied" by looking up an interval of multipliers in a Map, generating num multipliers in that interval, followed by multiplying the parameter by those multipliers to get its varied versions.
I tried solving this problem completely from scratch, rather than using some pre-existing libraries. My approach used the following
- A zipper so I could have a "cursor" to point to the parameter I was currently focusing on and varying
- Use the state monad to generate some variations based on the current state of the zipper, then shift the cursor,etc.
I do think my code feels rather overcomplicated and messy though, so I would like some feedback on how I could have done things better.
Further notes:
- I did use GADTs despite not being very well versed in them. This was because I wanted to impose the
Numconstraint for my RealInterval datatype. - I feel that maybe an
Intervaltypeclass was unnecessary.
{-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies, BangPatterns #-}
{-# LANGUAGE DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
import Control.Monad.Trans.State.Lazy
import Data.Function
import Debug.Trace
import qualified Data.Map as M
import Data.Maybe
import Data.List
data Zipper a = Zipper {left :: [a],
focus :: a,
right :: [a]}
deriving (Functor, Traversable, Foldable, Show)
fromList :: [a] -> Maybe (Zipper a)
fromList [] = Nothing
fromList (x:xs) = Just $ Zipper [] x xs
toList :: Zipper a -> [a]
toList (Zipper l f r) = transfer l (f:r)
where transfer [] l = l
transfer (x:xs) l = transfer xs (x:l)
class Interval i where
-- Generate a bunch of values in the interval, ranging from its start to end, with a step size specified by the 2nd argument.
range :: (Ord a, Fractional a) => i a -> a -> [a]
range i stepSize | stepSize == 0 = []
| otherwise = go seed []
where (trueStart, trueEnd) = endpoints i
(incStart, incEnd) = hasEndpoints i
next = if trueStart <= trueEnd then subtract stepSize else (+stepSize)
prev = if trueStart <= trueEnd then subtract stepSize else (+stepSize)
start = if incStart then trueStart else next trueStart
end = if incEnd then trueEnd else prev trueEnd
seed = if start <= end then end else start
go !curr ls | not $ i `has` curr = ls
| otherwise = go (prev curr) (curr:ls) -- builds list backwards
-- Generate equally spaced values in the interval (as specified by the integer like number. Returns an empty list if negative, for now.
linspace :: (Ord b, Fractional b, Integral a) => i b -> a -> [b]
linspace i n = range i stepSize
where (start, end) = endpoints i
stepSize = (end - start) / fromIntegral (n-1)
endpoints :: Num a => i a -> (a,a) -- Get the endpoints of the interval (start, end)
has :: (Ord a, Num a) => i a -> a -> Bool -- Check for whether a number is within an interval
hasEndpoints :: i a -> (Bool, Bool) -- Tells whether each endpoint of the interval is included
-- bisect :: Num a => i a -> a -> Maybe (i a, i a)
-- Attempts to bisect the interval around the provided value, if possible.
data RealInterval a where
RealInterval :: Num a => (a, Bool) -> (a, Bool) -> RealInterval a
instance Show a => Show (RealInterval a) where
show (RealInterval s e) = show s ++ " to " ++ show e
-- newtype RealInterval a = RealInterval {getEndpoints :: (Double, Double)}
instance Interval RealInterval where
endpoints (RealInterval s e) = (fst s, fst e)
has i v | prod < 0 = True
| prod > 0 = False
| otherwise = l == 0 && hs || r == 0 && he
where (s, e) = endpoints i
(hs, he) = hasEndpoints i
l = v - s
r = v - e
prod = l*r
hasEndpoints (RealInterval s e) = (snd s, snd e)
shift :: Zipper a -> Maybe (Zipper a)
shift (Zipper l f r) = case r of [] -> Nothing
(x:xs) -> Just $ Zipper (f:l) x xs
varyParams :: (Ord a, Fractional a, Integral b, Interval i) => M.Map a (i a) -> b -> [a] -> [[a]]
varyParams multipliers num params = case fromList params of Nothing -> [[]]
Just z -> evalState genVar z
where variations z = do let f = focus z
m <- maybe [] (flip linspace num) (M.lookup f multipliers)
pure . toList $ z {focus = m*f}
genVar = do z <- get
let v = variations z
case shift z of Nothing -> pure v
Just z -> do put z
rest <- genVar
pure (v ++ rest)
