[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