Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE DeriveGeneric
, DeriveDataTypeable
, TypeFamilies
, TypeOperators
#-}
import Prelude hiding ((+), (*), (^))
import NumericPrelude
import Data.List (inits)
import Math.Combinatorics.Species
import Math.Combinatorics.Species.Types
import Math.Combinatorics.Species.AST
import Math.Combinatorics.Species.AST.Instances
import Math.Combinatorics.Species.Structures
import Data.Typeable
data BinTreeC = BinTreeC deriving (Typeable, Show)
data BinTree a = Leaf a | Node a (BinTree a) (BinTree a)
type instance Interp BinTreeC self = Id :+: (Id :*: (self :*: self))
instance ASTFunctor BinTreeC where
apply _ self = annI TX :+:: annI (annI TX :*:: annI (annI self :*:: annI self))
instance Enumerable BinTree where
type StructTy BinTree = Mu BinTreeC
iso (Mu (Inl (Id a))) = Leaf a
iso (Mu (Inr ((Id a) :*: (l :*: r)))) = Node a (iso l) (iso r)
data RoseTreeC = RoseTreeC deriving (Typeable, Show)
data RoseTree a = RoseTree a [RoseTree a]
type instance Interp RoseTreeC self = Id :*: ([] :.: self)
instance ASTFunctor RoseTreeC where
apply _ self = annI TX :*:: annI (annI TL :.:: annI self)
instance Enumerable RoseTree where
type StructTy RoseTree = Mu RoseTreeC
iso (Mu ((Id a) :*: (Comp cs))) = RoseTree a (map iso cs)
main :: IO ()
main = do
-- Eine Surjektion auf die Menge {1..k} ist gegeben durch ihre k Urbilder
-- (die nicht leer sind)
putStrLn $ "Surjektionen einer n-elementigen Menge auf eine " ++
show k ++ "-elementige Menge:"
print $ start $ labelled $ (nonEmpty set) ^ k
-- Alternative:
--print $ start $ labelled $ (ofSizeExactly linOrd k) `o` (nonEmpty set)
putStrLn $ "Surjektionen von einer n-elementigen Menge:"
print $ start $ labelled $ linOrd `o` nonEmpty set
-- Eine Injektion der Menge {1..k} ist gegeben durch eine Bijektion aufs Bild
-- und den Rest:
putStrLn $ "\nInjektionen der Menge {1, ..., " ++ show k ++ "} in eine" ++
"n-elementige Menge:"
print $ start $ labelled $ ofSizeExactly linOrd k * set
putStrLn $ "Injektionen in eine n-elementige Menge:"
print $ start $ labelled $ linOrd * set
-- Ein idempotenter Endofunktor auf {1..n} ist gegeben durch Partitionen von
-- {1..n} und ein ausgewähltes Element in jeder Teilmenge
putStrLn $ "\nAnzahl idempotenter Endofunktoren auf {1, ..., n}"
print $ start $ labelled $ set `o` (singleton * set)
-- siehe: http://topologicalmusings.wordpress.com/2009/03/28/number-of-idempotent-endofunctions/
-- Eine Involution auf {1..n} ist gegeben durch eine Überdeckung von {1..n}
-- durch Mengen der Mächtigkeit 1 oder 2 (für alle Fixpunkte bzw. alle Paare
-- von Zahlen, die aufeinander abgebildet werden)
putStrLn $ "\nAnzahl der Involutionen auf {1, ..., n}:"
print $ start $ labelled $ set `o` ofSize set (`elem` [1,2])
-- Alternative:
--print $ start $ labelled $ set `o` (ofSizeExactly set 1 + ofSizeExactly set 2)
putStrLn $ "\nAnzahl der Oktopoden mit n bunten Steinen"
print $ start $ labelled $ Math.Combinatorics.Species.cycle `o` nonEmpty linOrd
-- Diese Spezies ist sogar vordefiniert:
--print $ start $ labelled octopi
putStrLn $ "\nAnzahl der Binärbäume mit 5 verschiedenen Werten: " ++
show (length (enumerate (rec BinTreeC) [1..5] :: [BinTree Int]))
--print $ start $ map (length . (enumerate (rec BinTreeC) :: [Int] -> [BinTree Int])) $ inits [1..]
putStrLn $ "\nAnzahl der Informatikerbäume mit 5 verschiedenen Werten: " ++
show (length (enumerate (rec RoseTreeC) [1..5] :: [RoseTree Int]))
--print $ start $ map (length . (enumerate (rec RoseTreeC) :: [Int] -> [RoseTree Int])) $ inits [1..]
where
k = 4
start = take 16
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.