[Haskell-cafe] Mapping over Type Level Literals
Dominic Steinitz
dominic at steinitz.org
Thu Sep 11 21:53:02 UTC 2014
If I were not using type literals then I would do something like this but then errors would occur at runtime.
> > haarEtouffe :: Int -> Int -> Double -> Double
> > haarEtouffe n k t
> > | n <= 0 = error "n must be >= 1"
> > | k `mod`2 == 0 = error "k must be odd"
> > | k < 0 || k > 2^n - 1 = error "k must be >=0 and <= 2^n -1"
> > | (k' - 1) * 2 ** (-n') < t && t <= k' * 2 ** (-n') = 2 ** ((n' - 1) / 2)
> > | k' * 2 ** (-n') < t && t <= (k' + 1) * 2 ** (-n') = -2 ** ((n' - 1) / 2)
> > | otherwise = 0
> > where
> > k' = fromIntegral k
> > n' = fromIntegral n
>
> > n :: Int
> > n = 100
>
> > xss :: [[(Double, Double)]]
> > xss = map (\(m, k) -> map (\i -> let x = fromIntegral i / fromIntegral n in (x, haarEtouffe m k x)) [0..n - 1]) [(1,1), (2,1), (2,3), (3,1), (3,3), (3,5), (3,7)]
Dominic Steinitz
dominic at steinitz.org
http://idontgetoutmuch.wordpress.com
On 11 Sep 2014, at 21:43, Richard Eisenberg <eir at cis.upenn.edu> wrote:
>
> On Sep 11, 2014, at 8:58 AM, Dominic Steinitz <dominic at steinitz.org> wrote:
>>
>> But now of course I would like to map over n and k but these are at the type level. Can this be done? I imagine unsafeCoerce would have to come into it somewhere.
>
> Mapping at the type level is probably possible, but I don't see exactly what you mean -- there aren't any lists around to map with. If you make the example a little more concrete, I may be able to help.
>
> Richard
More information about the Haskell-Cafe
mailing list