Planet Haskell

VISA · derangement

f k = [ n | n <- [1..k], (length . show $ n) == (length . nub . show $ n) ]
drop_tail k = reverse . (drop k) . reverse
by_pairs u = zip (drop 1 u) (drop_tail 1 u)
g k = maximum . map (uncurry (-)) . by_pairs . f $ k
fac :: Integer -> Integer
fac 0 = 1
fac n = n * (fac (n-1))

choose :: Integer -> Integer -> Integer
choose n k = (fac n) `div` ((fac k) * (fac (n-k)))

d :: Integer -> Integer
d 1 = 0
d 2 = 1
d n = (n-1) * ( d (n-1) + d (n-2) )

b :: Integer -> Integer
b n = sum [ (d k) * (n `choose` k) | k <- [ 1..n ] ]
*Properties> quickCheck prop_VClipTerminates 
OK, passed 100 tests.
32% Done, ("Edge","Edge").
14% Done, ("Edge","Vertex").
11% Done, ("Vertex","Edge").
10% Done, ("Face","Vertex").
8% Penetration, ("Face","Vertex").
8% Done, ("Vertex","Face").
7% Done, ("Vertex","Vertex").
5% Penetration, ("Vertex","Face").
3% Penetration, ("Face","Edge").
2% Penetration, ("Edge","Face").

nonzero :: Gen Vec
nonzero = do { v - arbitrary; if norm v > 0 then v else nonzero }
 
class Applicative ((:~*) e) => NarrowMemo e where
        data (:~*) e :: * -> *
        type D e :: *
        apply :: (e :~* r) -> D e -> r
        memo :: (D e -> r) -> (e :~* r)
        domain :: D e -> e
 
instance NarrowMemo Bool where
        data Bool :~* a = MemoBool a a
        type D Bool = Bool
        apply (MemoBool o1 o2) True = o1
        apply (MemoBool o1 o2) False = o2
        memo f = MemoBool (f True) (f False)
        domain = id
 
 
instance Functor ((:~*) Bool) where
        fmap f (MemoBool a b) = MemoBool (f a) (f b)
 
instance Applicative ((:~*) Bool) where
        pure x = MemoBool x x
        MemoBool f g  < *> MemoBool a b = MemoBool (f a) (g b)
 
 
instance NarrowMemo e => Monad ((:~*) e) where
        return = pure
        m >>= k = memo $ apply (fmap k m) >>= apply -- in (->)e
 
 
instance (NarrowMemo a, NarrowMemo b) =>
    NarrowMemo (a,b) where
        data (a,b) :~* e = MemoBoth (a :~* (b :~* e))
        type D (a,b) = (D a, D b)
        apply (MemoBoth f) = uncurry (apply . apply f)
        memo f = MemoBoth $ memo $ \a -> memo (f . (,) a)
        domain = domain *** domain
 
instance (NarrowMemo a, NarrowMemo b) =>
    Functor ((:~*) (a,b)) where
        fmap f (MemoBoth g) = MemoBoth (fmap (fmap f) g)
 
instance (NarrowMemo a, NarrowMemo b) =>
    Applicative ((:~*) (a,b)) where
        pure = MemoBoth . pure . pure
        f < *> a = MemoBoth $
                memo $ \da ->
                memo $ \db ->
                let e = (da, db) in
                apply f e (apply a e)
 
 
instance (NarrowMemo a, NarrowMemo b) =>
    NarrowMemo (Either a b) where
        data Either a b :~* e = MemoEither (a :~* e) (b :~* e)
        type D (Either a b) = Either (D a) (D b)
        apply (MemoEither l _) (Left a) = apply l a
        apply (MemoEither _ r) (Right b) = apply r b
        memo f = MemoEither (memo (f . Left)) (memo (f . Right))
        domain = domain +++ domain
 
instance (NarrowMemo a, NarrowMemo b) =>
    Functor ((:~*) (Either a b)) where
        fmap f (MemoEither a b) = MemoEither (fmap f a) (fmap f b)
 
instance (NarrowMemo a, NarrowMemo b) =>
    Applicative ((:~*) (Either a b)) where
        pure f = MemoEither (pure f) (pure f)
        MemoEither f g < *> MemoEither a b = MemoEither (f < *> a) (g < *> b)
 
 
class Comonad w => ComonadContext s w | w -> s where
        getC :: w a -> s
        modifyC :: (s -> s) -> w a -> a
 
data Context s a = Context (s -> a) s
 
instance ComonadContext s (Context s) where
        getC (Context _ s) = s
        modifyC m (Context f c) = f (m c)
 
instance Functor (Context s) where
        fmap f (Context f' s) = Context (f . f') s
 
instance Copointed (Context s) where
        extract   (Context f a) = f a
 
instance Comonad (Context s) where
        duplicate (Context f a) = Context (Context f) a
 
 
data NarrowContext e a = NarrowContext (e :~* a) (D e)
 
instance NarrowMemo e => Functor (NarrowContext e) where
        fmap f (NarrowContext t d) = NarrowContext (memo (f . apply t)) d
 
instance NarrowMemo e => Copointed (NarrowContext e) where
        extract (NarrowContext t d) = apply t d
 
instance NarrowMemo e => Comonad (NarrowContext e) where
        duplicate (NarrowContext f a) =
                NarrowContext (memo (NarrowContext f)) a
 
instance NarrowMemo e => ComonadContext (D e) (NarrowContext e a) where
        getC (NarrowContext _ e) = e
        modifyC f (NarrowContext g e) = apply g (f e)
 
 
instance (NarrowMemo e, Monoid (D e)) => Copointed ((:~*) e) where
        extract t = apply t mempty
 
instance (NarrowMemo e, Monoid (D e)) => Comonad ((:~*) e) where
        duplicate f = memo $ m -> memo (apply f . mappend m)

Planet Haskell

Antti-Juhani Kaijanaho (ibid): SF encyclopedic wiki?

Real-World Haskell: Last Call for Comments on Most Chapters

Edward Kmett: MSFP 2008

John Goerzen (CosmicRay): Video uploading sites?

"FP Lunch": braincurry

Alex McLean: Visualisation of a triangular mesh

Paul R Brown: Beust Sequence Ruminations

Subfactorials, Derangements, and Chooses

Manuel M T Chakravarty: Unwelcome Advice from Intel

Manuel M T Chakravarty: Mac OS X Intel/Leopard installer for GHC 6.8.3 (final)

Haskell Weekly News: Haskell Weekly News: July 2, 2008

Announcements

Google Summer of Code

Libraries

Discussion

Jobs

Blog noise

Quotes of the Week

About the Haskell Weekly News

Antti-Juhani Kaijanaho (ibid): A reader’s meme

Roman Cheplyaka: V-Clip seems to work!

Joel Reymont: Mnesia Unlimited

John Goerzen (CosmicRay): Linux on the Desktop

Luke Palmer: Apparently I do not want to be in Antwerp

"Osfameron": Blog move

Philip Wadler: Welcome to Scotland, Neil, Patricia, and Conor!

Philip Wadler: Fractal Food

Conrad Parker: FOMS 2009 CFP

André Pang (ozone): Talks for 2008

Nick Mudge: First-Pass Arithmetic Parser

Mark Jason Dominus: Freshman electromagnetism questions: answer 3

John Goerzen (CosmicRay): A response to "7 Ways Religion is Detrimental to Science"

Dan Piponi (sigfpe): A blessed man's formula for holey containers

Roman Cheplyaka: Status report: week 5

John Goerzen (CosmicRay): Troops

Edward Kmett: Memoizing Context