Skip to content

Instantly share code, notes, and snippets.

@smatting

smatting/sum-types.hs

Last active November 1, 2018 17:32
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save smatting/cdf4bc95006d40666800d7038910137c to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save smatting/cdf4bc95006d40666800d7038910137c to your computer and use it in GitHub Desktop.
Download ZIP
Raw
sum-types.hs
newtype Choice l = Choice [(Float, l)]
newtype Deterministic a = Deterministic a
newtype ChoicePlus l = ChoicePlus [l]
class Laralable l a where
larala :: l -> Larala a
instance Laralable (Deterministic a) a
where
larala (Deterministic y) = return y
instance Laralable (Larala a) a
where
larala = id
instance Laralable l a => Laralable (Choice l) a
where
larala (Choice lst) = do
let rv = weightedChoiceExtractCDF (cdfMapFromList lst)
(_, chosen) <- sampleRandom rv
larala chosen
instance Laralable l a => Laralable (ChoicePlus (Choice l)) a
where
larala (ChoicePlus lst) =
undefined
data Sum a =
Choice' (Choice (Sum a))
| ChoicePlus' (ChoicePlus (Choice (Sum a)))
| Deterministic' (Deterministic a)
instance Laralable (Sum a) a where
larala (Choice' c) = larala c
larala (ChoicePlus' cp) = larala cp
larala (Deterministic' d) = larala d
c1 :: Choice (Sum Char)
c1 = Choice [(1, Deterministic' (Deterministic 'a')), (1, Deterministic' (Deterministic 'b'))]
c2 :: Choice (Sum Char)
c2 = Choice [(2, Deterministic' (Deterministic 'a')), (2, Deterministic' (Deterministic 'b'))]
cp1 :: Sum Char
cp1 = ChoicePlus' $ ChoicePlus [c1, c2]
x :: Larala Char
x = larala cp1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment