├── .gitignore ├── Bijections.hs ├── CompNotSymmTemp.hs ├── GraphViz.hs ├── HoTT-coends.txt ├── Inkcov.hs ├── KanExtensions.hs ├── README.md ├── Shake.hs ├── SpeciesDiagrams.hs ├── Structures.hs ├── SumPermDiagrams.hs ├── Yorgey-thesis-final-2014-11-14-COLOR.pdf ├── Yorgey-thesis-final-2014-11-14-GRAY.pdf ├── Yorgey-thesis-final-2014-11-14.pdf ├── Yorgey-thesis-final-2014-11-17-GRAY.pdf ├── Yorgey-thesis-final-2014-11-17.pdf ├── abstract.tex ├── abstract_UMI.txt ├── acks.tex ├── agda ├── EquivEq.agda └── PartialIso.agda ├── boring ├── colorpages.sh ├── colorpages.txt ├── conclusion.lhs ├── defense ├── Proposal.hs ├── Shake.hs ├── defense.lhs ├── feedback │ ├── jacques-thesis-comments.txt │ └── questions.txt └── images │ ├── BinTree.pdf │ ├── bridge.gif │ ├── bridge.png │ └── plclub.png ├── defs.lhs ├── defs.sty ├── dump.txt ├── equality.lhs ├── generalized.lhs ├── gf.lhs ├── graypages.txt ├── images ├── relabeling.pdf └── thesis-beeminder.png ├── inkcov.txt ├── intro.lhs ├── labelled.lhs ├── liftproof.lhs ├── notes.org ├── pages.txt ├── prelim.lhs ├── proposal ├── Diagrams.hs ├── Shake.hs ├── Species-old.hs ├── Tree.hs ├── announce.txt ├── haskell.sty ├── images │ ├── BLL-cover.jpg │ ├── joyal-screencap.png │ ├── joyal-species.png │ ├── ocaml-logo.gif │ ├── ocaml-logo.png │ ├── oh-my.png │ ├── orange-tree.jpg │ ├── plclub.png │ ├── relabeling.pdf │ ├── species-package.png │ ├── tree-holes-partition.pdf │ └── universe.jpg ├── lhs2TeX-extra.fmt ├── notes.org ├── proposal.lhs └── talk.lhs ├── spe-closed-Cauchy.txt ├── species.lhs ├── thesis-final-draft-2014-09-23.pdf ├── thesis.bib ├── thesis.fmt ├── thesis.log.pulp ├── thesis.tex ├── timeline.txt └── variants.lhs /.gitignore: -------------------------------------------------------------------------------- 1 | .shake.database 2 | Shake 3 | *.hi 4 | *.o 5 | *.dyn_hi 6 | *.dyn_o 7 | *.log 8 | *.aux 9 | *.toc 10 | *.bbl 11 | *.blg 12 | *.ptb 13 | *.lof 14 | *.lot 15 | *.out 16 | *.thm 17 | *.errors 18 | *.nav 19 | *.snm 20 | *.vrb 21 | *_flymake.* 22 | 23 | *.agdai 24 | 25 | *.tex 26 | !thesis.tex 27 | !abstract.tex 28 | !acks.tex 29 | thesis.pdf 30 | 31 | Test 32 | Test.hs 33 | Test.pdf 34 | 35 | .diagrams_cache 36 | /diagrams/* 37 | /proposal/diagrams/* 38 | /proposal/SpeciesDiagrams.hs 39 | /proposal/proposal.pdf 40 | /proposal/species.* 41 | 42 | doi.sty 43 | ntheorem.sty 44 | ntheorem.std 45 | 46 | screenshots/* 47 | 48 | defense/defense.pdf 49 | defense/SpeciesDiagrams.hs 50 | defense/Structures.hs 51 | defense/diagrams 52 | defense/species.sty 53 | 54 | defense/feedback/BCP-* -------------------------------------------------------------------------------- /Bijections.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE NoMonomorphismRestriction #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TupleSections #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | {-# LANGUAGE TypeSynonymInstances #-} 7 | 8 | module Bijections where 9 | 10 | import Control.Arrow ((&&&)) 11 | import Control.Lens (makeLenses, mapped, (^.), _2) 12 | import Control.Monad (msum) 13 | import Data.Default.Class 14 | import Data.List (findIndex, isSuffixOf, partition) 15 | import qualified Data.Map as M 16 | import Data.Maybe (catMaybes, fromMaybe) 17 | import Data.Typeable 18 | 19 | import Diagrams.Backend.Cairo 20 | import Diagrams.Core.Names 21 | import Diagrams.Prelude hiding (end, r2, start) 22 | import Graphics.SVGFonts 23 | 24 | ------------------------------------------------------------ 25 | -- Diagram utilities 26 | 27 | type Dia = Diagram Cairo R2 28 | 29 | dot :: Dia 30 | dot = circle 0.3 # fc black # lw none 31 | 32 | text' :: Double -> String -> Dia 33 | text' d t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False d d) # fc black 34 | 35 | ------------------------------------------------------------ 36 | -- Name utilities 37 | 38 | disjointly :: Qualifiable q => ([q] -> q) -> [q] -> q 39 | disjointly f = f . zipWith (|>) ['a'..] 40 | 41 | (|@) :: Char -> Int -> Name 42 | c |@ i = c |> toName i 43 | 44 | (|@@) :: Char -> [Int] -> [Name] 45 | c |@@ is = map (c |@) is 46 | 47 | ------------------------------------------------------------ 48 | -- Parallel composition 49 | 50 | -- Parallel composition is not necessarily associative, nor is empty 51 | -- an identity. 52 | class Par p where 53 | empty :: p 54 | par :: p -> p -> p 55 | par x y = pars [x,y] 56 | pars :: [p] -> p 57 | pars = foldr par empty 58 | 59 | ------------------------------------------------------------ 60 | -- Sets 61 | 62 | data ASet = 63 | ASet 64 | { _eltNames :: [Name] 65 | , _setColor :: Colour Double 66 | } 67 | 68 | $(makeLenses ''ASet) 69 | 70 | instance Qualifiable ASet where 71 | n |> s = s & eltNames %~ (n|>) 72 | 73 | type Set = [ASet] 74 | 75 | instance Par Set where 76 | empty = [] 77 | pars = disjointly concat 78 | 79 | nset :: Int -> Colour Double -> ASet 80 | nset n c = ASet (map toName [0::Int .. (n-1)]) c 81 | 82 | set :: IsName n => [n] -> Colour Double -> ASet 83 | set ns c = ASet (map toName ns) c 84 | 85 | drawSet :: Set -> Dia 86 | drawSet = centerY . vcat . zipWithMult (|>) ['a'..] . map drawAtomic . annot . annot 87 | where 88 | zipWithMult _ _ [x] = [x] 89 | zipWithMult f xs ys = zipWith f xs ys 90 | annot = reverse . zip (False : repeat True) 91 | drawAtomic (bot, (top, ASet nms c)) 92 | = mconcat 93 | [ vcat' (with & sep .~ 1 & catMethod .~ Distrib) 94 | (zipWith named nms (replicate (length nms) dot)) 95 | # centerY 96 | , roundedRect' 1 (fromIntegral (length nms)) 97 | (with & radiusTL .~ (if top then 0 else (1/2)) 98 | & radiusTR .~ (if top then 0 else (1/2)) 99 | & radiusBL .~ (if bot then 0 else (1/2)) 100 | & radiusBR .~ (if bot then 0 else (1/2)) 101 | ) 102 | # fcA (c `withOpacity` 0.5) 103 | ] 104 | 105 | ------------------------------------------------------------ 106 | -- Bijections 107 | 108 | data ABij 109 | = ABij 110 | { _bijDomain :: [Name] 111 | , _bijData :: Name -> Maybe Name 112 | , _bijStyle :: Name -> Style R2 113 | , _bijSep :: Double 114 | , _bijLabel :: Maybe Dia 115 | } 116 | 117 | $(makeLenses ''ABij) 118 | 119 | instance Qualifiable ABij where 120 | n |> bij = bij & bijData %~ prefixF n & bijDomain %~ (n |>) 121 | where 122 | prefixF :: IsName a => a -> (Name -> Maybe Name) -> (Name -> Maybe Name) 123 | prefixF _ _ (Name []) = Just $ Name [] 124 | prefixF i f (Name (AName a : as)) = 125 | case cast a of 126 | Nothing -> Nothing 127 | Just a' -> if a' == i then (i |>) <$> f (Name as) else Nothing 128 | 129 | bijFun :: [Int] -> (Int -> Maybe Int) -> ABij 130 | bijFun is f = def & bijDomain .~ toNamesI is & bijData .~ fmap toName . f . extractInt 0 131 | where 132 | extractInt :: Int -> Name -> Int 133 | extractInt i (Name []) = i 134 | extractInt i (Name ns) = case last ns of 135 | AName a -> case cast a of 136 | Nothing -> i 137 | Just i' -> i' 138 | 139 | bijTable :: [(Name, Name)] -> ABij 140 | bijTable tab = def & bijDomain .~ map fst tab & bijData .~ tableToFun tab 141 | 142 | mkABij :: ASet -> ASet -> (Int -> Int) -> ABij 143 | mkABij s1 s2 f = def & bijDomain .~ (s1 ^. eltNames) 144 | & bijData .~ \n -> findIndex (==n) (s1 ^. eltNames) >>= ((s2^.eltNames) !!!) . f 145 | 146 | -- mkBij :: Set -> Set -> (Int -> Int) -> Bij 147 | -- mkBij ss1 ss2 f = undefined 148 | 149 | (!!!) :: [a] -> Int -> Maybe a 150 | [] !!! _ = Nothing 151 | (x:_) !!! 0 = Just x 152 | (_:xs) !!! n = xs !!! (n-1) 153 | 154 | tableToFun :: Eq a => [(a, b)] -> a -> Maybe b 155 | tableToFun = flip lookup 156 | 157 | instance Default ABij where 158 | def = ABij 159 | { _bijDomain = [] 160 | , _bijData = const Nothing 161 | , _bijStyle = const $ mempty # dashingG [0.03,0.02] 0 # lineCap LineCapButt 162 | , _bijSep = 3 163 | , _bijLabel = Nothing 164 | } 165 | 166 | type Bij = [ABij] 167 | 168 | emptyBij :: Bij 169 | emptyBij = [with & bijData .~ const Nothing] 170 | 171 | parBij :: Bij -> Bij -> Bij 172 | parBij x y = parBijs [x,y] 173 | 174 | parBijs :: [Bij] -> Bij 175 | parBijs = disjointly concat 176 | 177 | labelBij :: String -> Bij -> Bij 178 | labelBij s = (mapped . bijLabel) .~ Just (text' 2 s) 179 | 180 | ------------------------------------------------------------ 181 | -- Alternating lists 182 | 183 | data AltList a b 184 | = Single a 185 | | Cons a b (AltList a b) 186 | 187 | infixr 5 .-, -., -.. 188 | 189 | (.-) :: a -> (b, AltList a b) -> AltList a b 190 | a .- (b,l) = Cons a b l 191 | 192 | (-.) :: b -> AltList a b -> (b, AltList a b) 193 | (-.) = (,) 194 | 195 | (-..) :: b -> a -> (b,AltList a b) 196 | b -.. a = (b, Single a) 197 | 198 | zipWithA :: (a1 -> a2 -> a3) -> (b1 -> b2 -> b3) -> AltList a1 b1 -> AltList a2 b2 -> AltList a3 b3 199 | zipWithA f _ (Single x1) (Single x2) = Single (f x1 x2) 200 | zipWithA f _ (Single x1) (Cons x2 _ _) = Single (f x1 x2) 201 | zipWithA f _ (Cons x1 _ _) (Single x2) = Single (f x1 x2) 202 | zipWithA f g (Cons x1 y1 l1) (Cons x2 y2 l2) = Cons (f x1 x2) (g y1 y2) (zipWithA f g l1 l2) 203 | 204 | concatA :: AltList a b -> b -> AltList a b -> AltList a b 205 | concatA (Single a) b l = Cons a b l 206 | concatA (Cons a b l) b' l' = Cons a b (concatA l b' l') 207 | 208 | flattenA :: AltList (AltList a b) b -> AltList a b 209 | flattenA (Single l) = l 210 | flattenA (Cons l b l') = concatA l b (flattenA l') 211 | 212 | map1 :: (a -> b) -> AltList a c -> AltList b c 213 | map1 f (Single a) = Single (f a) 214 | map1 f (Cons a b l) = Cons (f a) b (map1 f l) 215 | 216 | map2 :: (b -> c) -> AltList a b -> AltList a c 217 | map2 _ (Single a) = Single a 218 | map2 g (Cons a b l) = Cons a (g b) (map2 g l) 219 | 220 | iterateA :: (a -> b) -> (b -> a) -> a -> AltList a b 221 | iterateA f g a = Cons a b (iterateA f g (g b)) 222 | where b = f a 223 | 224 | takeWhileA :: (b -> Bool) -> AltList a b -> AltList a b 225 | takeWhileA _ (Single a) = Single a 226 | takeWhileA p (Cons a b l) 227 | | p b = Cons a b (takeWhileA p l) 228 | | otherwise = Single a 229 | 230 | foldA :: (a -> r) -> (a -> b -> r -> r) -> AltList a b -> r 231 | foldA f _ (Single a) = f a 232 | foldA f g (Cons a b l) = g a b (foldA f g l) 233 | 234 | ------------------------------------------------------------ 235 | -- Bijection complexes 236 | 237 | type BComplex = AltList Set Bij 238 | 239 | labelBC :: String -> BComplex -> BComplex 240 | labelBC = map2 . labelBij 241 | 242 | seqC :: BComplex -> Bij -> BComplex -> BComplex 243 | seqC = concatA 244 | 245 | parC :: BComplex -> BComplex -> BComplex 246 | parC = zipWithA (++) parBij 247 | 248 | drawBComplex :: BComplex -> Dia 249 | drawBComplex = centerX . drawBComplexR 0 250 | where 251 | drawBComplexR :: Int -> BComplex -> Dia 252 | drawBComplexR i (Single s) = i |> drawSet s 253 | drawBComplexR i (Cons ss bs c) = 254 | hcat 255 | [ i |> s1 256 | , strutX thisSep <> label 257 | , drawBComplexR (succ i) c 258 | ] 259 | # applyAll (map (drawABij i (map fst $ names s1)) bs) 260 | where 261 | s1 = drawSet ss 262 | thisSep = case bs of 263 | [] -> 0 264 | _ -> maximum . map (^. bijSep) $ bs 265 | label = (fromMaybe mempty . msum . reverse . map (^. bijLabel) $ bs) 266 | # (\d -> d # withEnvelope (strutY (height d) :: D R2)) 267 | # (\d -> translateY (-(height s1 + thisSep - height d)/2) d) 268 | 269 | drawABij :: Int -> [Name] -> ABij -> Dia -> Dia 270 | drawABij i ns b = applyAll (map conn . catMaybes . map (_2 id . (id &&& (b ^. bijData))) $ ns) 271 | where 272 | conn :: (Name,Name) -> Dia -> Dia 273 | conn (n1,n2) = withNames [i |> n1, (i+1) |> n2] $ \[s1,s2] -> atop (drawLine s1 s2 # applyStyle (sty n1)) 274 | sty = b ^. bijStyle 275 | drawLine sub1 sub2 = boundaryFrom sub1 v ~~ boundaryFrom sub2 (negateV v) 276 | where 277 | v = location sub2 .-. location sub1 278 | 279 | toNameI :: Int -> Name 280 | toNameI = toName 281 | 282 | toNamesI :: [Int] -> [Name] 283 | toNamesI = map toName 284 | 285 | plus, minus, equals :: Dia 286 | plus = hrule 1 <> vrule 1 287 | minus = hrule 1 288 | equals = hrule 1 === strutY 0.5 === hrule 1 289 | 290 | mapAName :: (Typeable a, Typeable b, Ord b, Show b) => (a -> b) -> AName -> AName 291 | mapAName f an@(AName x) = case cast x of 292 | Nothing -> an 293 | Just a -> AName (f a) 294 | 295 | mapName :: (Typeable a, Typeable b, Ord b, Show b) => (a -> b) -> Name -> Name 296 | mapName f (Name ns) = Name (map (mapAName f) ns) 297 | 298 | ------------------------------------------------------------ 299 | -- Computing orbits/coloration 300 | 301 | type Edge a = (a,a) 302 | 303 | type Relator a = (a,[a],a) 304 | 305 | mkRelator :: Edge a -> Relator a 306 | mkRelator (n1,n2) = (n1,[],n2) 307 | 308 | start :: Relator a -> a 309 | start (n,_,_) = n 310 | 311 | end :: Relator a -> a 312 | end (_,_,n) = n 313 | 314 | relatorToList :: Relator a -> [a] 315 | relatorToList (a,bs,c) = a : bs ++ [c] 316 | 317 | isTailOf :: Eq a => Relator a -> Relator a -> Bool 318 | isTailOf r1 r2 = relatorToList r1 `isSuffixOf` relatorToList r2 && r1 /= r2 319 | 320 | composeRelators :: Eq a => Relator a -> Relator a -> Maybe (Relator a) 321 | composeRelators (s1,ns1,e1) (s2,ns2,e2) 322 | | e1 == s2 = Just (s1,ns1++[e1]++ns2,e2) 323 | | otherwise = Nothing 324 | 325 | type Relation a = [Relator a] 326 | 327 | mkRelation :: [Edge a] -> Relation a 328 | mkRelation = map mkRelator 329 | 330 | emptyR :: Relation a 331 | emptyR = [] 332 | 333 | unionR :: Relation a -> Relation a -> Relation a 334 | unionR = (++) 335 | 336 | composeR :: Eq a => Relation a -> Relation a -> Relation a 337 | composeR rs1 rs2 = [ rel | rel1 <- rs1, rel2 <- rs2, Just rel <- [composeRelators rel1 rel2] ] 338 | 339 | orbits :: Eq a => Relation a -> Relation a -> Relation a 340 | orbits r1 r2 = removeTails $ orbits' r2 r1 r1 341 | where 342 | orbits' _ _ [] = [] 343 | orbits' r1 r2 r = done `unionR` orbits' r2 r1 (r' `composeR` r1) 344 | where 345 | (done, r') = partition finished r 346 | finished rel = (start rel == end rel) || all ((/= end rel) . start) r1 347 | removeTails rs = filter (\r -> not (any (r `isTailOf`) rs)) rs 348 | 349 | bijToRel :: Bij -> Relation Name 350 | bijToRel = foldr unionR emptyR . map bijToRel1 351 | where 352 | bijToRel1 bij = mkRelation . catMaybes . map (_2 id . (id &&& (bij^.bijData))) $ bij^.bijDomain 353 | 354 | orbitsToColorMap :: Ord a => [Colour Double] -> Relation a -> M.Map a (Colour Double) 355 | orbitsToColorMap colors orbs = M.fromList (concat $ zipWith (\rel c -> map (,c) rel) (map relatorToList orbs) (cycle colors)) 356 | 357 | colorBij :: M.Map Name (Colour Double) -> Bij -> Bij 358 | colorBij colors = map colorBij' 359 | where 360 | colorBij' bij = bij & bijStyle .~ \n -> maybe id lc (M.lookup n colors) ((bij ^. bijStyle) n) 361 | 362 | ------------------------------------------------------------ 363 | -- Example sets and bijections 364 | 365 | a0, b0, a1, b1 :: ASet 366 | a0 = nset 3 yellow 367 | b0 = nset 3 blue 368 | 369 | a1 = nset 2 green 370 | b1 = nset 2 red 371 | 372 | bc0, bc1, bc01 :: BComplex 373 | bc0 = [a0] .- bij0 -.. [b0] 374 | bc1 = [a1] .- bij1 -.. [b1] 375 | bc01 = [a0,a1] .- bij01 -.. [b0,b1] 376 | 377 | bij0, bij1 :: Bij 378 | bij0 = [mkABij a0 b0 ((`mod` 3) . succ . succ)] 379 | bij1 = [mkABij a1 b1 id] 380 | 381 | names01, names02 :: [Name] 382 | names01 = 'X' |> disjointly concat [head bij0^.bijDomain, head bij1^.bijDomain] 383 | names02 = 'Y' |> (('a' |@@ [1,2]) ++ ('b' |@@ [0,1]) ++ ('a' |@@ [0])) 384 | 385 | bij01 :: Bij 386 | bij01 = [] 387 | 388 | -------------------------------------------------------------------------------- /CompNotSymmTemp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | 3 | import Diagrams.Backend.Cairo.CmdLine 4 | import Diagrams.Prelude 5 | 6 | import Data.List (zip4) 7 | import SpeciesDiagrams 8 | 9 | dot = circle 0.8 # fc black 10 | 11 | enc = fc white . enclose 1 1 12 | 13 | newCyc :: Double -> [Diagram B R2] -> Diagram B R2 14 | newCyc r ds = position (zip posns (zipWith named [0 :: Int ..] ds)) <> circle r -- # markBorders 15 | where 16 | n = length ds 17 | triples = zip4 ([1 :: Int .. n-1] ++ [0]) 18 | posns (tail (cycle posns)) ((tail . tail) (cycle posns)) 19 | markBorders = withNames [0 :: Int .. n-1] $ \ss -> 20 | applyAll (map (mark2Borders ss) triples) 21 | mark2Borders ss (i,prev,cur,next) = id 22 | -- where 23 | -- pb = binarySearch 24 | posns :: [P2] 25 | posns 26 | | n == 1 = [0 ^& r] 27 | | otherwise = polygon (with & polyType .~ PolyRegular (length ds) r 28 | & polyOrient .~ NoOrient 29 | ) 30 | # rotateBy (1/4) 31 | 32 | cls = map (newCyc 2.5) ((map . map) (enc . drawList' (const dot) . flip replicate ()) [[1,1,1],[2,1],[3]]) 33 | 34 | lcs = map (drawList' id) ((map . map) (enc . newCyc 2 . flip replicate dot) [[1,1,1],[2,1],[1,2],[3]]) 35 | 36 | dia = 37 | hcat' (with & sep .~ 6) 38 | [ vcat' (with & sep .~ 3) cls # centerY 39 | , vcat' (with & sep .~ 3) lcs # centerY 40 | ] 41 | # frame 0.5 42 | # lwO 0.7 43 | 44 | main :: IO () 45 | main = defaultMain dia 46 | -------------------------------------------------------------------------------- /GraphViz.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE NoMonomorphismRestriction #-} 4 | 5 | module GraphViz where 6 | 7 | import Diagrams.Backend.Cairo.CmdLine 8 | import Diagrams.Prelude 9 | 10 | import SpeciesDiagrams (mlocColor) 11 | 12 | import Data.Graph.Inductive.Graph (Graph, Node, labEdges, 13 | labNodes) 14 | import Data.Graph.Inductive.PatriciaTree 15 | import Data.GraphViz 16 | import Data.GraphViz.Attributes.Complete (Attribute (Pos), Point (..), 17 | Pos (..)) 18 | import Data.GraphViz.Commands.IO (hGetDot) 19 | import Data.GraphViz.Types.Generalised (FromGeneralisedDot (..)) 20 | 21 | graphToDia :: (Int -> Diagram B R2) -> (Int -> Int -> Diagram B R2 -> Diagram B R2) -> Gr (AttributeNode nl) (AttributeNode el) -> Diagram B R2 22 | graphToDia dn de gr = drawNodes # drawEdges 23 | where 24 | nodes = labNodes gr 25 | edges = labEdges gr 26 | drawNodes = mconcat . map drawNode $ nodes 27 | drawEdges = applyAll . map drawEdge $ edges 28 | drawNode (n,(attrs,_)) = 29 | case [p | Pos (PointPos p) <- attrs] of 30 | [] -> mempty 31 | [pt] -> dn n # named n # moveTo (pointToP2 pt) 32 | -- it's actually using ellipses by default. Need to set input shape. 33 | -- I will just draw edges myself, using diagrams. 34 | drawEdge (n1,n2,_) = de n1 n2 35 | -- case [ss | Pos (SplinePos ss) <- attrs] of 36 | -- [] -> mempty 37 | -- [splines] -> mconcat . map drawSpline $ splines 38 | -- drawSpline (Spline { startPoint = s, endPoint = e, splinePoints = pts}) = 39 | -- (pointToP2 (head pts') ~~ (pointToP2 (last pts'))) -- FIXME. 40 | -- -- should be 41 | -- -- cubic 42 | -- -- B-spline. 43 | -- where 44 | -- pts' = maybeToList s ++ pts ++ maybeToList e 45 | 46 | pointToP2 (Point {xCoord = x, yCoord = y}) = (x ^& y) # scale (1/20) 47 | 48 | ------------------------------------------------ 49 | 50 | graphToGraph' :: (Ord cl, Graph gr) => GraphvizParams Node nl el cl l 51 | -> GraphvizCommand 52 | -> gr nl el 53 | -> IO (gr (AttributeNode nl) (AttributeEdge el)) 54 | graphToGraph' params com gr = dotAttributes' com (isDirected params) gr' dot 55 | where 56 | dot = graphToDot params' gr' 57 | params' = params { fmtEdge = setEdgeIDAttribute $ fmtEdge params } 58 | gr' = addEdgeIDs gr 59 | 60 | dotAttributes' :: (Graph gr, PPDotRepr dg Node, FromGeneralisedDot dg Node) 61 | => GraphvizCommand -> Bool -> gr nl (EdgeID el) 62 | -> dg Node -> IO (gr (AttributeNode nl) (AttributeEdge el)) 63 | dotAttributes' command isDir gr dot 64 | = augmentGraph gr . parseDG <$> graphvizWithHandle command dot DotOutput hGetDot 65 | where 66 | parseDG = (`asTypeOf` dot) . fromGeneralised 67 | -------------------------------------------------------------------------------- /HoTT-coends.txt: -------------------------------------------------------------------------------- 1 | consider the category whose objects are types and whose arrows are functions of the appropriate type (in HoTT). Does anyone have any references on constructing coends in this category? 2 | Sigma-types seem too strong. 3 | It's suggestive that being cocomplete is equivalent to having coproducts and pushouts, and pushouts can (I think) be constructed in that category using a HIT. 4 | so maybe we can define coends via some sort of HIT? Is it as simple as a Sigma-type paired with some path constructors corresponding to the commuting diagrams that define a coend? 5 | it should pretty much be a quotients of sigmas, yeah 6 | ok, thanks 7 | I also found this comment: http://math.andrej.com/2014/01/13/univalent-foundations-subsume-classical-mathematics/comment-page-1/#comment-34504 8 | (it mentions coends at the very end.) I found it cryptic the first time I read it but now it makes perfect sense. 9 | mh 10 | i guess there it's saying that sigma types are already coends, when we consider the domain type as a category in itself 11 | it's just that usual domain types are discrete, so it degenerates into a coproduct 12 | ah, right 13 | but i think you were considering another categorical view at the start 14 | was I? 15 | oh, I see, I think I was just being imprecise 16 | well, considering types as objects and functions as arrows is not the same as considering types as categories and functions as functors 17 | true. 18 | the precise way to look at it, I suppose, is that I want to build coends over functors T^op x T -> U, where T is some type considered as a category, and U is the category of types and functions 19 | which it seems to me is exactly the sort of coend under consideration in that comment I linked 20 | byorgey: by "category" in your original question do you mean an (infty,1)-category? 21 | or when you talk about U 22 | rwbarton: I think so, though to be honest I am not sure what the difference would be 23 | I only know about (infty,1)-categories via HoTT, I know nothing about them from the category theory side 24 | well, with an ordinary category (where hom-sets are sets) you can't capture much 25 | what set is the set of maps from the point to the circle? 26 | put differently, what does it mean for two maps f, g : * -> S^1 to be "the same" 27 | I don't have very good intuition for S^1 28 | rwbarton: If you have funtional extensionality, (* -> A) and A are equivalent types. So (* -> S^1) is equivalent to S^1. 29 | byorgey: i think you get the sufficient equalities from a sigma type, because really it's mostly the arrows in T that matter, from U you're going to use the equality anyway 30 | jgross_: Yes of course, but S^1 isn't a set 31 | rwbarton: The proof doesn't assume that A is a set. 32 | (Tangentially, does that actually require functional extensionality?) 33 | jgross_: but byorgey wants to make a category 34 | Well, I assume he actually doesn't want to make a category 35 | yes, it seems I do want (infty,1)-categories then. The real answer is that I want "whatever is the right thing to model the things I am trying to model ;)" 36 | OK 37 | Saizan: can you elaborate? I'm not sure I understand what you mean 38 | In that case, in the theory of (infty,1)-categories, what you want is a homotopy coend, which you can compute as the colimit of a simplicial object 39 | rwbarton: (Yes. You need it to show that the maps (* -> S^1) -> S^1 and S^1 -> (* -> S^1) are inverses, in particular in the (* -> S^1) -> S^1 -> (* -> S^1) direction, because otherwise you have no way prove that the function you start with and the function you end with are equal.) 40 | rwbarton: do you have a good reference for that? 41 | jgross_: So does that mean you also need it to show that (X x -) and (X -> -) are adjoint functors? (since (* x -) is unconditionally equivalent to the identity, right?) 42 | byorgey: Are you looking for directed homotopy type theory (which doesn't exist yet)? i.e., where types are interpreted as infinity-categories rather than infinity groupoids? Otherwise you need to define "category" internally. That is, your diagram isn't a thing of type Type, but a thing of type Category. 43 | byorgey: I can spell it out 44 | byorgey: i think rwbarton can do a better job :) 45 | jgross_: no, I don't think I want directed HoTT. 46 | Normally when you want to compute the coend of a functor F : T^op x T -> U, you start with the coproduct of all the objects F(a,a), right? 47 | right 48 | And then for each f : a -> b in T and each point of F(a,b), we have an identification between a point of F(a,a) and one of F(b,b) 49 | right 50 | rwbarton: You need it to show that (X * (X -> Y)) and Y are equivalent types. I think that means you need it for that adjunction, but I'm not entirely sure. 51 | byorgey: OK, so in a homotopy coend we have to keep going 52 | Suppose you have f : a -> b, g : b -> c and a point x of F(a,c) 53 | I can compose f and g to get a map a -> c, and that determines one of the identifications between F(a,a) and F(c,c) that I made in the previous step 54 | Er, I notice I have my indices backwards 55 | Let's pretend I said F : T x T^op -> U 56 | no worries =) 57 | I can also take my x : F(a,c) and use f to get an element of F(b,c) 58 | that element of F(b,c) plus g : b -> c give me an identification between F(b,b) and F(c,c) from the previous step 59 | similarly I can get use x and g to get an element of F(a,b), and use that and f to get an identification between F(a,a) and F(b,b) 60 | Now, I add a 2-cell 61 | (a : T , x : F(a,a)) = (b : T , y : F(b,b)) <=> exists (f : T(a,b)), F(id,f)(x) = F(f,id)(y) -- that's the identification, right? 62 | right, so let's pick a notation for that equality constructor that was introduced by "And then for each f : a -> b in T and each point of F(a,b), we have an identification between a point of F(a,a) and one of F(b,b)" 63 | Saizan: wait, not quite 64 | (a : T , x : F(a,a)) = (b : T , y : F(b,b)) <=> exists (f : T(a,b), z : F(a,b)), F(id,f)(z) = x /\ F(f,id)(z) = y 65 | makes sense 66 | In other words for every f : T(a,b), z : F(a,b), I create a constructor [f,z] : F(id,f)(z) = F(f,id)(z) 67 | that's how you compute the ordinary coend 68 | right 69 | but for a homotopy coend, you continue as I was explaining. so in the situation where you have f : a -> b, g : b -> c, z : F(a,c), you also add a 2-cell from [gf,z] to the composition of [f,F(id,g)z] and [g,F(f,id)z] 70 | (If I got all the orderings right, which I probably didn't) 71 | oh, I see 72 | I suppose the next step is "and so on" =) 73 | and you continue like this, for strings of arbitrary length a1 -> a2 -> ... -> an 74 | right 75 | BUT it seems in HoTT that sometimes you can sidestep this kind of iterative/simplicial construction with a carefully chosen HIT; but I don't know if there is any way to do so in this case. 76 | interesting. 77 | rwbarton: if we are in HoTT and consider T(a,b) = a =_T b, does that make Sigma T (\a -> F a a) the coend of F? 78 | I feel like that's some magical part of the theory which I don't understand at all yet. 79 | mh, i guess contravariance is not that easy to talk about 80 | rwbarton: are you referring to your previous comment, or to Saizan's question? 81 | well, otoh, they are groupoids so selfdual 82 | My previous comment 83 | Saizan: if the index category is a groupoid then there should be some simple formula for the coend already in homotopy theory 84 | rwbarton: hmm, can you elaborate? 85 | rwbarton: If the index category is not a(n) (infinity-)groupoid, then you can't make the coend in HoTT, you need directed HoTT. 86 | Or use an internal notion of category for the index 87 | as you suggested before -- I expect that's what byorgey wanted 88 | actually, in my case the index category will always be a(n) (infinity-)groupoid 89 | Oh, right 90 | or rather, I have some freedom in choosing the properties of the index category, and this sounds like a good reason for requiring a groupoid. 91 | Hmm 92 | Let me think a bit, and get back to you on that 93 | ok, thanks 94 | I should go get some lunch anyway 95 | mh, if U is the category of types and functions then your action on morphisms is something like b = a -> c = d -> F a c -> F b d? 96 | from the sigma you get (a : T , x : F(a,a)) = (b : T , y : F(b,b)) <=> exists p : a = b, transport (\ a -> F a a) p x = y 97 | Saizan: which agrees with the coend I think 98 | since the index category is a groupoid, what I called "z" is determined by "x" and "f" (or "p") 99 | or let's say "y" and "f" 100 | Pick z so that F(f,id)(z) = y; so z = F(f^-1,id)(y); then my condition was F(id,f)(F(f^-1,id)(y)) = y 101 | and that should agree with your transport (\ a -> F a a) p 102 | unless F(p,q) does more than transporting? 103 | well, I'm not sure in what framework one could make this precise, but there should be a correspondence between functors T^op x T -> U, where T is the path (infinity-)groupoid of the space also denoted T, and functions T x T -> U 104 | the correspondence being given in the reverse direction by "transport" 105 | So given a functor T^op x T -> U, you have to massage it into the form of a function T x T -> U, and then form the Sigma-type 106 | with U still the category of types and functions, or the inf-groupoid of types and equivalences? 107 | Oh, well since T^op x T is a groupoid, the functor can only carry morphisms to equivalences anyways 108 | So in the phrase "a functor T^op x T -> U", it doesn't matter 109 | in the phrase "T x T -> U", I just mean U = Type 110 | nice :) 111 | many thanks for this enlightening discussion =) 112 | -------------------------------------------------------------------------------- /Inkcov.hs: -------------------------------------------------------------------------------- 1 | -- First, generate inkcov.txt using 2 | -- 3 | -- gs -o - -sDEVICE=inkcov Yorgey-thesis-final-2014-11-14.pdf > inkcov.txt 4 | -- 5 | -- which I got here: 6 | -- 7 | -- http://tex.stackexchange.com/a/61216 8 | -- 9 | -- This script then processes the generated data into a more useful format. 10 | -- 11 | -- To split out just the pages with color or with B&W, take one of the 12 | -- generated lists of page numbers, e.g. save it in a file 13 | -- colorpages.txt, and then do something like 14 | -- 15 | -- pdftk thesis.pdf cat `cat colorpages.txt` output thesis-COLOR.pdf 16 | 17 | import Data.List 18 | import Data.List.Split 19 | 20 | data Ink = Color | Gray 21 | deriving (Show) 22 | 23 | data Page = Page { pageNum :: Int, pageColor :: Ink } 24 | 25 | printPage :: Page -> String 26 | printPage (Page n ink) = show n ++ ": " ++ show ink 27 | 28 | isColor (Page _ Color) = True 29 | isColor _ = False 30 | 31 | main :: IO () 32 | main = do 33 | inkcov <- readFile "inkcov.txt" 34 | let pages = map (head . tail) . chunksOf 2 . drop 4 . lines $ inkcov 35 | pages' = zipWith processPage [1..] pages 36 | putStr . unlines . map printPage $ pages' 37 | let (colors, grays) = partition isColor pages' 38 | putStrLn "Gray pages:" 39 | putStrLn . unwords . map (show . pageNum) $ grays 40 | putStrLn "Color pages:" 41 | putStrLn . unwords . map (show . pageNum) $ colors 42 | 43 | processPage :: Int -> String -> Page 44 | processPage n dat 45 | | " 0.00000 0.00000 0.00000" `isPrefixOf` dat = Page n Gray 46 | | otherwise = Page n Color 47 | -------------------------------------------------------------------------------- /KanExtensions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | 4 | module KanExtensions where 5 | 6 | data Lan f x a where 7 | Lan :: (x c, f c -> a) -> Lan f x a 8 | 9 | -- one direction of the Yoneda lemma 10 | yonedaR :: (forall a. (c -> a) -> f a) -> f c 11 | yonedaR y = y id 12 | 13 | yonedaL :: Functor f => f c -> (forall a. (c -> a) -> f a) 14 | yonedaL f g = fmap g f 15 | 16 | -- hom(-,a) turns colimits into limits 17 | homL1 :: (forall a. Lan f x a -> g a) -> (forall a c. (x c, f c -> a) -> g a) 18 | homL1 l (xa,fca) = l (Lan (xa, fca)) 19 | 20 | homL2 :: (forall a c. (x c, f c -> a) -> g a) -> (forall a. Lan f x a -> g a) 21 | homL2 g (Lan (xc, fca)) = g (xc, fca) 22 | 23 | -- apply the Yoneda lemma on the RHS of the hom 24 | step3R :: (forall c. x c -> (forall a. (f c -> a) -> g a)) -> (forall c. x c -> g (f c)) 25 | step3R f x = yonedaR (f x) 26 | 27 | step3L :: Functor g => (forall c. x c -> g (f c)) -> (forall c. x c -> (forall a. (f c -> a) -> g a)) 28 | step3L g x = yonedaL (g x) 29 | 30 | lanAdjointR :: (forall a. Lan f x a -> g a) -> (forall c. x c -> g (f c)) 31 | lanAdjointR l = step3R (curry (homL1 l)) -- fmap yoneda (curry (homL l . swap)) 32 | 33 | {- 34 | step3 (curry (homL l)) x 35 | = yoneda (curry (homL l) x) 36 | = yoneda (curry (\(xa,fca) -> l (Lan xa fca)) x) 37 | = yoneda ((\xa fca -> l (Lan xa fca)) x) 38 | = yoneda (\fca -> l (Lan x fca)) 39 | = yoneda (l . Lan x) 40 | = (l . Lan x) id 41 | = l (Lan x id) 42 | 43 | In the particular case of species, we transform a polymorphic 44 | function l into a species morphism \x -> l (Lan x id). 45 | 46 | Hmm, I don't quite get it. Let's do the other direction. 47 | -} 48 | 49 | -- lanAdjointL :: Functor g => (forall c. x c -> g (f c)) -> (forall a. Lan f x a -> g a) 50 | -- lanAdjointL g = homL2 (uncurry (step3L g)) 51 | 52 | lanAdjoint :: Functor g => (forall c. f c -> g (j c)) -> (forall a. Lan j f a -> g a) 53 | lanAdjoint g = homL (uncurry (yoneda' g)) 54 | where 55 | homL :: (forall a c. (f c, j c -> a) -> g a) -> (forall a. Lan j f a -> g a) 56 | homL h (Lan (fc, jc_a)) = h (fc, jc_a) 57 | 58 | yoneda' :: Functor g => (forall c. f c -> g (j c)) -> (forall c. f c -> (forall a. (j c -> a) -> g a)) 59 | yoneda' h fc = yoneda (h fc) 60 | 61 | yoneda :: Functor f => f c -> (forall a. (c -> a) -> f a) 62 | yoneda fc h = fmap h fc 63 | 64 | 65 | {- 66 | 67 | homL2 (uncurry (step3L g)) (Lan sp m) 68 | = uncurry (step3L g) (sp, m) 69 | = step3L g sp m 70 | = yonedaL (g sp) m 71 | = fmap m (g sp) 72 | 73 | Here, we transform a species morphism g : F -> G.i into a 74 | polymorphic function F^ -> G. In particular, a value of type F^ A 75 | consists of an L-labelled F-shape together with a mapping L -> A; we 76 | apply g to the F-shape, resulting in an L-labelled G.i-shape; we then 77 | map the L->A mapping over this to get a G A value. 78 | 79 | I think this is the interesting direction. The point is that *every* 80 | polymorphic function on F^ A arises in this way. I.e. every 81 | polymorphic function has to be described by a process of splitting 82 | into shape + data mapping, reshaping, and then re-applying the 83 | labelling. 84 | 85 | How is this more restrictive than just any old polymorphic function? 86 | Note, it does depend on F. The point is that for certain functors H 87 | (the ones that arise as H = F^ for some species F), *all* polymorphic 88 | functions arise in this way. It is probably the case that all Haskell 89 | functors are analytic. So we have to be a bit more creative to come 90 | up with examples of non-analytic functors, which have map-commuting 91 | polymorphic functions on them which cannot be decomposed in this way. 92 | Well, I suppose it's not so much the *maps* that can't be decomposed 93 | but the functors themselves. 94 | 95 | Should Google for "non-analytic functor" and see what comes up. Also, 96 | read more about analytic functors in general, the way they decompose 97 | into generating functions, etc. 98 | 99 | Refer to Barry Jay's work here? 100 | 101 | -} 102 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Since I believe in open research, I'm writing my thesis here in 2 | public. Feel free to comment, ask questions, point out typos, chide 3 | me for not working faster, *etc.* 4 | 5 | You can find an [auto-updated build of the current PDF here](http://www.cis.upenn.edu/~byorgey/hosted/thesis.pdf). 6 | 7 | Time spent on my thesis: 8 | 9 | [![](https://www.beeminder.com/byorgey/goals/thesis/graph)](http://www.beeminder.com/byorgey/goals/thesis) 10 | 11 | Page count: 12 | 13 | [![](https://www.beeminder.com/byorgey/goals/pages/graph)](http://www.beeminder.com/byorgey/goals/pages) 14 | -------------------------------------------------------------------------------- /Shake.hs: -------------------------------------------------------------------------------- 1 | import Control.Applicative (liftA2, (<$>)) 2 | import Control.Monad (when) 3 | import Data.Char (isSpace) 4 | import Data.List (isPrefixOf) 5 | import Data.List.Split 6 | import Development.Shake 7 | import Development.Shake.FilePath 8 | 9 | lhs2TeX = "lhs2TeX" 10 | pdflatex = "pdflatex" 11 | rubber = "rubber" 12 | bibtex = "bibtex" 13 | 14 | main = shake shakeOptions $ do 15 | 16 | want ["thesis.pdf"] 17 | 18 | "*.tex" *> \output -> do 19 | let input = replaceExtension output "lhs" 20 | e <- doesFileExist input 21 | when e $ do 22 | need [input] 23 | cmd "lhs2TeX --poly -o" [output] [input] 24 | 25 | "*.pdf" *> \output -> do 26 | let input = replaceExtension output "tex" 27 | includes <- map extractArg . filter isInclude <$> readFileLines input 28 | need (map (<.> "tex") includes) 29 | 30 | pkgs <- getDirectoryFiles "" ["*.sty"] 31 | need pkgs 32 | 33 | () <- cmd [pdflatex] "--enable-write18" [input] 34 | () <- cmd [pdflatex] "--enable-write18" [input] 35 | () <- cmd [bibtex] [dropExtension input] 36 | () <- cmd [pdflatex] "--enable-write18" [input] 37 | return () 38 | 39 | isInclude = liftA2 (||) ("\\include" `isPrefixOf`) ("\\input" `isPrefixOf`) . dropWhile isSpace 40 | 41 | extractArg = (!!1) . splitOneOf "{}" 42 | -------------------------------------------------------------------------------- /SpeciesDiagrams.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE NoMonomorphismRestriction #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | {-# LANGUAGE TypeSynonymInstances #-} 8 | 9 | module SpeciesDiagrams where 10 | 11 | import Control.Arrow (first, second) 12 | import Control.Lens (_head, _last) 13 | import Data.Colour.Palette.BrewerSet 14 | import Data.List (intersperse, permutations) 15 | import Data.List.Split 16 | import qualified Data.Map as M 17 | import Data.Maybe (fromJust, fromMaybe) 18 | import Data.Tree 19 | import Diagrams.Backend.Cairo.CmdLine 20 | import Diagrams.Core.Points 21 | import Diagrams.Prelude 22 | import Diagrams.TwoD.Layout.Tree 23 | import Graphics.SVGFonts.ReadFont 24 | import qualified Math.Combinatorics.Multiset as MS 25 | 26 | colors :: [Colour Double] 27 | colors = brewerSet Set1 9 28 | 29 | labR, arrowGap :: Double 30 | labR = 0.3 31 | arrowGap = 0.2 32 | 33 | aLabels :: [Diagram B R2] 34 | aLabels = map (sized (Dims (4*labR) (4*labR))) 35 | [ circle 1 36 | , triangle 1 37 | , square 1 38 | , pentagon 1 39 | , rect 1 1.618 40 | , rect 1.618 1 41 | , circle 1 # scaleX 1.618 42 | , circle 1 # scaleY 1.618 43 | ] 44 | 45 | type EdgeLabel = P2 -> P2 -> Diagram B R2 46 | 47 | sLabels :: [EdgeLabel] 48 | sLabels = 49 | [ connStyle mempty 50 | , connStyle $ (mempty # lw veryThick) 51 | , connStyle $ (mempty # dashingG [0.1,0.1] 0) 52 | , connStyle $ (mempty # dashingG [0.05,0.15] 0) 53 | , connStyle $ (mempty # dashingG [0.05,0.05,0.1,0.05] 0) 54 | , \p q -> let v = 0.03 *^ normalized (perp (q .-. p)) 55 | in ((p .+^ v) ~~ (q .+^ v)) <> ((p .-^ v) ~~ (q .-^ v)) 56 | ] 57 | where 58 | connStyle sty p q = (p ~~ q) # applyStyle sty 59 | perp = rotateBy (1/4) 60 | 61 | labSty :: Int -> Maybe EdgeLabel 62 | labSty i = Just (sLabels !! i) 63 | 64 | leafData :: Int -> Diagram B R2 65 | leafData i = (aLabels !! i) # sized (Dims labR labR) # fc black <> square (labR*1.5) # fc white 66 | 67 | text' :: Double -> String -> Diagram B R2 68 | text' d s = (stroke $ textSVG' (TextOpts s lin INSIDE_H KERN False d d)) # fc black # lw none 69 | 70 | labT :: Int -> Diagram B R2 71 | labT n = text' 1.5 (show n) # scale labR <> lab n 72 | 73 | lab :: Int -> Diagram B R2 74 | lab n = lab' (colors !! n) 75 | 76 | lab' :: (TrailLike b, Transformable b, HasStyle b, V b ~ R2) => Colour Double -> b 77 | lab' c = circle labR 78 | # fc white 79 | # lc c 80 | # lwG (labR / 5) 81 | 82 | cyc :: [Int] -> Double -> Diagram B R2 83 | cyc labs r = cyc' (map lab labs) r 84 | 85 | cyc' :: (Monoid' a, TrailLike a, Transformable a, HasStyle a, HasOrigin a, V a ~ R2) => [a] -> Double -> a 86 | cyc' labs r 87 | = mconcat 88 | . zipWith (\l (p,a) -> l # moveTo p <> a) labs 89 | $ zipWith rotateBy 90 | [1/4, 1/4 + 1/(fromIntegral n) .. ] 91 | (map mkLink labs) 92 | where 93 | n = length labs 94 | mkLink _ = ( origin # translateX r 95 | , 96 | ( arc startAngle endAngle 97 | # scale r 98 | <> 99 | eqTriangle 0.1 100 | # translateX r 101 | # rotate endAngle 102 | # fc black 103 | ) 104 | ) 105 | startAngle = (labR + arrowGap)/r @@ rad 106 | endAngle = (tau/fromIntegral n @@ rad) ^-^ startAngle 107 | 108 | 109 | newtype Cyc a = Cyc {getCyc :: [a]} 110 | deriving Functor 111 | 112 | data Pointed a = Plain a | Pointed a 113 | 114 | class Drawable d where 115 | draw :: d -> Diagram B R2 116 | 117 | instance Drawable (Diagram B R2) where 118 | draw = id 119 | 120 | instance Drawable a => Drawable (Cyc a) where 121 | draw (Cyc ls) = cyc' (map draw ls # sized (Width (labR*2))) 1 122 | 123 | instance Drawable a => Drawable [a] where 124 | draw ls = centerX . hcat' (with & sep .~ 0.1) 125 | $ intersperse (mkArrow 0.5 mempty) (map draw ls) 126 | 127 | instance Drawable a => Drawable (Pointed a) where 128 | draw (Plain a) = draw a 129 | draw (Pointed a) = point (draw a) 130 | 131 | point :: Diagram B R2 -> Diagram B R2 132 | point d = d <> drawSpN Hole # sizedAs (d # scale 5) 133 | 134 | down :: Cyc (Diagram B R2) -> Cyc (Cyc (Pointed (Diagram B R2))) 135 | 136 | down (Cyc ls) = Cyc (map Cyc (pointings ls)) 137 | 138 | pointings :: [a] -> [[Pointed a]] 139 | pointings [] = [] 140 | pointings (x:xs) = (Pointed x : map Plain xs) : map (Plain x :) (pointings xs) 141 | 142 | elimArrow :: Diagram B R2 143 | elimArrow = hrule 2 144 | ||| eqTriangle 0.2 # rotateBy (-1/4) # fc black 145 | 146 | mkArrow :: Double -> Diagram B R2 -> Diagram B R2 147 | mkArrow len l = 148 | ( l 149 | === 150 | (arrow len # translateX (-len/2) <> rect len 0.5 # lw none) 151 | ) 152 | # alignB 153 | 154 | data SpN = Lab (Either Int String) 155 | | Leaf (Maybe (Diagram B R2)) 156 | | Hole 157 | | Point 158 | | Sp (Diagram B R2) Angle 159 | | Bag 160 | 161 | type SpT = Tree (Maybe EdgeLabel, SpN) 162 | 163 | drawSpT' :: T2 -> SymmLayoutOpts (Maybe EdgeLabel, SpN) -> SpT -> Diagram B R2 164 | drawSpT' tr slopts 165 | = transform tr 166 | . renderTree' (drawSpN' (inv tr) . snd) drawSpE 167 | . symmLayout' slopts 168 | 169 | drawSpT :: SpT -> Diagram B R2 170 | drawSpT = drawSpT' (rotation (1/4 @@ turn)) 171 | (with & slHSep .~ 0.5 & slVSep .~ 2 & slWidth .~ slw) 172 | where 173 | slw (_, Leaf (Just d)) = (-width d/2, width d/2) 174 | slw (_, sp@(Sp _ _)) = let w = width (drawSpN' (rotation (1/4 @@ turn)) sp) 175 | in (-w/2, w/2) 176 | slw _ = (0,0) 177 | 178 | drawSpN' :: Transformation R2 -> SpN -> Diagram B R2 179 | drawSpN' _ (Lab (Left n)) = lab n # scale 0.5 180 | drawSpN' tr (Lab (Right t)) = (drawSpN' tr (Leaf Nothing) ||| strutX (labR/2) ||| text' 0.3 t) # transform tr 181 | drawSpN' _ (Leaf Nothing) = circle (labR/2) # fc black 182 | drawSpN' _ (Leaf (Just d)) = d 183 | drawSpN' _ Hole = circle (labR/2) # lwG (labR / 10) # fc white 184 | drawSpN' tr Point = drawSpN' tr (Leaf Nothing) <> drawSpN' tr Hole # scale 1.7 185 | drawSpN' tr (Sp s f) = ( arc ((3/4 @@ turn) ^-^ f^/2) ((3/4 @@ turn) ^+^ f^/2) # scale 0.3 186 | ||| 187 | strutX 0.1 188 | ||| 189 | s # transform tr 190 | ) 191 | drawSpN' _ Bag = 192 | ( text' 1 "{" # scale 0.5 ||| strutX (labR/4) 193 | ||| circle (labR/2) # fc black 194 | ||| strutX (labR/4) ||| text' 1 "}" # scale 0.5 195 | ) # centerX 196 | 197 | drawSpN :: SpN -> Diagram B R2 198 | drawSpN = drawSpN' mempty 199 | 200 | drawSpE :: (t, P2) -> ((Maybe EdgeLabel, SpN), P2) -> Diagram B R2 201 | drawSpE (_,p) ((_,Hole),q) = (p ~~ q) # dashingG [0.05,0.05] 0 202 | drawSpE (_,p) ((Just f,_), q) = f p q 203 | drawSpE (_,p) (_,q) = p ~~ q 204 | 205 | nd :: Diagram B R2 -> Forest (Maybe EdgeLabel, SpN) -> SpT 206 | nd x = Node (Nothing, Sp x (1/3 @@ turn)) 207 | 208 | nd' :: EdgeLabel -> Diagram B R2 -> Forest (Maybe EdgeLabel, SpN) -> SpT 209 | nd' l x = Node (Just l, Sp x (1/3 @@ turn)) 210 | 211 | lf :: a -> Tree (Maybe EdgeLabel, a) 212 | lf x = Node (Nothing, x) [] 213 | 214 | lf' :: EdgeLabel -> a -> Tree (Maybe EdgeLabel, a) 215 | lf' l x = Node (Just l, x) [] 216 | 217 | struct :: Int -> String -> Diagram B R2 218 | struct n x = drawSpT (struct' n x) 219 | # centerXY 220 | 221 | struct' :: Int -> String -> SpT 222 | struct' n x = struct'' n (text' 1 x <> rect 2 1 # lw none) 223 | 224 | struct'' :: Int -> Diagram B R2 -> SpT 225 | struct'' n d = nd d (replicate n (lf (Leaf Nothing))) 226 | 227 | linOrd :: [Int] -> Diagram B R2 228 | linOrd ls = 229 | connect' (with & arrowHead .~ noHead) "head" "last" 230 | . hcat' (with & sep .~ 0.5) 231 | $ map labT ls & _head %~ named "head" & _last %~ named "last" 232 | 233 | unord :: (Monoid' b, Semigroup b, TrailLike b, Alignable b, Transformable b, HasStyle b, Juxtaposable b, HasOrigin b, Enveloped b, V b ~ R2) => [b] -> b 234 | unord [] = circle 1 # lc gray 235 | unord ds = elts # centerXY 236 | <> roundedRect w (mh + s*2) ((mh + s*2) / 5) 237 | where 238 | elts = hcat' (with & sep .~ s) ds 239 | mw = maximum' 0 . map width $ ds 240 | s = mw * 0.5 241 | mh = maximum' 0 . map height $ ds 242 | w = ((fromIntegral (length ds + 1) * s) +) . sum . map width $ ds 243 | maximum' d [] = d 244 | maximum' _ xs = maximum xs 245 | 246 | enRect' :: (Semigroup a, TrailLike a, Alignable a, Enveloped a, HasOrigin a, V a ~ R2) => Double -> a -> a 247 | enRect' o d = roundedRect (w+o) (h+o) o <> d # centerXY 248 | where (w,h) = size2D d 249 | 250 | enRect :: (Semigroup a, TrailLike a, Alignable a, Enveloped a, HasOrigin a, V a ~ R2) => a -> a 251 | enRect = enRect' 0.5 252 | 253 | txt x = text x # fontSizeO 10 <> square 1 # lw none 254 | 255 | ------------------------------------------------------------ 256 | -- Some specific constructions 257 | 258 | mlocColor = blend 0.5 white lightblue 259 | eltColor = blend 0.5 white lightgreen 260 | 261 | mloc m = text (show m) <> circle 0.8 # fc mlocColor 262 | elt x = text (show x) <> square 1.6 # fc eltColor 263 | 264 | arm typ m n r = ( typ m # rotateBy (-r) 265 | ||| hrule 1.5 266 | ||| typ n # rotateBy (-r) 267 | ) 268 | # translateX 3 269 | # rotateBy r 270 | 271 | arms typ elts = zipWith (\[e1,e2] r -> arm typ e1 e2 r) (chunksOf 2 elts) [1/8 + 0.001, 1/8+0.001 +1/4 .. 1] 272 | 273 | octo' typ elts = (mconcat (arms typ elts) <> circle 3) 274 | 275 | octo = octo' mloc 276 | 277 | sampleT7 = Node 3 [Node 4 (map lf [2,1,6]), Node 5 [], Node 0 [lf 7]] 278 | where 279 | lf x = Node x [] 280 | 281 | tree :: Diagram B R2 282 | tree = renderTree 283 | mloc 284 | (~~) 285 | (symmLayout' (with & slHSep .~ 4 & slVSep .~ 4) sampleT7) 286 | 287 | drawBinTree' :: SymmLayoutOpts (Diagram B R2) -> BTree (Diagram B R2) -> Diagram B R2 288 | drawBinTree' opts 289 | = maybe mempty (renderTree id (~~)) 290 | . symmLayoutBin' opts 291 | 292 | drawBinTree :: BTree (Diagram B R2) -> Diagram B R2 293 | drawBinTree = drawBinTree' with 294 | 295 | drawBinTreeWide :: BTree (Diagram B R2) -> Diagram B R2 296 | drawBinTreeWide = drawBinTree' (with & slHSep .~ 1.5) 297 | 298 | select :: [a] -> [(a,[a])] 299 | select [] = [] 300 | select (a:as) = (a,as) : (map . second) (a:) (select as) 301 | 302 | subsets :: [a] -> [([a],[a])] 303 | subsets [] = [([],[])] 304 | subsets (a:as) = (map . first) (a:) s ++ (map . second) (a:) s 305 | where s = subsets as 306 | 307 | type Edge = (Int,Int) 308 | type Graph = (M.Map Int P2, [Edge]) 309 | 310 | drawGraph drawLoc (locs, edges) = drawLocs <> drawEdges 311 | where 312 | drawLocs = mconcat . map (\(n,p) -> drawLoc n # moveTo p) . M.assocs $ locs 313 | drawEdges = mconcat . map drawEdge $ edges 314 | drawEdge (i1,i2) = lkup i1 ~~ lkup i2 315 | lkup i = fromMaybe origin $ M.lookup i locs 316 | 317 | gr :: Diagram B R2 318 | gr = drawGraph mloc 319 | ( M.fromList 320 | [ (0, 3 ^& (-1)) 321 | , (1, 8 ^& 0) 322 | , (2, origin) 323 | , (3, 8 ^& 2) 324 | , (4, 4 ^& 2) 325 | , (5, 3 ^& (-3)) 326 | ] # scale 1.5 327 | , [(2,0), (2,4), (0,4), (4,3), (3,1), (0,1), (0,5)] 328 | ) 329 | 330 | -------------------------------------------------- 331 | 332 | sampleBTree5, sampleBTree7 :: BTree Int 333 | sampleBTree5 = (BNode (0 :: Int) (BNode 1 Empty Empty) (BNode 2 (BNode 3 Empty Empty) (BNode 4 Empty Empty))) 334 | sampleBTree7 = (BNode (0 :: Int) (BNode 1 (BNode 2 Empty (BNode 3 Empty Empty)) Empty) (BNode 4 (BNode 5 Empty Empty) (BNode 6 Empty Empty))) 335 | 336 | 337 | wideTree 338 | :: (Monoid m, Semigroup m, TrailLike (QDiagram b R2 m)) 339 | => (a -> QDiagram b R2 m) -> BTree a -> QDiagram b R2 m 340 | wideTree n 341 | = maybe mempty (renderTree n (~~)) 342 | . symmLayoutBin' (with & slVSep .~ 4 & slHSep .~ 6) 343 | 344 | mkLeaf 345 | :: ( Semigroup m, IsName n ) 346 | => QDiagram b R2 m -> n -> QDiagram b R2 m 347 | mkLeaf shp n = shp # fc white # named n 348 | 349 | numbered :: Show a => a -> Diagram B R2 350 | numbered n = mkLeaf (text (show n) # fc black <> circle 1) () 351 | 352 | lettered :: Int -> Diagram B R2 353 | lettered n = mkLeaf (text [['a' ..] !! n] # fc black <> circle 1) () 354 | 355 | drawList nd n = drawList' nd [0::Int .. (n - 1)] 356 | 357 | drawList' nd ns = lst # centerX `atop` hrule (width lst - w) 358 | where 359 | elts = map nd ns 360 | w = maximum . map width $ elts 361 | lst = hcat' (with & sep .~ w/2) elts 362 | 363 | enumTrees :: [a] -> [BTree a] 364 | enumTrees [] = [ Empty ] 365 | enumTrees xxs = [ BNode x l r 366 | | (x,xs) <- select xxs 367 | , (ys, zs) <- subsets xs 368 | , l <- enumTrees ys 369 | , r <- enumTrees zs 370 | ] 371 | 372 | tag :: Int -> Diagram B R2 -> Diagram B R2 373 | tag i d = d # centerXY <> roundedRect w h r # applyStyle (tagStyles !! i) 374 | where 375 | w = width d + 1 376 | h = height d + 1 377 | r = 0.5 378 | 379 | 380 | tagStyles :: [Style R2] 381 | tagStyles = cycle 382 | [ mempty 383 | , mempty # lw veryThick # lc green 384 | , mempty # lw veryThick # lc green # dashingG [0.1,0.1] 0 385 | ] 386 | 387 | -------------------------------------------------- 388 | 389 | enclose :: Double -> Double -> Diagram B R2 -> Diagram B R2 390 | enclose g r d = d # centerXY <> roundedRect (width d + g) (height d + g) r 391 | 392 | objs :: IsName n => [n] -> Diagram B R2 393 | objs = enclose 1 1 . vcat' (with & sep .~ 1.5) . (map (\n -> dot # named n)) 394 | where 395 | dot = circle 0.1 # fc black 396 | 397 | -------------------------------------------------- 398 | -- Partial bijections 399 | 400 | data PBij a b where 401 | PBij :: [a] -> (a -> b) -> PBij a b 402 | 403 | applyPBij :: PBij a b -> (a -> b) 404 | applyPBij (PBij _ f) = f 405 | 406 | pbComp :: PBij b c -> PBij a b -> PBij a c 407 | pbComp (PBij _ f) (PBij as g) = PBij as (f . g) 408 | 409 | fromRel :: Eq a => [(a,b)] -> PBij a b 410 | fromRel rs = PBij (map fst rs) (fromJust . flip lookup rs) 411 | 412 | drawPBij :: (IsName a, IsName b) => PBij a b -> Diagram B R2 -> Diagram B R2 413 | drawPBij (PBij as f) = applyAll [ conn a (f a) | a <- as ] 414 | where 415 | conn x y = connect' pBijAOpts x y 416 | 417 | pBijAOpts = with & arrowTail .~ spike' & gaps .~ Local 0.3 & lengths .~ Local 0.3 418 | 419 | mkSet = mkSet' (const dot) 420 | where 421 | dot = circle 0.2 # fc black 422 | 423 | mkSet' dn names 424 | = enclose 0.5 1 425 | . vcat' (with & sep .~ 0.5) 426 | . zipWith named names 427 | . map dn 428 | $ names 429 | 430 | 431 | 432 | pb1 :: PBij Int Char 433 | pb1 = fromRel 434 | [ (0, 'd') 435 | , (1, 'a') 436 | , (2, 'b') 437 | , (3, 'e') 438 | ] 439 | 440 | pb2 :: PBij Int Int 441 | pb2 = fromRel [ (100, 3), (101, 2) ] 442 | 443 | ------------------------------------------------------------------------ 444 | 445 | parts :: [a] -> [[[a]]] 446 | parts = map (map MS.toList . MS.toList) . MS.partitions . MS.fromDistinctList 447 | 448 | cycles [] = [] 449 | cycles (x:xs) = map (x:) (permutations xs) 450 | 451 | perms :: [a] -> [[[a]]] 452 | perms = concatMap (mapM cycles) . parts 453 | 454 | drawPerm = hcat' (with & sep .~ 0.2) . map ((\l -> cyc' l 0.8) . map labT) 455 | 456 | smallHoleNode = circle labR # fc white # dashingL [0.05,0.05] 0 457 | holeNode = (circle 0.8 # fc white # dashingL [0.1,0.1] 0) 458 | 459 | fun x y = hcat' (with & sep .~ 1) 460 | [ x # centerY 461 | , arrow 3 462 | , y # centerY 463 | ] 464 | -------------------------------------------------------------------------------- /Structures.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | module Structures where 5 | 6 | import Diagrams.Backend.Cairo 7 | import Diagrams.Prelude 8 | import Diagrams.TwoD.Layout.Tree 9 | import Graphics.SVGFonts 10 | 11 | import Control.Applicative ((<|>)) 12 | import Control.Arrow (second) 13 | import Control.Lens (makeLenses, (^.)) 14 | import Data.Default.Class 15 | import Data.List (genericLength, mapAccumL, nub) 16 | import qualified Data.Map as M 17 | import Data.Tree 18 | import Physics.ForceLayout 19 | import Text.Parsec (between, char, many, runParser) 20 | import Text.Parsec.String (Parser) 21 | 22 | type DC = Diagram Cairo R2 23 | 24 | nil :: DC 25 | nil = square 1 # fc black 26 | 27 | dot :: DC 28 | dot = circle 0.8 # fc (blend 0.5 white lightblue) 29 | 30 | list :: Int -> DC 31 | list 0 = square 1 # fc black 32 | list n = dots <> rule 33 | where 34 | dots = hcat' (with & sep .~ 2) (replicate n dot) 35 | rule = hrule (width dots) # translateXTo dots 36 | 37 | translateXTo ref mv = alignL mv # maybe id translateX (fst <$> extentX ref) 38 | 39 | tree :: Tree () -> DC 40 | tree = 41 | renderTree (const dot) (~~) . symmLayout' (with & slHSep .~ 4 & slVSep .~ 4) 42 | 43 | treeParser :: Parser (Tree ()) 44 | treeParser = Node () <$> between (char '(') (char ')') (many treeParser) 45 | 46 | bTreeParser :: Parser (BTree ()) 47 | bTreeParser = char '(' *> 48 | ( BNode () <$> bTreeParser <*> bTreeParser 49 | <|> pure Empty 50 | ) 51 | <* char ')' 52 | 53 | parseTree :: String -> Tree () 54 | parseTree s = case runParser treeParser () "" s of 55 | Left _ -> error "parse error" 56 | Right t -> t 57 | 58 | parseBTree :: String -> BTree () 59 | parseBTree s = case runParser bTreeParser () "" s of 60 | Left _ -> error "parse error" 61 | Right t -> t 62 | 63 | graph :: [(Int,Int)] -> DC 64 | graph es = drawEnsemble es $ 65 | forceLayout (with & damping .~ 0.8 66 | & energyLimit .~ Just 0.001 67 | & stepLimit .~ Nothing 68 | ) 69 | ens 70 | 71 | where 72 | ens :: Ensemble R2 73 | ens = Ensemble [ (es, hookeForce 0.05 4) 74 | , (allPairs, coulombForce 1) 75 | ] 76 | particleMap 77 | vs = nub (map fst es ++ map snd es) 78 | allPairs = [(x,y) | x <- vs, y <- vs, x < y ] 79 | particleMap :: M.Map Int (Particle R2) 80 | particleMap = M.fromList $ zip vs (map initParticle (regPoly (length vs) 4)) 81 | 82 | drawEnsemble :: [(Int,Int)] -> Ensemble R2 -> DC 83 | drawEnsemble es = applyAll (map drawEdge es) . mconcat . map drawPt . (map . second) (^.pos) . M.assocs . (^.particles) 84 | where 85 | drawPt (pid, p) = dot # named pid # moveTo p 86 | drawEdge (v1,v2) = withNames [v1,v2] $ \[s1,s2] -> beneath (location s1 ~~ location s2) 87 | 88 | cyc :: Int -> DC 89 | cyc 0 = mempty 90 | cyc 1 = dot 91 | cyc n 92 | = mconcat 93 | [ position (zip (polygon (with & polyType .~ PolyRegular n r)) (repeat dot)) 94 | , circle r 95 | ] 96 | where 97 | r = 4* fromIntegral n / tau 98 | 99 | decorateLeaves :: BTree a -> Tree (Maybe a) 100 | decorateLeaves Empty = Node Nothing [] 101 | decorateLeaves (BNode a l r) = Node (Just a) [decorateLeaves l, decorateLeaves r] 102 | 103 | binTreeN :: BTree () -> DC 104 | binTreeN Empty = square 1 # fc black 105 | binTreeN t 106 | = renderTree (maybe nil (const dot)) (~~) 107 | . symmLayout' (with & slHSep .~ 5 & slVSep .~ 4) 108 | . decorateLeaves 109 | $ t 110 | 111 | binTree :: BTree () -> DC 112 | binTree Empty = mempty 113 | binTree t 114 | = renderTree' (maybe mempty (const dot)) (drawEdge) 115 | . symmLayout' (with & slHSep .~ 5 & slVSep .~ 4) 116 | . decorateLeaves 117 | $ t 118 | where 119 | drawEdge _ (Nothing,_) = mempty 120 | drawEdge (_,p) (_,q) = p ~~ q 121 | 122 | pair :: DC -> DC -> DC 123 | pair d1 d2 = 124 | hcat 125 | [ d1 # centerXY <> halfBox (w1 + padding) (h + padding) 126 | , d2 # centerXY <> halfBox (w2 + padding) (h + padding) # reflectX 127 | ] 128 | where 129 | w1 = width d1 130 | w2 = width d2 131 | h = max (height d1) (height d2) 132 | padding = maximum [w1 * padFactor, w2 * padFactor, h * padFactor] 133 | padFactor = 0.2 134 | halfBox w h = roundedRect' w h (with & radiusTL .~ min w h / 8 & radiusBL .~ min w h / 8) 135 | 136 | allBinTrees :: [[BTree ()]] 137 | allBinTrees = map binTreesK [0..] 138 | where 139 | binTreesK 0 = [Empty] 140 | binTreesK n = [ BNode () t1 t2 | k <- [(n-1), (n-2) .. 0], t1 <- binTreesK k, t2 <- binTreesK (n - 1 - k)] 141 | 142 | allTrees :: [[Tree ()]] 143 | allTrees = map treesK [0..] 144 | where 145 | treesK 0 = [] 146 | treesK n = [ Node () ts 147 | | part <- oPartitions (n-1) 148 | , ts <- mapM treesK part 149 | ] 150 | 151 | oPartitions 0 = [[]] 152 | oPartitions n | n < 0 = [] 153 | oPartitions n = concat [ map (k:) (oPartitions (n-k)) | k <- [n, n-1 .. 1] ] 154 | 155 | ------------------------------------------------------------ 156 | -- Bucketing 157 | ------------------------------------------------------------ 158 | 159 | -- XXX make bucket lines thicker 160 | 161 | data BucketOpts 162 | = BucketOpts 163 | { _numBuckets :: Int 164 | , _showEllipses :: Bool 165 | , _showIndices :: Bool 166 | , _bucketSize :: Double 167 | , _expandBuckets :: Bool 168 | } 169 | 170 | $(makeLenses ''BucketOpts) 171 | 172 | instance Default BucketOpts where 173 | def = BucketOpts 174 | { _numBuckets = 6 175 | , _showEllipses = True 176 | , _showIndices = True 177 | , _bucketSize = 10 178 | , _expandBuckets = False 179 | } 180 | 181 | bucketed' :: BucketOpts -> [[DC]] -> DC 182 | bucketed' opts buckets 183 | = (if opts ^. showEllipses then (||| ellipses) else id) 184 | . hcat' (with & sep .~ 1) 185 | . take (opts ^. numBuckets) 186 | . zipWith (makeBucket opts) [0..] 187 | $ buckets 188 | where 189 | ellipses = strutX 1 ||| hcat' (with & sep .~ 1) (replicate 3 (circle 0.5 # fc black)) 190 | 191 | makeBucket :: BucketOpts -> Int -> [DC] -> DC 192 | makeBucket opts n elts 193 | = (if (opts ^. showIndices) then (=== (strutY 1 === text' 5 (show n))) else id) 194 | (bucketDia <> wrapLayout s s elts) 195 | where 196 | bucketDia :: DC 197 | bucketDia = roundedRect s s (s / 8) 198 | s = opts ^. bucketSize 199 | 200 | wrapLayout :: Double -> Double -> [DC] -> DC 201 | wrapLayout w h = layoutGrid w h . wrap w h 202 | 203 | wrap :: Double -> Double -> [DC] -> [[DC]] 204 | wrap w h [] = [] 205 | wrap w h es = map snd this : wrap w h (map snd rest) 206 | where 207 | (this, rest) = span (( let w' = w + width e in (w', (w', e))) 0 es 210 | 211 | layoutGrid :: Double -> Double -> [[DC]] -> DC 212 | layoutGrid w h es = centerY . spread unit_Y h $ map (centerX . spread unitX w) es 213 | where 214 | spread :: R2 -> Double -> [DC] -> DC 215 | spread v total es = cat' v (with & sep .~ (total - sum (map (extent v) es)) / (genericLength es + 1)) es 216 | extent v d 217 | = maybe 0 (negate . uncurry (-)) 218 | $ (\f -> (-f (negateV v), f v)) <$> (appEnvelope . getEnvelope $ d) 219 | 220 | bucketed :: [[DC]] -> DC 221 | bucketed = bucketed' def 222 | 223 | ------------------------------------------------------------ 224 | 225 | listBuckets opts = bucketed' opts (map (:[]) . zipWith scale ([1,1,1,0.6] ++ repeat 0.4) . map list $ [0..]) 226 | 227 | binTreeBuckets opts 228 | = bucketed' opts 229 | ( map (map (pad 1.3 . centerXY . binTree)) allBinTrees 230 | # zipWith scale [1,1,0.5, 0.2, 0.2, 0.08] 231 | ) 232 | 233 | ------------------------------------------------------------ 234 | 235 | theTree = tree (parseTree "((())()((()()())()(()())))") # centerXY 236 | 237 | theGraph = graph [(0,1), (0,2), (1,3), (2,3), (2,4), (2,5), (3,5), (3,6), (6,7), (6,8)] # centerXY 238 | 239 | theList = list 5 # centerXY 240 | 241 | theCycles = hcat' (with & sep .~ 2) [cyc 5, cyc 7] # centerXY # rotateBy (1/20) 242 | 243 | ------------------------------------------------------------ 244 | -- misc 245 | 246 | text' d t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False d d ) # fc black # lw none 247 | -------------------------------------------------------------------------------- /SumPermDiagrams.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | 4 | module SumPermDiagrams where 5 | 6 | import Diagrams.Prelude 7 | 8 | import Control.Lens (partsOf, traverse) 9 | import Data.Bits 10 | import Data.List (find) 11 | import Data.Maybe (fromJust) 12 | import Data.Typeable 13 | import Data.Universe.Instances.Base 14 | 15 | newtype Index = Index Int 16 | deriving (Eq, Ord, Show, Read, Real, Num, Integral, Bits, Enum, Typeable) 17 | 18 | instance IsName Index 19 | 20 | instance Universe Index where 21 | universe = map Index [0..] 22 | 23 | column cs 24 | = vcat' (with & sep .~ 1) 25 | . zipWith (|>) ['a' ..] 26 | . map vcat 27 | . (partsOf (traverse.traverse) %~ zipWith fc cs) 28 | . map (\n -> zipWith named [0 :: Index ..] (replicate n (square 1))) 29 | 30 | permL :: (Index -> Index) -> [a] -> [a] 31 | permL s l = [ l !! (fromEnum (inverse s i)) | i <- [0 .. toEnum (length l) - 1] ] 32 | 33 | either2Name :: Either Index Index -> Name 34 | either2Name (Left i) = 'a' .> i 35 | either2Name (Right i) = 'b' .> i 36 | 37 | inverse :: (Universe a, Eq b) => (a -> b) -> (b -> a) 38 | inverse f b = fromJust (find ((==b) . f) universe) 39 | 40 | -------------------------------------------------------------------------------- /Yorgey-thesis-final-2014-11-14-COLOR.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/Yorgey-thesis-final-2014-11-14-COLOR.pdf -------------------------------------------------------------------------------- /Yorgey-thesis-final-2014-11-14-GRAY.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/Yorgey-thesis-final-2014-11-14-GRAY.pdf -------------------------------------------------------------------------------- /Yorgey-thesis-final-2014-11-14.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/Yorgey-thesis-final-2014-11-14.pdf -------------------------------------------------------------------------------- /Yorgey-thesis-final-2014-11-17-GRAY.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/Yorgey-thesis-final-2014-11-17-GRAY.pdf -------------------------------------------------------------------------------- /Yorgey-thesis-final-2014-11-17.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/Yorgey-thesis-final-2014-11-17.pdf -------------------------------------------------------------------------------- /abstract.tex: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | \begin{doublespace} 4 | 5 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 6 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 | \begin{centering} 8 | {\Large ABSTRACT} \\ 9 | \Title \\ 10 | Brent Abraham Yorgey \\ 11 | Stephanie Weirich \\ 12 | \end{centering} 13 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 14 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 15 | 16 | \vspace*{1in} 17 | 18 | The theory of \term{combinatorial species} was developed in the 1980s 19 | as part of the mathematical subfield of enumerative combinatorics, 20 | unifying and putting on a firmer theoretical basis a collection of 21 | techniques centered around \term{generating functions}. The theory of 22 | \term{algebraic data types} was developed, around the same time, in 23 | functional programming languages such as Hope and Miranda, and is 24 | still used today in languages such as Haskell, the ML family, and 25 | Scala. Despite their disparate origins, the two theories have striking 26 | similarities. In particular, both constitute algebraic frameworks in 27 | which to construct structures of interest. Though the similarity has 28 | not gone unnoticed, a link between combinatorial species and algebraic 29 | data types has never been systematically explored. This dissertation 30 | lays the theoretical groundwork for a precise---and, hopefully, 31 | useful---bridge between the two theories. One of the key 32 | contributions is to port the theory of species from a classical, 33 | untyped set theory to a constructive type theory. This porting process 34 | is nontrivial, and involves fundamental issues related to equality and 35 | finiteness; the recently developed \term{homotopy type theory} is put 36 | to good use formalizing these issues in a satisfactory way. In 37 | conjunction with this port, species as general functor categories are 38 | considered, systematically analyzing the categorical properties 39 | necessary to define each standard species operation. Another key 40 | contribution is to clarify the role of species as \emph{labelled 41 | shapes}, not containing any data, and to use the theory of 42 | \term{analytic functors} to model labelled data structures, which have 43 | both labelled shapes and data associated to the labels. Finally, some 44 | novel species variants are considered, which may prove to be of use in 45 | explicitly modelling the memory layout used to store labelled data 46 | structures. 47 | 48 | \end{doublespace} 49 | -------------------------------------------------------------------------------- /abstract_UMI.txt: -------------------------------------------------------------------------------- 1 | The theory of combinatorial species was developed in 2 | the 1980s as part of the mathematical subfield of enumerative 3 | combinatorics, unifying and putting on a firmer theoretical basis a 4 | collection of techniques centered around generating 5 | functions. The theory of algebraic data 6 | types was developed, around the same time, in functional 7 | programming languages such as Hope and Miranda, and is still used 8 | today in languages such as Haskell, the ML family, and Scala. Despite 9 | their disparate origins, the two theories have striking 10 | similarities. In particular, both constitute algebraic frameworks in 11 | which to construct structures of interest. Though the similarity has 12 | not gone unnoticed, a link between combinatorial species and algebraic 13 | data types has never been systematically explored. This dissertation 14 | lays the theoretical groundwork for a precise—and, hopefully, 15 | useful—bridge bewteen the two theories. One of the key 16 | contributions is to port the theory of species from a classical, 17 | untyped set theory to a constructive type theory. This porting process 18 | is nontrivial, and involves fundamental issues related to equality and 19 | finiteness; the recently developed homotopy type 20 | theory is put to good use formalizing these issues in a 21 | satisfactory way. In conjunction with this port, species as general 22 | functor categories are considered, systematically analyzing the 23 | categorical properties necessary to define each standard species 24 | operation. Another key contribution is to clarify the role of species 25 | as labelled shapes, not containing any data, and to 26 | use the theory of analytic functors to model labelled 27 | data structures, which have both labelled shapes and data associated 28 | to the labels. Finally, some novel species variants are considered, 29 | which may prove to be of use in explicitly modelling the memory layout 30 | used to store labelled data structures. 31 | -------------------------------------------------------------------------------- /acks.tex: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | \newpage 4 | \chapter*{Acknowledgments} 5 | 6 | I first thank Stephanie Weirich, who has been a wonderful advisor, 7 | despite the fact that we have fairly different interests and different 8 | approaches to research. She has always encouraged me to pursue my 9 | passions, even to the point of allowing me to take on a dissertation 10 | topic she knew very little about. Perhaps most importantly, she has 11 | done a masterful job getting me to actually graduate (no mean 12 | feat)---by turns encouraging and challenging me, each at the 13 | appropriate moment. 14 | 15 | Jacques Carette has been an unofficial second advisor to me. Despite 16 | having plenty of ``official'' advisees also demanding his time and 17 | attention, he has generously taken the time to collaborate, give 18 | feedback and advice, and even twice to host me for a week of focused, 19 | face-to-face collaboration. This dissertation literally would not 20 | exist were it not for his academic and personal generosity, for which 21 | I will always be grateful. 22 | 23 | My family has been, and continues to be, a constant source of joy and 24 | encouragement. My wife and bestest friend Joyia, more than anyone 25 | else, is the one who encouraged me through the darkest points and 26 | convinced me to keep going. She has also sacrificed much in order to 27 | give me the time and space necessary to finish. My son Noah, too, has 28 | sacrificed---in ways he doesn't even understand---while his daddy 29 | wrote a ``very long story about computers and numbers''. But I could 30 | always count on him to cheer me up with tickle fights. 31 | 32 | The other members of the Penn programming languages group---especially 33 | (though by no means limited to) Chris Casinghino, Richard Eisenberg, 34 | Nate Foster, Michael Greenberg, Peter-Michael Osera, Benjamin Pierce, 35 | Vilhelm Sj\"oberg, Daniel Wagner, and Steve Zdancewic---deserve a 36 | great deal of thanks for all their support over the years, through 37 | moral support and encouragement, critical feedback on papers and 38 | talks, enlightening discussions, and simply friendship. PL Club has 39 | been a wonderfully collegial community in which to learn and work. 40 | 41 | While developing the ideas in this dissertation I have benefited over 42 | the years, both directly and indirectly, from conversations with many 43 | people in the Haskell community and the wider FP and PL communities, 44 | particularly Faris Abou-Saleh, Reid Barton, Gershom Bazerman, Conal 45 | Elliott, Jeremy Gibbons, Andy Gill, Jason Gross, Ralf Hinze, Neel 46 | Krishnaswami, Dan Licata, Peter Lumsdaine, Simon Peyton Jones, Ross 47 | Street, Andrea Vezzosi, and Nick Wu, along with many others. I am 48 | also grateful to Heinrich Apfelmus, Toby Bartels, Shachaf Ben-Kiki, Gabor Greif, David Harrison, 49 | Jay McCarthy, Colin McQuillan, David Roberts, Jon Sterling, and Ryan 50 | Yates, all of whom read early drafts of this dissertation and sent me 51 | typo reports as well as more substantial suggestions, greatly 52 | improving the final product. Thanks also to the anonymous MSFP and 53 | MFPS reviewers, whose feedback on submissions based on this material 54 | led to many substantial improvements to the technical content. 55 | 56 | The \texttt{diagrams} community---particularly Daniel Bergey, Chris 57 | Chalmers, Allen Gardner, Niklas Haas, Claude Heiland-Allen, Chris 58 | Mears, Jeff Rosenbluth, Carter Schonwald, Michael Sloan, Luite 59 | Stegeman, and Ryan Yates---has been a great source of joy to me during 60 | the long process of completing my PhD. Not only have they provided 61 | encouragement, camaraderie, and welcome distraction, but this 62 | dissertation itself is richer for their contributions to 63 | \texttt{diagrams}---many of the diagrams throughout this document make 64 | nontrivial use of features contributed by other members of the 65 | community. It has also been a particular joy to see the project 66 | continue humming along even during my virtual absence while writing. 67 | 68 | It is staggering to consider the wealth of relationship accumulated 69 | during six years at City Church Philadelphia. I particularly thank 70 | Tuck and Stacy Bartholomew, Darren Bell, Dave and Katie Brindley, Zac 71 | and Joanna Brooks, Sara Cayless, Mike and Sonja Chen, Tim and Ruth 72 | Creber, Chris and Bonnie Currie, Ben Doane and Melissa McCarten, Megan and Ryan Dougherty, John 73 | Dyck, Brooke Fugate, Kevin Funderburk, Will and Margaret Kendall, Dick Landis, Colin and Lauren 74 | Marlowe, Drew and Susie Matter, Nick McAvoy, Chris and Sarah Miciek, 75 | Jeremy Millington, Cat Ricketts, Ben Smith, Josh and Kory Stamper, Ben 76 | Sykora and Beth Dyson, Matt Thanabalan and Carrie Lutjens, Gene and 77 | Laura Twilley, and Jackson Warren, all of whom, at various times and 78 | in various ways, have provided encouragement and support as I made my 79 | way through graduate school. It is certain that I have forgotten 80 | others who should also be on this list, and in any case it is not even 81 | clear where the list should stop! 82 | 83 | I thank the Mustard Seed Foundation for their affirmation in selecting 84 | me as a Harvey Fellow, and for their support, both financially, and in 85 | helping me think through the integration of my faith and work. 86 | 87 | A heartfelt thank you to the Williams College computer science 88 | department for the genuine care and support I have received as a 89 | visiting faculty member, and especially to Bill Lenhart for his 90 | generous gift of time in taking on most of the grungy legwork for CS 91 | 134. Beginning a new job, teaching two classes, and simultaneously 92 | completing a dissertation would be impossible even to contemplate were 93 | it not undertaken in such a supportive environment. 94 | 95 | In Philadelphia, the Green Line Cafe, Lovers \& Madmen, the Penn 96 | Graduate Student Center, and Van Pelt library---and in Williamstown, 97 | Tunnel City Coffee and the Schow science library---have all provided 98 | wonderfully conducive environments for focused writing sessions. 99 | 100 | Last but certainly not least, a big thank you is due to Beeminder 101 | (\url{http://beeminder.com}), and to its cofounders, Bethany Soule and 102 | Danny Reeves. The chance that I would have successfully finished this 103 | dissertation without Beeminder is vanishingly small, for the simple 104 | reason that a dissertation cannot be put off until a week before it is 105 | due. \$145 for the motivation to write a dissertation is quite a 106 | steal; I owe the whole Beeminder team a round of beers! 107 | 108 | \begin{center} 109 | \includegraphics[width=4in]{thesis-beeminder} 110 | \end{center} 111 | 112 | Finally, my work has been supported by the National Science 113 | Foundation under the following grants: 114 | \begin{itemize} 115 | \item NSF 1218002, CCF-SHF Small: \emph{Beyond Algebraic Data Types: 116 | Combinatorial Species and Mathematically-Structured Programming} 117 | \item NSF 1116620, CCF-SHF Small: \emph{Dependently-typed Haskell} 118 | \item NSF 0910500, CCF-SHF Large: \emph{Trellys: Community-Based 119 | Design and Implementation of a Dependently Typed Programming 120 | Language} 121 | \end{itemize} 122 | and by the Defense Advanced Research Projects Agency under the 123 | following grant: 124 | \begin{itemize} 125 | \item DARPA Computer Science Study Panel Phase 126 | II. \emph{Machine-Checked Metatheory for Security-Oriented 127 | Languages.} 128 | \end{itemize} 129 | 130 | \subsection*{Statement of contribution} 131 | 132 | Parts of \pref{chap:species}, particularly the enumeration of 133 | categorical properties needed to support various species operations, 134 | were carried out in collaboration with Jacques Carette. The rest of 135 | this dissertation is my own original work. 136 | -------------------------------------------------------------------------------- /agda/EquivEq.agda: -------------------------------------------------------------------------------- 1 | -- Uses NAD's "equality" repo: http://www.cse.chalmers.se/~nad/listings/equality/README.html 2 | 3 | {-# OPTIONS --without-K #-} 4 | 5 | open import Equality 6 | 7 | module EquivEq {reflexive} (eq : ∀ {a p} → Equality-with-J a p reflexive) where 8 | 9 | open import Prelude 10 | open Derived-definitions-and-properties eq 11 | open import Equivalence eq as Equiv 12 | open import Preimage eq 13 | open import Equality.Decision-procedures eq using (module Fin) 14 | 15 | ⊎-disjoint : ∀ {A B : Set} {P : Set} {x : A} {y : B} → (inj₁ x ≡ inj₂ y) → P 16 | ⊎-disjoint {A} {B} {P} eq = subst (λ X → X) (cong wit eq) tt 17 | where 18 | wit : (A ⊎ B) → Set 19 | wit (inj₁ _) = ⊤ 20 | wit (inj₂ _) = P 21 | 22 | inj₂-inj : ∀ {A B : Set} {b b' : B} → B → (inj₂ b ≡ inj₂ b') → (b ≡ b') 23 | inj₂-inj {A} {B} def = cong proj 24 | where 25 | proj : A ⊎ B → B 26 | proj (inj₁ _) = def 27 | proj (inj₂ x) = x 28 | 29 | -- Proving this special case might be more straightforward then GCBP 30 | -- in all its generality. 31 | -- 32 | -- Or... maybe not. It's certainly tedious. 33 | lemma : ∀ {A B : Set} → ((⊤ ⊎ A) ≃ (⊤ ⊎ B)) → (A ≃ B) 34 | lemma {A} {B} ⊤⊎A≃⊤⊎B = record 35 | { to = A→B 36 | ; is-equivalence = λ b → (B→A b , A→B∘B→A b) , preimgPf b 37 | } 38 | where 39 | open _≃_ ⊤⊎A≃⊤⊎B using (to; from; injective; right-inverse-of; left-inverse-of) 40 | A→B : A → B 41 | A→B a with inspect (to (inj₂ a)) 42 | A→B a | inj₂ b with-≡ _ = b 43 | A→B a | inj₁ tt with-≡ eq₁ with inspect (to (inj₁ tt)) 44 | ... | inj₂ b with-≡ _ = b 45 | ... | inj₁ tt with-≡ eq₂ = ⊎-disjoint (injective (trans eq₂ (sym eq₁))) 46 | 47 | B→A : B → A 48 | B→A b with inspect (from (inj₂ b)) 49 | B→A b | inj₂ a with-≡ _ = a 50 | B→A b | inj₁ tt with-≡ eq₁ with inspect (from (inj₁ tt)) 51 | ... | inj₂ a with-≡ _ = a 52 | ... | inj₁ tt with-≡ eq₂ = ⊎-disjoint (_≃_.injective (inverse ⊤⊎A≃⊤⊎B) (trans eq₂ (sym eq₁))) 53 | 54 | -- ugh!!! And that's only *one* direction... Would need to come 55 | -- up with a much nicer theory & way of organizing these things... 56 | -- (for example, A→B and B→A are entirely symmetric but that 57 | -- doesn't go into their definitions so we don't get to exploit 58 | -- it). 59 | A→B∘B→A : (b : B) → A→B (B→A b) ≡ b 60 | A→B∘B→A b with inspect (from (inj₂ b)) 61 | A→B∘B→A b | inj₂ a with-≡ _ with inspect (to (inj₂ a)) 62 | A→B∘B→A b | inj₂ a with-≡ _ | inj₁ tt with-≡ _ with inspect (to (inj₁ tt)) 63 | A→B∘B→A b | inj₂ a with-≡ _ | inj₁ tt with-≡ eq₁ | inj₁ tt with-≡ eq₂ = ⊎-disjoint (injective (trans eq₂ (sym eq₁))) 64 | A→B∘B→A b | inj₂ a with-≡ eq₃ | inj₁ tt with-≡ eq₂ | inj₂ _ with-≡ _ 65 | = ⊎-disjoint 66 | (trans (sym (subst (λ x → to x ≡ inj₁ tt) (sym eq₃) eq₂)) 67 | (right-inverse-of (inj₂ b))) 68 | A→B∘B→A b | inj₂ a with-≡ eq₁ | inj₂ b' with-≡ eq₂ 69 | = inj₂-inj b (trans (sym eq₂) (subst (λ x → to x ≡ inj₂ b) eq₁ (right-inverse-of (inj₂ b)))) 70 | A→B∘B→A b | inj₁ tt with-≡ _ with inspect (from (inj₁ tt)) 71 | A→B∘B→A b | inj₁ tt with-≡ eq₁ | inj₁ tt with-≡ eq₂ = ⊎-disjoint (_≃_.injective (inverse ⊤⊎A≃⊤⊎B) (trans eq₂ (sym eq₁))) 72 | A→B∘B→A b | inj₁ tt with-≡ eq₁ | inj₂ a with-≡ eq₂ with inspect (to (inj₂ a)) 73 | A→B∘B→A b | inj₁ tt with-≡ eq₁ | inj₂ a with-≡ eq₂ | inj₂ y with-≡ eq₃ 74 | = ⊎-disjoint 75 | (trans (sym (right-inverse-of (inj₁ tt))) 76 | (subst (λ x → to x ≡ inj₂ y) (sym eq₂) eq₃)) 77 | A→B∘B→A b | inj₁ tt with-≡ eq₁ | inj₂ a with-≡ eq₂ | inj₁ tt with-≡ eq₃ with inspect (to (inj₁ tt)) 78 | A→B∘B→A b | inj₁ tt with-≡ eq₁ | inj₂ a with-≡ eq₂ | inj₁ tt with-≡ eq₃ | inj₁ tt with-≡ eq₄ 79 | = ⊎-disjoint 80 | (trans (sym (left-inverse-of (inj₁ tt))) 81 | (subst (λ x → from x ≡ inj₂ a) (sym eq₄) eq₂)) 82 | A→B∘B→A b | inj₁ tt with-≡ eq₁ | inj₂ a with-≡ eq₂ | inj₁ tt with-≡ eq₃ | inj₂ y with-≡ eq₄ 83 | = inj₂-inj b 84 | (sym 85 | (trans (sym (right-inverse-of (inj₂ b))) 86 | (subst (λ x → to x ≡ inj₂ y) (sym eq₁) eq₄))) 87 | 88 | preimgPf : (b : B) → (b⁻¹ : A→B ⁻¹ b) → ((B→A b , A→B∘B→A b) ≡ b⁻¹) 89 | preimgPf b b⁻¹ with inspect (from (inj₂ b)) 90 | preimgPf b (a' , a'≡) | inj₂ a with-≡ eq₁ = {!!} 91 | preimgPf b b⁻¹ | inj₁ tt with-≡ eq₁ = {!!} 92 | 93 | gcbp : ∀ {A B A' B' : Set} → ((A ⊎ A') ≃ (B ⊎ B')) → (A ≃ B) → (A' ≃ B') 94 | gcbp {A} {B} {A'} {B'} A⊎A'≃B⊎B' A≃B = record 95 | { to = λ a → back-and-forth (inj₂ a) 96 | ; is-equivalence = {!!} -- this part is nontrivial too! 97 | } 98 | where 99 | back-and-forth : A ⊎ A' → B' 100 | back-and-forth a with (_≃_.to A⊎A'≃B⊎B' a) 101 | ... | inj₂ b' = b' 102 | ... | inj₁ b = back-and-forth (inj₁ (_≃_.from A≃B b)) 103 | -- and it is REALLY non-obvious that this terminates! need to 104 | -- build some sort of data structure that makes it more 105 | -- evident... like with mergesort. Hopefully that would also lead 106 | -- to a more perspicuous explanation of the proof. 107 | 108 | Fin≃→≡ : ∀ {n₁ n₂ : ℕ} → (Fin n₁ ≃ Fin n₂) → (n₁ ≡ n₂) 109 | Fin≃→≡ {zero} {zero} e = refl 0 110 | Fin≃→≡ {zero} {suc n₂} e with (_≃_.from e (inj₁ tt)) 111 | ... | () 112 | Fin≃→≡ {suc n₁} {zero} e with (_≃_.to e (inj₁ tt)) 113 | ... | () 114 | Fin≃→≡ {suc n₁} {suc n₂} e = cong suc (Fin≃→≡ (gcbp e Equiv.id)) 115 | -- hehe, indeed, it is really not obvious that the above terminates, 116 | -- even aside from the termination of gcbp itself, since there is a 117 | -- call to 'gcbp' in the recursive position. 118 | 119 | data PChain : Set → Set → Set₁ where 120 | Node : ∀ {A} → PChain A A 121 | Link : ∀ {A A' B' B} → PChain A A' → (A' ≃ B') → PChain B' B → PChain A B 122 | -- Need a type of "sublink" as well, which handles subsets? 123 | 124 | -- Need the fact that the sets are *finite*! Otherwise the 125 | -- back-and-forth really might not terminate! 126 | -- back-and-forth : ∀ {A B A' B' : Set} → ((A ⊎ A') ≃ (B ⊎ B')) → (A ≃ B) → A' → Chain A' B' 127 | -- back-and-forth A⊎A'≃B⊎B' A≃B a' = {!!} 128 | -------------------------------------------------------------------------------- /agda/PartialIso.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K #-} 2 | 3 | open import Equality 4 | 5 | module PartialIso {reflexive} (eq : ∀ {a p} → Equality-with-J a p reflexive) where 6 | 7 | open import Prelude as P hiding (id; _∘_) 8 | open Derived-definitions-and-properties eq 9 | open import Equivalence eq as Equiv hiding (id; _∘_) 10 | 11 | inj₂-inj : ∀ {ℓ : Level} {A B : Set ℓ} {b b' : B} → B → (inj₂ b ≡ inj₂ b') → (b ≡ b') 12 | inj₂-inj {_} {A} {B} def = cong proj 13 | where 14 | proj : A ⊎ B → B 15 | proj (inj₁ _) = def 16 | proj (inj₂ x) = x 17 | 18 | PartialIso′ : (ℓ : Level) → Set ℓ → Set ℓ → Set ℓ 19 | PartialIso′ ℓ S T = 20 | 21 | ∃ λ (f : S → T) → 22 | 23 | ∃ λ (f′ : T → (↑ ℓ ⊤) ⊎ S) → 24 | 25 | ((s : S) → f′ (f s) ≡ inj₂ s) × 26 | 27 | ((s : S) → (t : T) → (f′ t ≡ inj₂ s) → (t ≡ f s)) 28 | 29 | record PartialIso (ℓ : Level) (S T : Set ℓ) : Set ℓ where 30 | field 31 | partialIso : PartialIso′ ℓ S T 32 | 33 | to : S → T 34 | to = proj₁ partialIso 35 | 36 | from : T → (↑ ℓ ⊤) ⊎ S 37 | from = proj₁ (proj₂ partialIso) 38 | 39 | from-to : (s : S) → from (to s) ≡ inj₂ s 40 | from-to = proj₁ (proj₂ (proj₂ partialIso)) 41 | 42 | to-from : (s : S) → (t : T) → (from t ≡ inj₂ s) → (t ≡ to s) 43 | to-from = proj₂ (proj₂ (proj₂ partialIso)) 44 | 45 | _⊆_ : {ℓ : Level} → (S T : Set ℓ) → Set ℓ 46 | _⊆_ {ℓ} = PartialIso ℓ 47 | 48 | id : ∀ {ℓ : Level} → (S : Set ℓ) → PartialIso ℓ S S 49 | id {ℓ} S = record 50 | { partialIso = P.id , inj₂ 51 | , (λ s → refl (inj₂ s)) 52 | , (λ s t eq → inj₂-inj {A = ↑ ℓ ⊤} s (subst (λ x → inj₂ t ≡ inj₂ x) (refl s) eq)) 53 | } 54 | 55 | _K∘_ : {ℓ : Level} {A B C : Set ℓ} → (B → (↑ ℓ ⊤) ⊎ C) → (A → (↑ ℓ ⊤) ⊎ B) → (A → (↑ ℓ ⊤) ⊎ C) 56 | _K∘_ f g a with g a 57 | _K∘_ f g a | inj₁ _ = inj₁ (lift tt) 58 | _K∘_ f g a | inj₂ b = f b 59 | 60 | _∘_ : ∀ {ℓ : Level} {S T U : Set ℓ} → PartialIso ℓ T U → PartialIso ℓ S T → PartialIso ℓ S U 61 | _∘_ {ℓ} {S} {T} {U} f g = 62 | record 63 | { partialIso 64 | = (λ s → f.to (g.to s)) 65 | , g.from K∘ f.from 66 | , f-t 67 | , t-f 68 | } 69 | where 70 | module f = PartialIso f 71 | module g = PartialIso g 72 | f-t : (s : S) → (g.from K∘ f.from) (f.to (g.to s)) ≡ inj₂ s 73 | f-t s with (f.from (f.to (g.to s))) 74 | f-t s | inj₁ x = {!!} 75 | f-t s | inj₂ y = {!!} 76 | t-f : {!!} 77 | t-f = {!!} 78 | -------------------------------------------------------------------------------- /boring: -------------------------------------------------------------------------------- 1 | # This file contains a list of extended regular expressions, one per 2 | # line. A file path matching any of these expressions will be filtered 3 | # out during `darcs add', or when the `--look-for-adds' flag is passed 4 | # to `darcs whatsnew' and `record'. The entries in ~/.darcs/boring (if 5 | # it exists) supplement those in this file. 6 | # 7 | # Blank lines, and lines beginning with an octothorpe (#) are ignored. 8 | # See regex(7) for a description of extended regular expressions. 9 | 10 | ### compiler and interpreter intermediate files 11 | # haskell (ghc) interfaces 12 | \.hi$ 13 | \.hi-boot$ 14 | \.o-boot$ 15 | # object files 16 | \.o$ 17 | \.o\.cmd$ 18 | # profiling haskell 19 | \.p_hi$ 20 | \.p_o$ 21 | # haskell program coverage resp. profiling info 22 | \.tix$ 23 | \.prof$ 24 | # fortran module files 25 | \.mod$ 26 | # linux kernel 27 | \.ko\.cmd$ 28 | \.mod\.c$ 29 | (^|/)\.tmp_versions($|/) 30 | # *.ko files aren't boring by default because they might 31 | # be Korean translations rather than kernel modules 32 | # \.ko$ 33 | # python, emacs, java byte code 34 | \.py[co]$ 35 | \.elc$ 36 | \.class$ 37 | # objects and libraries; lo and la are libtool things 38 | \.(obj|a|exe|so|lo|la)$ 39 | # compiled zsh configuration files 40 | \.zwc$ 41 | # Common LISP output files for CLISP and CMUCL 42 | \.(fas|fasl|sparcf|x86f)$ 43 | 44 | ### build and packaging systems 45 | # cabal intermediates 46 | \.installed-pkg-config 47 | \.setup-config 48 | # standard cabal build dir, might not be boring for everybody 49 | # ^dist(/|$) 50 | # autotools 51 | (^|/)autom4te\.cache($|/) 52 | (^|/)config\.(log|status)$ 53 | # microsoft web expression, visual studio metadata directories 54 | \_vti_cnf$ 55 | \_vti_pvt$ 56 | # gentoo tools 57 | \.revdep-rebuild.* 58 | # generated dependencies 59 | ^\.depend$ 60 | 61 | ### version control systems 62 | # cvs 63 | (^|/)CVS($|/) 64 | \.cvsignore$ 65 | # cvs, emacs locks 66 | ^\.# 67 | # rcs 68 | (^|/)RCS($|/) 69 | ,v$ 70 | # subversion 71 | (^|/)\.svn($|/) 72 | # mercurial 73 | (^|/)\.hg($|/) 74 | # git 75 | (^|/)\.git($|/) 76 | # bzr 77 | \.bzr$ 78 | # sccs 79 | (^|/)SCCS($|/) 80 | # darcs 81 | (^|/)_darcs($|/) 82 | (^|/)\.darcsrepo($|/) 83 | ^\.darcs-temp-mail$ 84 | -darcs-backup[[:digit:]]+$ 85 | # gnu arch 86 | (^|/)(\+|,) 87 | (^|/)vssver\.scc$ 88 | \.swp$ 89 | (^|/)MT($|/) 90 | (^|/)\{arch\}($|/) 91 | (^|/).arch-ids($|/) 92 | # bitkeeper 93 | (^|/)BitKeeper($|/) 94 | (^|/)ChangeSet($|/) 95 | 96 | ### miscellaneous 97 | # backup files 98 | ~$ 99 | \.bak$ 100 | \.BAK$ 101 | # patch originals and rejects 102 | \.orig$ 103 | \.rej$ 104 | # X server 105 | \..serverauth.* 106 | # image spam 107 | \# 108 | (^|/)Thumbs\.db$ 109 | # vi, emacs tags 110 | (^|/)(tags|TAGS)$ 111 | #(^|/)\.[^/] 112 | # core dumps 113 | (^|/|\.)core$ 114 | # partial broken files (KIO copy operations) 115 | \.part$ 116 | # waf files, see http://code.google.com/p/waf/ 117 | (^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/) 118 | (^|/)\.lock-wscript$ 119 | # mac os finder 120 | (^|/)\.DS_Store$ 121 | 122 | \.tex$ 123 | \.ptb$ 124 | (^|/)diagrams(/|$) 125 | .diagrams_cache 126 | Shake$ 127 | .shake.database 128 | tmp$ 129 | \.errors$ 130 | tmp.hs$ -------------------------------------------------------------------------------- /colorpages.sh: -------------------------------------------------------------------------------- 1 | # Got this script from 2 | # 3 | # http://stackoverflow.com/questions/641427/how-do-i-know-if-pdf-pages-are-color-or-black-and-white 4 | # 5 | # But it doesn't work for me: it just prints 'sRGB' for every page. 6 | 7 | #!/bin/bash 8 | 9 | FILE=$1 10 | PAGES=$(pdfinfo ${FILE} | grep 'Pages:' | sed 's/Pages:\s*//') 11 | 12 | GRAYPAGES="" 13 | COLORPAGES="" 14 | 15 | echo "Pages: $PAGES" 16 | N=1 17 | while (test "$N" -le "$PAGES") 18 | do 19 | COLORSPACE=$( identify -format "%[colorspace]" "$FILE[$((N-1))]" ) 20 | echo "$N: $COLORSPACE" 21 | if [[ $COLORSPACE == "Gray" ]] 22 | then 23 | GRAYPAGES="$GRAYPAGES $N" 24 | else 25 | COLORPAGES="$COLORPAGES $N" 26 | fi 27 | N=$((N+1)) 28 | done 29 | 30 | echo "Color pages:" 31 | echo $COLORPAGES 32 | echo "Black-and-white pages:" 33 | echo $GRAYPAGES 34 | 35 | #pdftk $FILE cat $COLORPAGES output color_${FILE}.pdf 36 | -------------------------------------------------------------------------------- /colorpages.txt: -------------------------------------------------------------------------------- 1 | 6 36 45 47 56 57 64 67 69 77 78 79 80 82 85 86 87 88 89 90 95 98 99 101 102 107 109 111 112 113 115 119 123 124 125 126 129 130 132 134 135 138 139 140 141 142 143 145 146 150 157 158 163 166 167 169 177 2 | -------------------------------------------------------------------------------- /conclusion.lhs: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | \chapter{Conclusion and future work} 4 | \label{chap:conclusion} 5 | 6 | This dissertation has laid the theoretical groundwork to pursue 7 | applications of combinatorial species (and variants thereof) to 8 | algebraic data types in functional programming languages. It is too 9 | early to say with confidence what sorts of applications there might 10 | be, though the future work laid out below hints at some ideas. 11 | 12 | Two aspects of this work have turned out to be particularly surprising 13 | and gratifying to me. The first is the host of nontrivial issues that 14 | arise when attempting to formalize species in a constructive type 15 | theory---and the way that homotopy type theory is able to neatly 16 | dispatch them all. I hope I have successfully made the case that HoTT 17 | is the right framework in which to carry out this work; in any case it 18 | is a lot of fun to see such a recent and groundbreaking theory put to 19 | productive work in a different area of mathematics (namely, 20 | combinatorics). The second gratifying aspect of this work is the way 21 | that analytic functors neatly encapsulate the idea of labelled shapes 22 | associated with a mapping from labels to data. Indeed, Jacques and I 23 | had the basic idea of associating shapes and mappings for a long time 24 | before realizing that what we were thinking of were ``just'' analytic 25 | functors. 26 | 27 | Although this dissertation merely hints at practical applications, I 28 | feel that building on the foundations of this work, practical 29 | applications will not be far behind. In general, there is no shortage 30 | of future work! This dissertation has just scratched the surface of 31 | what is possible, and indeed, some of my initial conceptions of what 32 | my thesis would contain seem to actually constitute a viable five- or 33 | ten-year research program. I mention here some of the most promising 34 | avenues for continued work in this area. 35 | 36 | \begin{itemize} 37 | \item This dissertation discussed exponential and ordinary generating 38 | functions, but omitted \term{cycle index series}, which are a 39 | generalization of both (and which are necessary for computing, \eg, 40 | ogfs of compositions). For that matter, even ogfs were not 41 | discussed much, but correspond to ``unlabelled'' structures, which 42 | may often be what one actually wants to work with. My gut sense is 43 | that there is quite a lot more that could be said about 44 | computational interpretation of generating functions, and that this 45 | may have very practical applications, for example, in the enumeration 46 | and random generation of data structures. 47 | 48 | \item As mentioned in the discussion of 49 | \pref{conj:linear-equipotence}, it seems promising to translate the 50 | theory of molecular and atomic species into homotopy type theory, 51 | ideally using Coq or Agda to formalize the development. My sense is 52 | that this will shed additional light on the theory, and may have 53 | some practical applications as well. 54 | 55 | \item It seems there is something interesting that could be said about 56 | recursively defined $(\fc \B \Set)$-species, where infinite families 57 | of same-size shapes are allowed. Some of the criteria for the 58 | implicit species theorems presented in \pref{sec:recursive} work 59 | simply to prevent such infinite families, and hence are not needed 60 | in such a setting. It would be interesting to explore minimal 61 | criteria for analogues of the implicit species theorems in more 62 | generalized settings. 63 | 64 | \item Although the introduction mentions generic programming, the 65 | remainder of the dissertation has little to say on the topic, but 66 | there are certainly interesting connections to be made. In a 67 | practical vein, using generic programming, it should be possible to 68 | create tools that allow algebraic data types to be manipulated via 69 | generic ``views'' as species. 70 | 71 | % \item There is much more to explore with respect to $\BTSub$ and its 72 | % related notions of species. In particular, \later{finish this once 73 | % I've written more about it.} 74 | 75 | \item It seems that there ought to be some sort of connection between 76 | species and linear logic. In general, labels are ``treated 77 | linearly''; partitional product feels analogous to multiplicative 78 | conjunction, Cartesian product to additive conjunction, and species 79 | sum to additive disjunction. This suggests looking for a species 80 | operation analogous to multiplicative disjunction, although I have 81 | not been able to make sense of such an operation\footnote{Much like 82 | multiplicative disjunction itself.}. It seems worthwhile to 83 | investigate the possibility of a real, deeper connection between 84 | species and linear logic. 85 | 86 | \item \pref{sec:analytic-partial} considered a variant of $\analytic F 87 | A$ which ``removed the coend'', exposing the labels in the type: \[ 88 | \LStr F L A \defeq (\iota L \to A) \times F\ L. \] It is still not 89 | clear, however, whether there is any benefit to being able to 90 | explicitly talk about the label type in this way. Coming up with a 91 | more precise story about such ``exposed'' labelled structures---or 92 | showing conclusively why one does not want to work with them---would 93 | be an important next step. 94 | \end{itemize} 95 | 96 | \later{Say something to wrap up\dots something about ``feels like a 97 | beginning rather than an ending''? How do you end a 200-page 98 | document without sounding hoky?} 99 | -------------------------------------------------------------------------------- /defense/Proposal.hs: -------------------------------------------------------------------------------- 1 | module Proposal where 2 | 3 | import Diagrams.Prelude 4 | 5 | timeline w = hcat [ vrule 1, hrule w, vrule 1 ] 6 | 7 | totalTime = 30 8 | thisWork = 8 9 | 10 | if' True t = t 11 | if' False _ = mempty 12 | 13 | proposalDia n 14 | = vcat' (with & sep .~ 0.5) 15 | [ vcat' (with & sep .~ 0.5) 16 | [ text "proposal" 17 | , timeline totalTime # centerXY 18 | ] 19 | # alignL 20 | , if' (n > 1) $ 21 | hcat 22 | [ vcat' (with & sep .~ 0.5) 23 | [ timeline thisWork # centerXY 24 | , text "this work" 25 | ] 26 | , if' (n > 2) $ 27 | vcat' (with & sep .~ 0.5) 28 | [ timeline (30 - thisWork) # centerXY 29 | , text "next 5-10 years?" 30 | ] 31 | ] 32 | # alignL 33 | ] 34 | -------------------------------------------------------------------------------- /defense/Shake.hs: -------------------------------------------------------------------------------- 1 | import Control.Applicative (liftA2, (<$>)) 2 | import Control.Monad (when) 3 | import Data.Char (isSpace) 4 | import Data.List (isPrefixOf) 5 | import Data.List.Split 6 | import Development.Shake 7 | import Development.Shake.FilePath 8 | 9 | lhs2TeX = "lhs2TeX" 10 | pdflatex = "pdflatex" 11 | rubber = "rubber" 12 | bibtex = "bibtex" 13 | 14 | main = shake shakeOptions $ do 15 | 16 | want ["defense.pdf"] 17 | 18 | "*.tex" *> \output -> do 19 | let input = replaceExtension output "lhs" 20 | e <- doesFileExist input 21 | when e $ do 22 | need [input] 23 | cmd "lhs2TeX --poly -o" [output] [input] 24 | 25 | "*.pdf" *> \output -> do 26 | let input = replaceExtension output "tex" 27 | includes <- map extractArg . filter isInclude <$> readFileLines input 28 | need (map (<.> "tex") includes) 29 | 30 | pkgs <- getDirectoryFiles "" ["*.sty"] 31 | need pkgs 32 | 33 | () <- cmd [pdflatex] "--enable-write18" [input] 34 | () <- cmd [pdflatex] "--enable-write18" [input] 35 | () <- cmd [bibtex] [dropExtension input] 36 | () <- cmd [pdflatex] "--enable-write18" [input] 37 | return () 38 | 39 | isInclude = liftA2 (&&) (not . ("\\includegraphics" `isPrefixOf`)) 40 | (liftA2 (||) ("\\include" `isPrefixOf`) ("\\input" `isPrefixOf`)) 41 | . dropWhile isSpace 42 | 43 | extractArg = (!!1) . splitOneOf "{}" 44 | -------------------------------------------------------------------------------- /defense/feedback/jacques-thesis-comments.txt: -------------------------------------------------------------------------------- 1 | [The page numbers are all on the official version sent in to the examiners] 2 | 3 | Note: I will use 'bb' to indicate 'bad break' below. 4 | 5 | General comments: 6 | - please review all your uses of "trivial", "trivially", "not hard", 7 | "easy", "easily", and so on. First, there are too many. Second, some 8 | of them are only 'easy' after proper understanding, but not so in the 9 | middle of introducing the concept. 10 | (ex: p.43) 11 | - section 2.2.2 (p.48). This material feels really important to me -- 12 | raise its profile, somehow? 13 | - I definitely think that 3.1-3.5 should be one chapter, 3.6-3.11 another. 14 | 15 | Chapter 0. 16 | - p.1 you use the word "container" which might lead to more confusion 17 | than help? 18 | - p.2 the use of 'treeProd' maybe assumes too much reader knowledge? 19 | - p.3 Carette and Uszkay reference not in bib 20 | - p.3 "[Duchon et al., 2002, Philippe Duchon and Chaeffer," - malformed 21 | bib ref 22 | - p.4 normally DAG, not dag. 23 | - p.4 "involv-ing" -- bad break. You should review all your word 24 | breaks, I have seen a dozen awful ones. 25 | - p.4 nontermination or non-termination? 26 | - p.5 "itself related issues", missing 'to' 27 | 28 | Chapter 1. 29 | - p.8 use of judgmental before definition 30 | - p.9 axiomatic bb 31 | - p.11 you talk about x =_A y, then equality of A and B, which is 32 | confusing. Stick to x and y, OR make it clear you have "moved up a 33 | level" by talking of type equality instead of element equality. 34 | - p.16 first full paragraph. Is this used in the thesis? If not, say 35 | so, if it is, say where. 36 | - p.16 "there constructively exists an A such that B" - I think you mean 37 | "an a in A" ? Or maybe "there constructively exists an inhabitant of A 38 | such that B" ? 39 | - p.21 "The above definition". I would add (1.4.1) to be even more precise. 40 | - p. 22 "categories nLab [2014c]" - the reference reads badly, format it 41 | differently? 42 | - p. 23 "replace by category", missing 'a' 43 | - p.23 you refer to MacLane twice on this page, one reference to VII.2 44 | has not \section symbol, the one to VII.7 does. Be consistent! 45 | [Throughout the thesis] 46 | - p.24 cut definition 1.4.6 after the first sentence. The rest is 47 | commentary, not definition. 48 | - p.24 give a reference/citation at the end of the commentary? 49 | - p.26 top: "Remark. Note that" - a bit too much redundancy... 50 | 51 | Chapter 2 52 | - p. 32 "this can be seen as one of the goals of the univalent 53 | foundations program" - I am not sure they would see it that way! 54 | - p. 33 When talking about AC, it is always better to differentiate 55 | finite AC, countable AC and 'larger' AC. 56 | - p. 33 (around distributivity discussion) shouldn't you mention 57 | Skolemization here? 58 | - p. 33 ex-ercize bb 59 | - p. 38 cat-egory bb 60 | - p.44 defin-ing bb 61 | - p.47 "2.2.1 Monoidal categories in HoTT\\ The first example is the 62 | theory of monoidal categories." I had to read this twice - if this is a 63 | section on monoidal categories, why are they the first example? 64 | - p.52 proof of 2.4.3. It is worth looking at NAD's Agda proof of this 65 | lemma. And this proof is also in Joyal 81. 66 | - p.53 remark on remark: in reversible computation, the 'computational 67 | content' of this lemma appears to be crucial. 68 | - p.57 A lot of 2.4.3 has its genesis in our early Haskell experiments - 69 | is that worth a mention? 70 | - p.60 I think the very last paragraph on that page (about building a 71 | very specific functor) is quite important, and its profile should be raised. 72 | 73 | Chapter 3 74 | - p.65 Figure 3.8, that there are no labels (shape vs species) is 75 | confusing on first read 76 | - p.66 end of 3.1. Interestingly the discussion here brought to mind 77 | the "environment map + memory map" distinction that Dowek uses in 78 | describing the semantics of Java in /Principles of Programming 79 | Languages/, Springer UTiCS, ISBN: 978-1-8482-031-9. 80 | - p. 70 I would have expected \mathcal{SPE} rather than bold in 3.2.3. 81 | - p.72 F-form seems highly related to clique, yet there seems to be no 82 | mention of this 83 | - p.90 "objects, functors and natural transformations" occur twice in 84 | the same sentence, which is awkward. 85 | - p.90 using superscripts for functor categories, and also for lifting a 86 | functor (3.6.9) confused me. There has to be a less overloaded notation! 87 | - p.93 I think you need the 'theory of sketches' by Barr & Wells for 88 | lemma 3.6.12. 89 | - p.94 I would call 3.7 "Partitional Product and Day Convolution" 90 | - p.95 prod-ucts bb 91 | - p.104 Example. "E.E is the species of binary partitions, whereas E.E 92 | is the species of subsets". Uh?? 93 | - p. 107 Do you mean "(Fin m)!" or "(Fin m!)" ? 94 | - p. 108 "for some particular choice of monoid in B" - don't you mean P 95 | here? 96 | - p.115 "rections" ? 97 | - p.115 "Joyal [1981, p.-11]" bb 98 | - p.115 "defintion" missing i 99 | - p.117 there has to be a better explanation to why we these adjoints 100 | exist for B ! Ask a category theorist? 101 | - p.118 "and (\frak{C}, \times) has to be monoidal" reads funny. Of 102 | course it is monoidal, you just gave me the multiplication... yet I 103 | know what you mean, it was just surprising. 104 | - p. 120 Fig-ure bb 105 | - p.121 consist-ing bb 106 | - p.121 prod-uct bb 107 | - p.122 "derivative twice results in two different, distinguishable 108 | holes" screams for a picture! 109 | - p.123 Figure 3.43 is awkwardly placed 110 | - p.123 The equation for the well-scoped terms of the (untyped) lambda 111 | calculus is a Riccati equation!!! 112 | - p.124 Are you sure that what Lescanne does is the same as this? It is 113 | related, definitely, but there are important differences in the details 114 | of the counting which might make the two approaches quite different. 115 | - p. 125 "disucssion" 116 | - p.129 "K \u+ L" would be much clearer as "L \u+ K" ! 117 | - p.129 [This definition of derivative is exceedingly cool! In the 118 | world of virtual species, this could give a nice interpretation to both 119 | negative derivative (aka integration) and fractional derivatives too] 120 | - p.130 Remind the reader that the rhs of the defining equation for (G 121 | =>_{\dot} H) L has to be a set ? 122 | - p.131 you should explicitly comment on L=>C species here. 123 | - p.139 molec-ular bb 124 | - p.140 char-acterized bb 125 | - p.141 thm 3.13.1 should really refer to Joyal, not just 'the book' 126 | 127 | Chapter 4 128 | - p. 145 the "." after 4.5 is really hard to see, which makes the 129 | sentence confusing (it could be a comma) 130 | - p. 146 "which correspond to Cartesian closure" - missing 'the' 131 | - p. 148 one equation has bold E, the other has blackboard E 132 | - p. 148 X, Y but blackboard Z ???? 133 | - p.149 "S-sorted" instead of "S-sort" ? 134 | - p.152 cat-egories bb 135 | - p.159 "foregoing" -> do you mean "that we will now introduce" or what 136 | was in the previous section? [I know what "foregoing" means, not sure if 137 | that's what you want to say] 138 | - p.160 Perfom-ing bb 139 | - p.160-161. I hate 5-tuples (4 or more, really). Amazingly hard to read. 140 | - p.162 "i.e. a So," ???? 141 | - p. 164 At the end of 4.6, you really should summarize what all this 142 | implies! I mean, we don't remember what all the assumptions are, so 143 | what kind of operations are supported on these species? spell it out. 144 | 145 | Chapter 5 146 | - p. 167 in defn 5.1.1 "functor K:E -> D, written ..." ? 147 | - p. 167 don't put a footnote in a formula, it looks too much like a 148 | superscript! 149 | - p. 167 defin 5.1.1, put the type annotation on G ? 150 | - p.167 put G in the commutative diagram? And the Kan extension as a 151 | 2-arrow too? 152 | - p.169 [??] reference 153 | - p.169 "latter definition is less useful" insert 'immediately' between 154 | less and useful? To be useful, one really needs the full classification 155 | theorem for analytic functors (i.e. for molecular decomposition) 156 | - p.171 last formula: I would put A^n \times F n first, then ~= what you 157 | have 158 | - p.172 use ~~~ rather than = for the informal equality? 159 | - p.173 Cat-egories bb 160 | - p.174 (X and Y have no upper bound) -> insert 'necessarily' 161 | - p.175 last line of 5.2: you have used E.E, not E^2, up to now for the 162 | subsets species 163 | - p.176 oper-ations bb 164 | - p. 177 C is copowered over Set -- why Set? 165 | - p. 177 you have bold B where you mean script B (near end of page) 166 | - p. 179 Thus, \inject L ... missing ( 167 | - p. 179 remark: isn't this immediately related to separation logic? 168 | 169 | Chapter 6 170 | - p.180 grat-ifying bb 171 | 172 | Bibl 173 | - p. 184 (for example). Some references are "N. Fiore, N. Gambino" etc, 174 | while others "Philippe Flajolet, Bruno Salvy, " etc. Actually, for two 175 | of the Flajolet-Salvy, you mix styles! Pick one. 176 | - p. 186 Capitalization on Knuth's ACP 177 | 178 | Jacques 179 | -------------------------------------------------------------------------------- /defense/feedback/questions.txt: -------------------------------------------------------------------------------- 1 | Questions during Brent's defense 2 | 3 | JC: What part turned out the most subtle? 4 | BAY: The contents of Chapter 2 about encoding in HoTT 5 | - finiteness? 6 | - axiom of choice? 7 | 8 | JC: What part was the most surprising? 9 | BAY: We had this idea that data structures are species + labels for a long time, 10 | but I was surprised to find that this was just analytic functors 11 | 12 | JC: New to me Definition 2.2.2 in HoTT turned out to be forall and exists. Is this known? 13 | BAY: People knew about it, but I can't find the citation. 14 | JC: There's more to mine about this idea. 15 | 16 | JC: What did you learn from early Haskell experiments? 17 | BAY: It doesn't show up in my dissertation, but formed my intuition about encoding in constructive type theory. "Obvious" way to encode finiteness in Haskell is too strong---you could do things you shouldn't be able to. Not sure that Haskell allows the right encoding....propositional truncation is exactly what you want. 18 | 19 | JC: Are F-forms the same as a clique? 20 | BAY: ... 21 | JC: clarify this in your thesis 22 | 23 | JC: Partitional and Arithmetic product are both complicated. Why is that? 24 | BAY: They come out of the same category theory operation, so they are closely related. 25 | 26 | JC: Have you seen Arthimetic derivative anywhere before? That's cool. 27 | BAY: No, that is novel to this work. Putting it in the larger 28 | framework made it clear. But, I don't know of any applications. 29 | 30 | JC: Generalized composition takes product/co-product from Set to B. 31 | Seems awkward that there isn't something more intrinsic. 32 | BAY: You are talking about the specific instance of B to Set. 33 | I don't know a way to generalize it to other categories. 34 | Essential idea is an indexed exponentiation, but I find it unsatisfying too. 35 | 36 | -*- 37 | 38 | BCP: Great job, really enjoyed reading it. 39 | 40 | BCP: Global architecture of the dissertation seems muddled. I expected that we'd define HoTT, port category theory, then build theory of species from there. But that is not what it was. Why did you do what you did? 41 | BAY: From technical point of view, would have been good to forget Set theory. But on pedagogical grounds, I wanted to explain the ideas in terms of Set theory (especially for people who already know the topic) and then explain how they connect over. 42 | BCP: That's what I guessed. But it's confusing sometimes. 43 | BAY: A second answer is that Set theory motivates the important problems in the port. 44 | BCP: You've done a lot work in Set theory (esp your characterizations of properties) is that also a primary contribution? 45 | BAY: Yes, I've never seen a systematic enumeration of properties before. And we had to have it to know that we've done the port correctly. 46 | 47 | BCP: Is there a prospect for a more formal bridge? Generating functions are simpler objects. Could they be used as a core of a rigorous correspondence? 48 | BAY: great idea! 49 | 50 | BCP: Analytic functors. I wasn't clear whether you were satisfied with your account for eliminators. 51 | BAY: I'm not satisfied. If you want to model datatypes with species, you need intro/elim forms. I've been thinking about it for a while and never made much progress. Fundamental stuff first. But I included it anyway. But didn't have time to get to what I wanted. 52 | BCP: How far away are you? 53 | BAY: Not far, but of course I don't know. 54 | 55 | BCP: Some places where parts of proofs are left as future work (page 90). Is this missing proof on the critical path? 56 | BAY: It's not. At least not that one in particular. I've seen people say this is true, and I have no doubts, but I've never seen a good proof. 57 | 58 | -*- 59 | 60 | VT: Can you bring something back from HoTT to theory of algebraic datatypes? 61 | BAY: Nothing specific, maybe generic programming, especially converting between datatypes. 62 | 63 | VT: What about memory layout? 64 | BAY: Jacques and I have ideas about this. Especially for linear algebra. Connecting high-level spec and low-level memory management. 65 | 66 | -*- 67 | 68 | SAZ: What is the next *immediate* step? 69 | BAY: good question. I'm most excited about continuing with memory layout, especially with practical applications. Also, going back to idea of generating functions to unify exhaustive/random generation. 70 | 71 | SAZ: Your dissertation is really broad and general, but could have benefitted by one deep exploration, for a non-algebraic species (like cycles). Could you work out an instance of the eliminators for this? How straightforward is it now? 72 | BAY: With molecular species, you are stuck and can't decompose any more. Not very fun. 73 | I had this idea to use an operation to break symmetry in all possible ways and then put it together. But, I haven't been able to describe it in an algebraic way. I have intuition, but no formalization. 74 | 75 | -------------------------------------------------------------------------------- /defense/images/BinTree.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/defense/images/BinTree.pdf -------------------------------------------------------------------------------- /defense/images/bridge.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/defense/images/bridge.gif -------------------------------------------------------------------------------- /defense/images/bridge.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/defense/images/bridge.png -------------------------------------------------------------------------------- /defense/images/plclub.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/defense/images/plclub.png -------------------------------------------------------------------------------- /defs.lhs: -------------------------------------------------------------------------------- 1 | % -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | %% Haskell typesetting 5 | 6 | %include thesis.fmt 7 | 8 | % Use 'arrayhs' mode, so code blocks will not be split across page breaks. 9 | \arrayhs 10 | 11 | \renewcommand{\Conid}[1]{\mathsf{#1}} 12 | 13 | \newcommand{\mappend}{\diamond} 14 | \newcommand{\mempty}{\varepsilon} 15 | 16 | \renewcommand{\onelinecomment}[1]{--- {#1}} 17 | 18 | \newcommand{\pkg}[1]{\texttt{#1}} 19 | 20 | \newcommand{\Int}{\cons{Int}} 21 | 22 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 23 | %% Package imports 24 | 25 | \usepackage{amsmath} 26 | \usepackage{amssymb} 27 | %\usepackage{amsthm} 28 | \usepackage[amsmath,amsthm,thmmarks]{ntheorem} 29 | \usepackage{mathtools} 30 | \usepackage{stmaryrd} 31 | \usepackage[all,cmtip,2cell]{xy} 32 | \UseAllTwocells 33 | \usepackage{xcolor} 34 | \usepackage{prettyref} 35 | \usepackage{xspace} 36 | \usepackage{url} 37 | \usepackage{footmisc} 38 | \usepackage{enumitem} 39 | \usepackage{verse} 40 | \usepackage[toc]{appendix} 41 | 42 | \usepackage[final]{showkeys} 43 | 44 | % \usepackage{breakurl} 45 | \usepackage{natbib} 46 | 47 | \usepackage{graphicx} 48 | \graphicspath{{images/}} 49 | \usepackage[outputdir=diagrams,backend=cairo,extension=pdf]{diagrams-latex} 50 | 51 | \usepackage[top=1in, bottom=1in, left=1.5in, right=1in,includefoot,paperwidth=8.5in,paperheight=11in]{geometry} 52 | \usepackage{setspace} 53 | 54 | \usepackage[pdftex]{hyperref} 55 | \hypersetup{ 56 | pdftitle={\Title}, 57 | pdfauthor={Brent Yorgey}, 58 | bookmarksnumbered=true, 59 | bookmarksopen=true, 60 | bookmarksopenlevel=1, 61 | hidelinks, 62 | naturalnames=true, 63 | pdfstartview=Fit, 64 | pdfpagemode=UseOutlines, 65 | pdfpagelayout=TwoPageRight 66 | } 67 | 68 | \usepackage{doi} 69 | 70 | \usepackage{fancyhdr} 71 | \lfoot[\fancyplain{}{}]{\fancyplain{}{}} 72 | \rfoot[\fancyplain{}{}]{\fancyplain{}{}} 73 | \cfoot[\fancyplain{}{\footnotesize\thepage}]{\fancyplain{}{\footnotesize\thepage}} 74 | \lhead[\fancyplain{}{}]{\fancyplain{}{}} 75 | \rhead[\fancyplain{}{}]{\fancyplain{}{}} 76 | \ifdraft 77 | \chead[\fancyplain{}{\textbf{DRAFT --- 78 | \today}}]{\fancyplain{}{\textbf{DRAFT --- \today}}} 79 | \fi 80 | \renewcommand{\headrulewidth}{0pt} 81 | \setlength{\headheight}{15pt} 82 | 83 | \newcommand{\signature}{~ \\ \underline{\hspace{20em}}} 84 | 85 | \newenvironment{pagecentered}{% 86 | \vspace*{\stretch{2}}% 87 | \begin{center}% 88 | \begin{minipage}{.8\textwidth}% 89 | }{% 90 | \end{minipage}% 91 | \end{center}% 92 | \vspace*{\stretch{3}}\clearpage} 93 | 94 | \newcommand{\nochapter}[1]{% 95 | \refstepcounter{chapter}% 96 | \addcontentsline{toc}{chapter}{#1}% 97 | \markright{#1}} 98 | 99 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 100 | 101 | \usepackage[utf8x]{inputenx} 102 | \ifgreek 103 | \usepackage[polutonikogreek,english]{babel} 104 | \fi 105 | 106 | \usepackage{defs} 107 | 108 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 109 | %% SDG qed symbol 110 | 111 | \font\tinyfont=cmss10 scaled 375 112 | 113 | % This is for the amsthm package 114 | % \let\oldqedsymbol\qedsymbol 115 | % \renewcommand{\qedsymbol}{\rlap\oldqedsymbol{}\raise 116 | % .5ex\hbox{\tinyfont \hskip .3em S\kern-.15em D\kern -.15em G}} 117 | 118 | % Now I'm using the ntheorem package with amsthm option 119 | \let\oldproofSymbol\proofSymbol 120 | \renewcommand{\proofSymbol}{\rlap\oldproofSymbol{}\raise 121 | .5ex\hbox{\tinyfont \hskip .3em S\kern-.15em D\kern -.15em G}} 122 | -------------------------------------------------------------------------------- /defs.sty: -------------------------------------------------------------------------------- 1 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | %% Declarative formatting 3 | 4 | \newcommand{\term}[1]{\emph{#1}} 5 | \newcommand{\latin}[1]{\textit{#1}\xspace} 6 | \newcommand{\foreign}[1]{\emph{#1}} 7 | 8 | \newcommand{\ie}{\latin{i.e.}} 9 | \newcommand{\eg}{\latin{e.g.}} 10 | \newcommand{\etal}{\latin{et al.}} 11 | \newcommand{\etc}{\latin{etc.}} 12 | 13 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 14 | %% Math typesetting 15 | 16 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 17 | %% General math 18 | 19 | \newcommand{\bbb}[1]{\ensuremath{\mathbb{#1}}} 20 | \providecommand{\N}{\bbb{N}} 21 | \providecommand{\Z}{\bbb{Z}} 22 | \providecommand{\Q}{\bbb{Q}} 23 | \providecommand{\R}{\bbb{R}} 24 | \providecommand{\C}{\bbb{C}} 25 | 26 | \newcommand{\all}[1]{\forall #1.\;} 27 | \newcommand{\exist}[1]{\exists #1.\;} 28 | 29 | \newcommand{\ddx}{\frac{d}{dx}} 30 | 31 | \newcommand{\mcal}[1]{\ensuremath{\mathcal{#1}}} 32 | \let\Sect\S 33 | \renewcommand{\S}{\mcal S} 34 | \renewcommand{\H}{\mcal H} 35 | \newcommand{\I}{\mcal I} 36 | \newcommand{\Sym}{\mcal S} 37 | 38 | \newcommand{\msf}[1]{\ensuremath{\mathsf{#1}}\xspace} 39 | \newcommand{\newmsf}[1]{% 40 | \expandafter\providecommand\csname #1\endcsname{}\expandafter\renewcommand\csname #1\endcsname{\msf{#1}}} 41 | 42 | \newcommand{\param}{\mathord{-}} 43 | 44 | \newcommand{\restr}[2]{#2|_{#1}} 45 | 46 | \newcommand{\comp}{\mathbin{\circ}} 47 | \newcommand{\kcomp}{\mathbin{\bullet}} 48 | \newcommand{\union}{\cup} 49 | \newcommand{\Union}{\bigcup} 50 | \newcommand{\intersect}{\cap} 51 | \newcommand{\Intersect}{\bigcap} 52 | \newcommand{\powerset}{\mcal P} 53 | \newcommand{\singleton}{\{\star\}} 54 | 55 | \newcommand{\partition}{\vdash} 56 | \newcommand{\rectangle}{\Vdash} 57 | \newcommand{\numrect}[2]{\genfrac{\{}{\}}{0pt}{}{#1}{#2}} 58 | 59 | % problem: doesn't seem to adapt to different font sizes, even though 60 | % we use em units?? 61 | % 62 | % \newcommand{\rectangle}{\mathbin{% 63 | % \begin{tikzpicture}% 64 | % \draw (0,0) rectangle (1.618ex,1ex);% 65 | % \end{tikzpicture}}% 66 | % } 67 | 68 | \newcommand{\floor}[1]{\left\lfloor #1 \right\rfloor} 69 | \newcommand{\ceil}[1]{\left\lceil #1 \right\rceil} 70 | 71 | \newcommand{\bij}{\stackrel{\protect\raisebox{-0.2em}{${}_\sim$}}{\longrightarrow}} 72 | %\newcommand{\bij}{\stackrel{\sim}{\longrightarrow}} 73 | \newcommand{\perm}[1]{#1!} 74 | \newcommand{\mkIso}{\rightleftharpoons} 75 | \newcommand{\inj}{\hookrightarrow} 76 | \let\oldequiv\equiv 77 | \newcommand{\jeq}{\oldequiv} % judgmental equality 78 | \newcommand{\defeq}{\mathrel{:=}} % definitional equality in set theory 79 | \newcommand{\hdefeq}{\mathrel{:\jeq}} % definitional equality in HoTT 80 | \renewcommand{\equiv}{\simeq} % homotopy equivalence 81 | \newcommand{\iso}{\cong} % isomorphism in a category 82 | \newcommand{\lequiv}{\leftrightarrow} % logical equivalence 83 | \renewcommand{\implies}{\to} 84 | \renewcommand{\iff}{\lequiv} 85 | \newcommand{\eqrel}{\sim} 86 | 87 | \newcommand{\cpbij}{\subseteq} % copartial bijection 88 | 89 | \newcommand{\quotient}[2]{#1 \mathbin{/} \mathord{#2}} 90 | 91 | % axiom of choice 92 | \newmsf{AC} 93 | 94 | % group action 95 | \newcommand{\act}{\odot} 96 | 97 | \newcommand{\subgroup}{\subseteq} 98 | 99 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 100 | %% Theorems etc. 101 | 102 | \newtheorem{thm}{Theorem}[section] 103 | \newtheorem{prop}[thm]{Proposition} 104 | \newtheorem{lem}[thm]{Lemma} 105 | \newtheorem{cor}[thm]{Corollary} 106 | \newtheorem{conj}[thm]{Conjecture} 107 | 108 | \theoremstyle{definition} 109 | 110 | \makeatletter 111 | \newtheorem*{rep@theorem}{\protect\rep@title} 112 | \newcommand{\newreptheorem}[2]{% 113 | \newenvironment{rep#1}[1]{% 114 | \def\rep@title{#2 \ref*{##1}}% 115 | \begin{rep@theorem}}% 116 | {\end{rep@theorem}}} 117 | \makeatother 118 | 119 | \newtheorem{defn}[thm]{Definition} 120 | \newreptheorem{defn}{Definition} 121 | 122 | \theoremstyle{remark} 123 | \newtheorem*{rem}{Remark} 124 | \newtheorem*{ex}{Example} 125 | \newtheorem*{nota}{Notation} 126 | 127 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 128 | %% Type theory 129 | 130 | \newcommand{\universe}{\mcal{U}} 131 | \newcommand{\dep}[1]{\prod_{#1}} 132 | \newcommand{\fun}[1]{\lambda #1.\ } 133 | 134 | \newcommand{\TyZero}{\ensuremath{\bot}\xspace} 135 | \newcommand{\TyOne}{\ensuremath{\top}\xspace} 136 | \newcommand{\unit}{\ensuremath{\star}\xspace} 137 | 138 | \newcommand{\cons}[1]{\ensuremath{\mathsf{#1}}} 139 | 140 | \providecommand{\False}{} 141 | \renewcommand{\False}{\cons{F}} 142 | \providecommand{\True}{} 143 | \renewcommand{\True}{\cons{T}} 144 | 145 | \newcommand{\zero}{\msf{O}} 146 | \newcommand{\suc}{\msf{S}} 147 | \newcommand{\fzero}{\msf{FO}} 148 | \newcommand{\fsuc}{\msf{FS}} 149 | 150 | \newcommand{\lam}[2]{\lambda\,#1.\;#2} 151 | 152 | \newcommand{\pair}[2]{\langle #1 , #2 \rangle} 153 | \newcommand{\inl}{\cons{inl}} 154 | \newcommand{\inr}{\cons{inr}} 155 | \newcommand{\outl}{\cons{outl}} 156 | \newcommand{\outr}{\cons{outr}} 157 | 158 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 159 | %% HoTT 160 | 161 | \newcommand{\ptrunc}[1]{\ensuremath{\left\|#1\right\|}} 162 | \newcommand{\ptruncI}[1]{\ensuremath{\left|#1\right|}} 163 | 164 | \newcommand{\tygrpd}[1]{\ensuremath{\mathcal{G}(#1)}} 165 | 166 | \newcommand{\transport}[2]{\ensuremath{\mathsf{transport}^{#1}(#2)}} 167 | 168 | \newmsf{ua} 169 | 170 | \newcommand{\hott}[1]{\textit{h}-#1} 171 | 172 | \newmsf{refl} 173 | \newmsf{isSet} 174 | \newmsf{isFinite} 175 | \newmsf{linOrd} 176 | 177 | \newmsf{Fun} 178 | \newmsf{Ana} 179 | 180 | \providecommand{\hom}{} 181 | \renewcommand{\hom}{\Hom} 182 | 183 | \newcommand{\CT}{\mcal{C}} 184 | \newcommand{\DT}{\mcal{D}} 185 | \newcommand{\ST}{\mcal{S}} 186 | \newcommand{\STp}{\ST_{\rightharpoonup}} 187 | \newcommand{\SetT}{\msf{Set}} 188 | \newcommand{\idT}{\msf{id}} 189 | 190 | \newmsf{idtoiso} 191 | \newmsf{isotoid} 192 | \newmsf{qinv} 193 | \newmsf{isequiv} 194 | 195 | \newcommand{\embed}[1]{#1^{\to}} 196 | \newcommand{\project}[1]{#1^{\leftarrow}} 197 | 198 | \newmsf{pInv} 199 | \newmsf{isInjective} 200 | 201 | \newcommand{\Type}{\ensuremath{\mathcal{U}}} 202 | \newcommand{\FinType}{\ensuremath{\Type_{\mathrm{Fin}}}} 203 | \newcommand{\FinTypeT}{\ensuremath{\Type_{\ptrunc{\mathrm{Fin}}}}} 204 | \newcommand{\SetL}{\FinType} 205 | \newcommand{\FinSetT}{\FinTypeT} 206 | \newcommand{\sizesymb}{\#} 207 | \newcommand{\size}[1]{\ensuremath{\sizesymb#1}} 208 | 209 | \newcommand{\Fin}[1]{\ensuremath{\cons{Fin}\ #1}} 210 | 211 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 212 | %% Category theory 213 | 214 | % typesetting for category names 215 | \newcommand{\cat}[1]{\ensuremath{\mathbf{#1}}\xspace} 216 | 217 | \newcommand{\op}{\ensuremath{\mathrm{op}}} % opposite category 218 | \newcommand{\disc}[1]{\ensuremath{\left|#1\right|}} % discrete category 219 | \newcommand{\then}{\mathbin{;}} % flipped composition 220 | 221 | % objects & morphisms 222 | \DeclareMathOperator{\Ob}{Ob} 223 | \newcommand{\mor}[2]{\ensuremath{#1 \longrightarrow #2}} 224 | \newcommand{\nt}[2]{\ensuremath{#1 \stackrel{\bullet}{\longrightarrow} #2}} 225 | \newcommand{\ntiso}[2]{\ensuremath{#1 \stackrel{\bullet}{\longleftrightarrow} #2}} 226 | 227 | \newcommand{\homsymb}{\Rightarrow} 228 | \newcommand{\Hom}[3][]{#2 \homsymb_{#1} #3} 229 | \newcommand{\expn}{\Hom} 230 | \newcommand{\id}{\ensuremath{\mathit{id}}} 231 | \newcommand{\Id}{\ensuremath{\mathit{Id}}} 232 | 233 | \newcommand{\ahom}[2]{\hom[\aprod]{#1}{#2}} 234 | \newcommand{\phom}[2]{\hom[\bullet]{#1}{#2}} 235 | \newcommand{\chom}[2]{\hom[\comp]{#1}{#2}} 236 | 237 | \newcommand{\fc}[2]{\Hom{#1}{#2}} % functor category 238 | 239 | % some standard categories 240 | \newcommand{\newcategory}[1]{% 241 | \expandafter\providecommand\csname #1\endcsname{}\expandafter\renewcommand\csname #1\endcsname{\cat{#1}}} 242 | 243 | \newcategory{Set} % sets and total functions 244 | \newcategory{FinSet} % finite sets 245 | \newcategory{Grp} % groups 246 | \newcategory{Cat} % (small) categories 247 | \newcategory{Spe} % species 248 | \newcategory{CSpe} % constructive species 249 | \newcategory{Hask} % Haskell types and functions 250 | \newcategory{B} % finite sets and bijections 251 | \newcategory{P} % naturals and permutations 252 | \newcategory{L} % finite linear orders and order-preserving bijections 253 | \newcommand{\Vect}{\cat{Vec}} % vector spaces 254 | \newcommand{\PSpe}{\ensuremath{\prt \Spe}} % copartial species 255 | 256 | \newcommand{\BT}{\mcal{B}} 257 | \newcommand{\PT}{\mcal{P}} 258 | \newcommand{\LT}{\mcal{L}} 259 | 260 | \newcommand{\prt}[1]{\ensuremath{#1_{\cpbij}}} 261 | \newcommand{\STSub}{\prt \ST} 262 | \newcommand{\BTSub}{\prt \BT} 263 | \newcommand{\PTSub}{\ensuremath{\PT_{\inj}}} 264 | 265 | \newcommand{\extra}[1]{#1_{\TyOne}} 266 | \newcommand{\extrabij}[1]{\tilde{#1}} % #1^{\sim} 267 | 268 | \newcommand{\FinNSub}{\ensuremath{\cat{Fin}\N_{\subseteq}}} 269 | 270 | \newcommand{\fin}[1]{\ensuremath{[#1]}} 271 | 272 | % ring of weights 273 | \newcommand{\W}{\bbb{W}} 274 | 275 | % generic categories 276 | \newcommand{\D}{\bbb{D}} 277 | \newcommand{\E}{\bbb{E}} 278 | 279 | % limits and colimits 280 | \DeclareMathOperator{\colim}{colim} 281 | 282 | % anafunctors 283 | \newcommand{\Spec}{\bbb{S}} 284 | \newcommand{\lana}[1]{\overleftarrow{#1}} 285 | \newcommand{\rana}[1]{\overrightarrow{#1}} 286 | 287 | % adjunctions 288 | \newcommand{\adj}{\dashv} 289 | 290 | % monoidal lifting 291 | \newcommand{\lifted}[1]{\hat{#1}} 292 | \newcommand{\lotimes}{\mathbin{\lifted{\otimes}}} 293 | 294 | % products and coproducts 295 | \newcommand{\choice}[2]{[#1, #2]} 296 | \newcommand{\fork}[2]{\langle #1, #2 \rangle} 297 | 298 | % ends and coends 299 | \newcommand{\eend}[1]{\all{#1}} 300 | \newcommand{\coend}[1]{\exist{#1}} 301 | 302 | % Kan extensions 303 | \newcommand{\ran}[2]{#2 / #1} 304 | \newcommand{\lan}[2]{#1 \backslash #2} 305 | \DeclareMathOperator{\Lan}{Lan} 306 | \DeclareMathOperator{\Ran}{Ran} 307 | 308 | % cliques 309 | \DeclareMathOperator{\clq}{clq} 310 | 311 | % groupoids 312 | \newcommand{\core}[1]{#1^*} 313 | 314 | % commutative diagrams 315 | \newcommand{\pushout}[1][dr]{\save*!/#1+1.2pc/#1:(1,-1)@^{|-}\restore} 316 | \newcommand{\pullback}[1][dr]{\save*!/#1-1.2pc/#1:(-1,1)@^{|-}\restore} 317 | 318 | \newcommand{\Span}[5]{\xymatrix{#1 & #3 \ar[l]_-{#2} \ar[r]^-{#4} & #5}} 319 | \newcommand{\Cospan}[5]{\xymatrix{#1 \ar[r]_-{#2} & #3 & #5 \ar[l]^-{#4}}} 320 | \newcommand{\BackForth}[4]{\xymatrix{#1 \ar@<.5ex>[r]^{#2} & #4 \ar@<.5ex>[l]^{#3}}} 321 | \newcommand{\Parallel}[4]{\xymatrix{#1 \ar@<.5ex>[r]^{#2} \ar@<-.5ex>[r]_{#3} & #4 }} 322 | 323 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 324 | %% Species 325 | 326 | \renewcommand{\Sp}{\msf} 327 | \newcommand{\X}{\Sp{X}} 328 | \newcommand{\Y}{\Sp{Y}} 329 | \newcommand{\ZZ}{\Sp{Z}} 330 | \newcommand{\F}{\Sp{F}} 331 | \newcommand{\G}{\Sp{G}} 332 | \newcommand{\List}{\Sp{L}} 333 | \newcommand{\T}{\Sp{T}} 334 | \newcommand{\Par}{\Sp{Par}} 335 | \newcommand{\Bag}{\Sp{E}} 336 | \newcommand{\Rubbish}{\Bag} 337 | \newcommand{\elts}{\varepsilon} 338 | \newcommand{\Cyc}{\Sp{C}} 339 | \newcommand{\Perm}{\Sp{S}} 340 | \newcommand{\Bin}{\Sp{B}} 341 | \newcommand{\Der}{\Sp{Der}} 342 | \newcommand{\Arbor}{\mcal{A}} 343 | \newcommand{\arbor}{\mathfrak{a}} 344 | \newcommand{\Rose}{\Sp{R}} 345 | 346 | \newcommand{\Zero}{\msf{0}} 347 | \newcommand{\One}{\msf{1}} 348 | 349 | \newcommand{\sprod}{\cdot} 350 | \newcommand{\fcomp}{\mathbin{\square}} 351 | \newcommand{\hder}[2]{{#2}^{(#1)}} 352 | \newcommand{\ader}[2]{{#2}^{\{#1\}}} 353 | 354 | \newcommand{\pointed}[1]{\ensuremath{{#1}^{\bullet}}} 355 | 356 | \providecommand{\comp}{\circ} 357 | 358 | \newcommand{\usum}{\boxplus} 359 | \newcommand{\uprod}{\boxtimes} 360 | \newcommand{\ucomp}{\boxcircle} 361 | 362 | \newcommand{\unl}[1]{\widetilde{#1}} 363 | 364 | \newcommand{\Lab}{\mathfrak{L}} 365 | \newcommand{\Str}{\mathfrak{S}} 366 | 367 | \newcommand{\equipot}{\mathrel{\stackrel{\#}{=}}} 368 | \newcommand{\relabel}{\approx} 369 | \DeclareMathOperator{\sh}{sh} 370 | 371 | \newcommand{\pt}[1]{#1^{\bullet}} 372 | 373 | \DeclareMathOperator{\fix}{fix} 374 | \DeclareMathOperator{\Fix}{Fix} 375 | 376 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 377 | %% Analytic functors 378 | 379 | \newcommand{\analytic}[1]{\widehat{#1}} 380 | 381 | \newcommand{\lab}[1]{\langle #1 \rangle} 382 | \newcommand{\LStr}[3]{{\lab {#1}}_{#2}\ {#3}} 383 | \newcommand{\GLStr}[4]{{\lab {#1}}^{#2}_{#3}\ {#4}} 384 | 385 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 386 | %% Comments 387 | 388 | \newif\ifcomments\commentsfalse 389 | \newif\ifallcomments\allcommentsfalse 390 | 391 | \newcounter{todocount} 392 | 393 | \ifcomments 394 | \newcommand{\authornote}[3]{\textcolor{#1}{[#3 ---#2]}} 395 | \newcommand{\todo}[1]{\textcolor{red}{[TODO: #1]}\addtocounter{todocount}{1}} 396 | \else 397 | \newcommand{\authornote}[3]{} 398 | \newcommand{\todo}[1]{} 399 | \fi 400 | 401 | \ifallcomments 402 | \newcommand{\later}[1]{\textcolor{green}{[LATER: #1]}} 403 | \else 404 | \newcommand{\later}[1]{} 405 | \fi 406 | 407 | \newcommand{\bay}[1]{\authornote{blue}{BAY}{#1}} 408 | 409 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 410 | %% Prettyref 411 | 412 | \newrefformat{fig}{Figure~\ref{#1}} 413 | \newrefformat{chap}{Chapter~\ref{#1}} 414 | \newrefformat{sec}{\Sect\ref{#1}} 415 | \newrefformat{eq}{equation~\eqref{#1}} 416 | \newrefformat{prob}{Problem~\ref{#1}} 417 | \newrefformat{tab}{Table~\ref{#1}} 418 | \newrefformat{thm}{Theorem~\ref{#1}} 419 | \newrefformat{lem}{Lemma~\ref{#1}} 420 | \newrefformat{prop}{Proposition~\ref{#1}} 421 | \newrefformat{defn}{Definition~\ref{#1}} 422 | \newrefformat{cor}{Corollary~\ref{#1}} 423 | \newrefformat{conj}{Conjecture~\ref{#1}} 424 | 425 | % memoir defines pref and Pref as 'pageref' 426 | \providecommand{\pref}{} 427 | \renewcommand{\pref}[1]{\prettyref{#1}} 428 | 429 | % \Pref is just like \pref but it uppercases the first letter; for use 430 | % at the beginning of a sentence. 431 | \providecommand{\Pref}{} 432 | \renewcommand{\Pref}[1]{% 433 | \expandafter\ifx\csname r@#1\endcsname\relax {\scriptsize[ref]} 434 | \else 435 | \edef\reftext{\prettyref{#1}}\expandafter\MakeUppercase\reftext 436 | \fi 437 | } 438 | 439 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 440 | %% Proofs 441 | 442 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 443 | %% Structured proofs 444 | 445 | \newenvironment{sproof}{% 446 | \begin{tabbing} 447 | \phantom{$\equiv$} \= \qquad\qquad\qquad\qquad\qquad \= \kill 448 | }{% 449 | \end{tabbing}% 450 | } 451 | \newcommand{\stmt}[1]{\> \ensuremath{#1} \\} 452 | \newcommand{\lstmt}[1]{\> \ensuremath{#1} } 453 | \newcommand{\reason}[2]{\ensuremath{#1} \>\> \{ \quad #2 \quad \} \\} 454 | 455 | \newcommand{\subpart}[1]{\llcorner #1 \lrcorner} 456 | \newcommand{\suppart}[1]{\ulcorner #1 \urcorner} 457 | -------------------------------------------------------------------------------- /gf.lhs: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | \chapter{Generating functions} 4 | \label{chap:gfs} 5 | 6 | \bay{Whether this chapter will actually end up being included depends 7 | on available time, how much other material there is, etc. At any 8 | rate it would still need a bunch more work. I certainly plan to 9 | flesh this out and publish it at some point, whether or not it goes 10 | in my thesis.} 11 | 12 | \bay{Give intuitive explanation of why composition is not homomorphic 13 | for ogfs, via generation algorithms?} 14 | 15 | \setcounter{section}{-1} 16 | \section{Introduction and motivation} 17 | \label{sec:motivation} 18 | 19 | Show some example Haskell code for \emph{e.g.} enumerating values of 20 | algebraic data types, or \emph{e.g.} for computing isomorphism with 21 | $\N$. Question: how do we extend this to certain types of non-regular 22 | structures involving composition (\emph{e.g.} permutations = nonempty 23 | sets of cycles?). Give some intuition why this is nonobvious and 24 | hard. 25 | 26 | Corresponds to the observation that ogfs/egfs do not preserve 27 | composition for non-regular species. In combinatorics, solved by 28 | generalizing both to \emph{cycle index series}. Idea: give 29 | a framework for interpreting generating functions computationally, and 30 | show how to extend it all the way to cycle index series. Then the 31 | algorithms we want will just ``fall out'' (at least, that is the hope!). 32 | 33 | \section{Semirings} 34 | \label{sec:intro} 35 | 36 | For the purposes of this note, a \emph{semiring} $(S,+,0,\cdot,1)$ is 37 | a type $S$ equipped with binary operations $+$ and $\cdot$ such that 38 | $(S,+,0)$ is a commutative monoid, $(S,\cdot,1)$ is a monoid, $0 \cdot 39 | a = a \cdot 0 = 0$, and $\cdot$ distributes over $+$. As usual, we 40 | will often abuse notation and denote a semiring simply by its carrier 41 | type $S$ when the operations are clear from context. We also 42 | sometimes omit $\cdot$ and denote multiplication by juxtaposition, $a 43 | \cdot b = ab$. 44 | 45 | Examples of semirings (some of which will play an important role later) 46 | include: 47 | \begin{itemize} 48 | \item Booleans under disjunction and conjunction, $(\B, \lor, \False, 49 | \land, \True)$. 50 | \item Natural numbers under addition and multiplication, 51 | $(\N,+,0,\cdot,1)$. 52 | \item Integers under addition and multiplication, $(\Z,+,0,\cdot,1)$. 53 | \item The integers (or naturals), adjoined with $-\infty$, under 54 | maximum and addition, $(\Z \cup \{-\infty\},\max,-\infty,+,0)$. 55 | \item Finite sets under disjoint union and cartesian product, 56 | $(\FinSet, \uplus, \varnothing, \times, \{\star\})$. (Note 57 | that the laws hold only up to isomorphism of sets.) 58 | \end{itemize} 59 | 60 | By a semiring \emph{homomorphism} $\phi : S \to T$ we mean simply a 61 | function $S \to T$ which preserves all the semiring structure, that 62 | is, $\phi(0_S) = 0_T$, $\phi(1_S) = 1_T$, $\phi(a + b) = \phi(a) + 63 | \phi(b)$, and $\phi(ab) = \phi(a)\phi(b)$. Observe, for 64 | example, that we have the sequence of semiring homomorphisms 65 | \[ 66 | \xymatrix{ 67 | (\FinSet, \uplus, \varnothing, \times, \{\star\}) 68 | \ar[d]^{||\param||} \\ 69 | (\N,+,0,\cdot,1) 70 | \ar[d]^{> 0} \\ 71 | (\B, \lor, \False, \land, \True) 72 | } 73 | \] 74 | going from a set $S$, to its size $||S||$, to its inhabitation $||S||>0$. 75 | 76 | \section{Formal power series} 77 | \label{sec:power-series} 78 | 79 | In connection with the theory of species, we typically consider formal 80 | power series with coefficients taken from some numeric type like 81 | natural numbers or integers. However, there is nothing particularly 82 | special about numbers in this context. As is well-known, given any 83 | semiring $S$ we may form the semiring $S[[x]]$ of formal power series 84 | with coefficients in $S$, with addition and multiplication defined in 85 | the usual way. In particular, $S[[x]]$ can be viewed as what we get by 86 | adjoining a new distinguished element $x$ to $S$, and then taking the 87 | completion to form a semiring over the resulting set. Note also that 88 | any semiring homomorphism $\phi : S \to T$ induces a homomorphism over 89 | the associated semirings of formal power series, which we notate as 90 | $\phi[[x]] : S[[x]] \to T[[x]]$ (that is, $\param [[x]]$ is an 91 | endofunctor on the category of semirings). 92 | 93 | In what follows, it will be useful to keep in mind a different (but 94 | equivalent) formulation of formal power series: we view the formal 95 | power series $S[[x]]$ as a \emph{function} $S[[x]] : \N \to S$, giving 96 | the coefficient at each power of $x$. 97 | 98 | \section{Ordinary generating functions and unlabelled species} 99 | \label{sec:ogf} 100 | 101 | To each species $F$ we associate an \term{ordinary generating 102 | function} (ogf), $\unl{F}(x)$, defined by \[ \unl{F}(x) = \sum_{n 103 | \geq 0} \unl{f}_n x^n, \] where $\unl{f}_n$ denotes the number of 104 | \term{unlabelled $F$-structures} of size $n$, that is, the number of 105 | equivalence classes of $F$-structures under relabelling. This mapping 106 | from species to ogfs is a semiring homomorphism, that is, 107 | $(\unl{F+G})(x) = \unl F(x) + \unl G(x)$ and $(\unl{F \cdot G})(x) = 108 | \unl F(x) \cdot \unl G(x)$. 109 | 110 | The standard definition of a species is a functor $\B \to \FinSet$, 111 | where $\B$ is the category of finite sets with bijections as 112 | morphisms. Unlabelled structures are equivalence classes of 113 | (labelled) species structures. Can view ``unlabelled species'' as 114 | functors from discrete category $\N$ (the skeleton of $\B$) 115 | 116 | \[ 117 | \xymatrix{ 118 | \B \ar[r] \ar[d]_{||\param||} & \FinSet \ar[d] \\ 119 | \N \ar[r] & \FinSet 120 | } 121 | \] 122 | 123 | View species definition itself, $\B \to \FinSet$, as a generating 124 | function $\N \to \FinSet$ with canonically-labeled structures. (Can 125 | recover action on all of $\B$ from action on $\N$, since $\N$ as 126 | discrete category is the skeleton of $\B$.) (Q: are these naturally 127 | isomorphic as functors?) Then the well-known mapping to ogfs arises as 128 | the semiring homomorphism on formal power series induced by the 129 | semiring homomorphism on the coefficients, $||\param|| : (\FinSet, 130 | \uplus, \times, \varnothing, \{\star\}) \to (\N,+,\cdot,0,1)$. (Is 131 | this quite right? There's a factor of $n!$ to deal with somewhere.) 132 | 133 | We then consider other semiring homomorphisms to and from $\FinSet$, 134 | and discover we can churn out algorithms to compute things about 135 | unlabelled species simply by designing the proper semiring + 136 | homomorphism and transporting the species-expression-as-ogf along the 137 | induced ogf homomorphism. (Many of these algorithms are well-known 138 | and/or ``obvious''.) Exhibit some Haskell code. 139 | 140 | However, this only works for ogfs. (Can we use theory of semiring 141 | homomorphisms etc. to show why ogfs break down when trying to handle 142 | unlabelled non-regular species?) The idea is to generalize this 143 | entire analysis from ogfs to egfs and cycle index series, which 144 | requires generalizing the notion of semiring. 145 | 146 | \section{Sized semirings} 147 | \label{sec:indexed-semirings} 148 | 149 | \emph{Sized semirings} are a generalization of semirings where the 150 | elements have types indexed by a natural number (their ``size''). In 151 | particular, a sized semiring consists of 152 | \begin{itemize} 153 | \item A type family $S : \N \to \universe$ (where \universe\ denotes 154 | the universe of types). We use subscripts to denote applications of 155 | $S$, as in $S_n$. 156 | \item A binary operation $\_ + \_ : \dep{n:\N} S_n \to S_n \to S_n$. 157 | We usually omit the size argument when it is clear from context. 158 | \item A distinguished family of elements $0 : \dep{n:\N} S_n$. We 159 | write $0_n$ when we wish to be explicit about the size, but usually 160 | omit it. 161 | \item A binary operation $\_ \cdot \_ : \dep{m, n : \N} S_m \to S_n \to 162 | S_{m+n}$. We usually omit the size arguments. 163 | \item A distinguished element $1 : S_0$. 164 | \end{itemize} 165 | Moreover, these are subject to laws analogous to the laws of a 166 | semiring, listed below. Sizes are indicated by subscripts; all free 167 | variables (including sizes) are implicitly universally quantfied. 168 | \begin{itemize} 169 | \item $0_n + s_n = s_n + 0_n = s_n$ \hfill ($0$ is an 170 | identity for $+$) 171 | \item $(s_n + t_n) + u_n = s_n + (t_n + u_n)$ \hfill (Associativity of $+$) 172 | \item $s_n + t_n = t_n + s_n$ \hfill 173 | (Commutativity of $+$) 174 | \item $0_m \cdot s_n = s_n \cdot 0_m = 175 | 0_{m+n}$ \hfill ($0$ is an annihilator for $\cdot$) 176 | \item $1 \cdot s_n = s_n \cdot 1 = s_n$ \hfill ($1$ is an identity for 177 | $\cdot$) 178 | \item $(s_m \cdot t_n) \cdot u_p = s_m \cdot (t_n \cdot 179 | u_p)$ \hfill (Associativity of $\cdot$) 180 | \item $s_m \cdot (t_n + u_n) 181 | = s_m \cdot t_n + s_m \cdot u_n$ \hfill (Left distributivity) 182 | \item $(t_n + u_n) \cdot s_m 183 | = t_n \cdot s_m + u_n \cdot s_m$ \hfill (Right distributivity) 184 | \end{itemize} 185 | 186 | We can make any semiring $S$ into a sized semiring $R$ by putting a 187 | copy of $S$ at every size, that is, by defining $R_n \defeq S$, and 188 | taking the binary operations of $R$ to be those of $S$, ignoring the 189 | sizes. In fact, we can see semirings as precisely those sized 190 | semirings where $+$, $\cdot$, and $0$ are defined uniformly over all 191 | sizes. 192 | 193 | For a more interesting example of a sized semiring, consider the 194 | following definition of the \term{binomial semiring}, $B$. We begin 195 | with a copy of the natural numbers at each size, $B_n \defeq \N$, and 196 | take the usual $0$, $1$, and $+$, defined uniformly for all sizes. For 197 | the product operation, however, we define \[ \cdot_B = \fun {m, n : 198 | \N} \fun {a : B_m} \fun {b : B_n} \binom{m+n}{m} \cdot a \cdot b \] 199 | where the product operations on the right-hand side are the usual 200 | product of natural numbers. For example, $4_2 \cdot_B 7_3 = 201 | \binom{5}{2} 28 = 280$. It is not hard to show that this satisfies 202 | the sized semiring laws. 203 | 204 | The analogue of generating functions over a sized semiring $S$ are 205 | dependent functions $\dep{n:\N} S_n$ (instead of $\N \to S$ for 206 | semirings). The type of such generating functions over a sized 207 | semiring $S$ is also denoted $S[[x]]$; this should not cause confusion 208 | since it will usually be clear whether $S$ denotes a usual or a sized 209 | semiring. 210 | 211 | \section{Exponential generating functions} 212 | \label{sec:egfs} 213 | 214 | Exponential generating functions (egfs) represent a sequence $f_0, 215 | f_1, f_2, \dots$ by an infinite polynomial \[ F(x) = \sum_{n \geq 0} 216 | f_n \frac{x^n}{n!}. \] Given the previous developments, we can now 217 | view egfs as elements of the semiring $B[[x]]$ of formal power series 218 | over the (sized) binomial semiring $B$. To see this, it suffices to 219 | note that 220 | \begin{align*} 221 | F(x) G(x) 222 | &= \left(\sum_{n \geq 0} f_n \frac{x^n}{n!}\right) \left(\sum_{n \geq 0} 223 | g_n \frac{x^n}{n!}\right) \\ 224 | &= \sum_{n \geq 0} \sum_{0 \leq k \leq n} \frac{f_k}{k!} 225 | \frac{g_{n-k}}{(n-k)!} x^n \\ 226 | &= \sum_{n \geq 0} \left(\sum_{0 \leq k \leq n} \binom{n}{k} f_k 227 | g_{n-k} \right) \frac{x^n}{n!} \\ 228 | &= \sum_{n \geq 0} \left(\sum_{0 \leq k \leq n} f_k \cdot_B 229 | g_{n-k} \right) \frac{x^n}{n!} 230 | \end{align*} 231 | 232 | Exhibit the sized semiring homomorphism 233 | $\FinSet \to B$ which induces the homomorphism from species to egfs. 234 | Talk about other homomorphisms, algorithms on labelled species, etc. 235 | 236 | However, we still can't handle unlabelled species in all generality 237 | (Q: can we show why using this framework?). For that we have to 238 | generalize to cycle index series. 239 | 240 | \section{Indexed semirings} 241 | \label{sec:gen-indexed-semirings} 242 | 243 | \term{Indexed semirings} represent a further generalization of sized 244 | semirings. Instead of indexing by a natural number size, we index by 245 | an arbitrary monoid. In detail, an indexed semiring consists of 246 | \begin{itemize} 247 | \item A monoid $(\I, \oplus, \varepsilon)$. Elements $i,j \in \I$ are 248 | called \term{indices}. 249 | \item A type family $S : \I \to \universe$, where applications of $S$ 250 | are again denoted using subscripts, $S_i$. 251 | \item A binary operation $\_ + \_ : \dep{i:\I} S_i \to S_i \to S_i$. 252 | \item A distinguished family of elements $0 : \dep{i:\I} S_i$. 253 | \item A binary operation $\_ \cdot \_ : \dep{i,j:\I} S_i \to S_j \to 254 | S_{i \oplus j}$. 255 | \item A distinguished element $1 : S_\varepsilon$. 256 | \end{itemize} 257 | In addition, indexed semirings are subject to laws exactly parallel to 258 | those for sized semirings, in such a way that every sized semiring is 259 | automatically an indexed semiring indexed by $(\N,+,0)$. 260 | 261 | Use this to do the appropriate thing for cycle index series, indexed 262 | by\dots integer partitions (???) 263 | 264 | The hope is that some non-obvious algorithms will ``fall out'' of 265 | this, for e.g. enumerating unlabelled non-regular species. 266 | 267 | \section{Questions} 268 | \label{sec:questions} 269 | 270 | Questions for further consideration: 271 | 272 | \begin{itemize} 273 | \item It seems like weighted species ought to fit nicely into this 274 | framework. Do they? What are the details? 275 | \item Can we fit Boltzmann sampling into this framework too? 276 | \emph{e.g.} do Boltzmann samplers have a semigroup structure? 277 | \end{itemize} 278 | 279 | -------------------------------------------------------------------------------- /graypages.txt: -------------------------------------------------------------------------------- 1 | 1 2 3 4 5 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 37 38 39 40 41 42 43 44 46 48 49 50 51 52 53 54 55 58 59 60 61 62 63 65 66 68 70 71 72 73 74 75 76 81 83 84 91 92 93 94 96 97 100 103 104 105 106 108 110 114 116 117 118 120 121 122 127 128 131 133 136 137 144 147 148 149 151 152 153 154 155 156 159 160 161 162 164 165 168 170 171 172 173 174 175 176 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 2 | -------------------------------------------------------------------------------- /images/relabeling.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/images/relabeling.pdf -------------------------------------------------------------------------------- /images/thesis-beeminder.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/images/thesis-beeminder.png -------------------------------------------------------------------------------- /inkcov.txt: -------------------------------------------------------------------------------- 1 | GPL Ghostscript 9.10 (2013-08-30) 2 | Copyright (C) 2013 Artifex Software, Inc. All rights reserved. 3 | This software comes with NO WARRANTY: see the file PUBLIC for details. 4 | Processing pages 1 through 206. 5 | Page 1 6 | 0.00000 0.00000 0.00000 0.02025 CMYK OK 7 | Page 2 8 | 0.00000 0.00000 0.00000 0.00800 CMYK OK 9 | Page 3 10 | 0.00000 0.00000 0.00000 0.01660 CMYK OK 11 | Page 4 12 | 0.00000 0.00000 0.00000 0.05627 CMYK OK 13 | Page 5 14 | 0.00000 0.00000 0.00000 0.06608 CMYK OK 15 | Page 6 16 | 0.04379 0.03963 0.04742 0.02772 CMYK OK 17 | Page 7 18 | 0.00000 0.00000 0.00000 0.03591 CMYK OK 19 | Page 8 20 | 0.00000 0.00000 0.00000 0.00497 CMYK OK 21 | Page 9 22 | 0.00000 0.00000 0.00000 0.02124 CMYK OK 23 | Page 10 24 | 0.00000 0.00000 0.00000 0.02991 CMYK OK 25 | Page 11 26 | 0.00000 0.00000 0.00000 0.01855 CMYK OK 27 | Page 12 28 | 0.00000 0.00000 0.00000 0.00341 CMYK OK 29 | Page 13 30 | 0.00000 0.00000 0.00000 0.02699 CMYK OK 31 | Page 14 32 | 0.00000 0.00000 0.00000 0.03407 CMYK OK 33 | Page 15 34 | 0.00000 0.00000 0.00000 0.00279 CMYK OK 35 | Page 16 36 | 0.00000 0.00000 0.00000 0.00483 CMYK OK 37 | Page 17 38 | 0.00000 0.00000 0.00000 0.04296 CMYK OK 39 | Page 18 40 | 0.00000 0.00000 0.00000 0.05916 CMYK OK 41 | Page 19 42 | 0.00000 0.00000 0.00000 0.06878 CMYK OK 43 | Page 20 44 | 0.00000 0.00000 0.00000 0.05385 CMYK OK 45 | Page 21 46 | 0.00000 0.00000 0.00000 0.06830 CMYK OK 47 | Page 22 48 | 0.00000 0.00000 0.00000 0.01000 CMYK OK 49 | Page 23 50 | 0.00000 0.00000 0.00000 0.03181 CMYK OK 51 | Page 24 52 | 0.00000 0.00000 0.00000 0.04944 CMYK OK 53 | Page 25 54 | 0.00000 0.00000 0.00000 0.03808 CMYK OK 55 | Page 26 56 | 0.00000 0.00000 0.00000 0.04559 CMYK OK 57 | Page 27 58 | 0.00000 0.00000 0.00000 0.05750 CMYK OK 59 | Page 28 60 | 0.00000 0.00000 0.00000 0.05312 CMYK OK 61 | Page 29 62 | 0.00000 0.00000 0.00000 0.05962 CMYK OK 63 | Page 30 64 | 0.00000 0.00000 0.00000 0.05436 CMYK OK 65 | Page 31 66 | 0.00000 0.00000 0.00000 0.06351 CMYK OK 67 | Page 32 68 | 0.00000 0.00000 0.00000 0.05005 CMYK OK 69 | Page 33 70 | 0.00000 0.00000 0.00000 0.05659 CMYK OK 71 | Page 34 72 | 0.00000 0.00000 0.00000 0.04524 CMYK OK 73 | Page 35 74 | 0.00000 0.00000 0.00000 0.04519 CMYK OK 75 | Page 36 76 | 0.01062 0.01062 0.00926 0.04574 CMYK OK 77 | Page 37 78 | 0.00000 0.00000 0.00000 0.05475 CMYK OK 79 | Page 38 80 | 0.00000 0.00000 0.00000 0.03700 CMYK OK 81 | Page 39 82 | 0.00000 0.00000 0.00000 0.05049 CMYK OK 83 | Page 40 84 | 0.00000 0.00000 0.00000 0.04669 CMYK OK 85 | Page 41 86 | 0.00000 0.00000 0.00000 0.04766 CMYK OK 87 | Page 42 88 | 0.00000 0.00000 0.00000 0.02680 CMYK OK 89 | Page 43 90 | 0.00000 0.00000 0.00000 0.04572 CMYK OK 91 | Page 44 92 | 0.00000 0.00000 0.00000 0.05582 CMYK OK 93 | Page 45 94 | 0.00625 0.00625 0.00625 0.02521 CMYK OK 95 | Page 46 96 | 0.00000 0.00000 0.00000 0.04508 CMYK OK 97 | Page 47 98 | 0.01044 0.01060 0.01001 0.03896 CMYK OK 99 | Page 48 100 | 0.00000 0.00000 0.00000 0.04861 CMYK OK 101 | Page 49 102 | 0.00000 0.00000 0.00000 0.06236 CMYK OK 103 | Page 50 104 | 0.00000 0.00000 0.00000 0.05773 CMYK OK 105 | Page 51 106 | 0.00000 0.00000 0.00000 0.05025 CMYK OK 107 | Page 52 108 | 0.00000 0.00000 0.00000 0.05591 CMYK OK 109 | Page 53 110 | 0.00000 0.00000 0.00000 0.03987 CMYK OK 111 | Page 54 112 | 0.00000 0.00000 0.00000 0.02800 CMYK OK 113 | Page 55 114 | 0.00000 0.00000 0.00000 0.05860 CMYK OK 115 | Page 56 116 | 0.00636 0.00636 0.00636 0.03198 CMYK OK 117 | Page 57 118 | 0.00237 0.00237 0.00237 0.04260 CMYK OK 119 | Page 58 120 | 0.00000 0.00000 0.00000 0.03842 CMYK OK 121 | Page 59 122 | 0.00000 0.00000 0.00000 0.05650 CMYK OK 123 | Page 60 124 | 0.00000 0.00000 0.00000 0.05462 CMYK OK 125 | Page 61 126 | 0.00000 0.00000 0.00000 0.05415 CMYK OK 127 | Page 62 128 | 0.00000 0.00000 0.00000 0.03380 CMYK OK 129 | Page 63 130 | 0.00000 0.00000 0.00000 0.03982 CMYK OK 131 | Page 64 132 | 0.00017 0.00017 0.00017 0.06090 CMYK OK 133 | Page 65 134 | 0.00000 0.00000 0.00000 0.03734 CMYK OK 135 | Page 66 136 | 0.00000 0.00000 0.00000 0.05582 CMYK OK 137 | Page 67 138 | 0.00357 0.00406 0.00406 0.04011 CMYK OK 139 | Page 68 140 | 0.00000 0.00000 0.00000 0.05058 CMYK OK 141 | Page 69 142 | 0.00590 0.00590 0.00590 0.03986 CMYK OK 143 | Page 70 144 | 0.00000 0.00000 0.00000 0.04513 CMYK OK 145 | Page 71 146 | 0.00000 0.00000 0.00000 0.04820 CMYK OK 147 | Page 72 148 | 0.00000 0.00000 0.00000 0.04795 CMYK OK 149 | Page 73 150 | 0.00000 0.00000 0.00000 0.04506 CMYK OK 151 | Page 74 152 | 0.00000 0.00000 0.00000 0.04628 CMYK OK 153 | Page 75 154 | 0.00000 0.00000 0.00000 0.04765 CMYK OK 155 | Page 76 156 | 0.00000 0.00000 0.00000 0.04585 CMYK OK 157 | Page 77 158 | 0.01181 0.01181 0.01181 0.03597 CMYK OK 159 | Page 78 160 | 0.01137 0.01137 0.01114 0.03417 CMYK OK 161 | Page 79 162 | 0.01242 0.01334 0.01099 0.00746 CMYK OK 163 | Page 80 164 | 0.02375 0.02481 0.02162 0.01450 CMYK OK 165 | Page 81 166 | 0.00000 0.00000 0.00000 0.05594 CMYK OK 167 | Page 82 168 | 0.00410 0.00477 0.00409 0.04283 CMYK OK 169 | Page 83 170 | 0.00000 0.00000 0.00000 0.06369 CMYK OK 171 | Page 84 172 | 0.00000 0.00000 0.00000 0.04614 CMYK OK 173 | Page 85 174 | 0.00961 0.00961 0.00961 0.03708 CMYK OK 175 | Page 86 176 | 0.00221 0.00221 0.00221 0.04467 CMYK OK 177 | Page 87 178 | 0.00411 0.00411 0.00411 0.03325 CMYK OK 179 | Page 88 180 | 0.00771 0.00771 0.00703 0.04617 CMYK OK 181 | Page 89 182 | 0.00369 0.00369 0.00369 0.04605 CMYK OK 183 | Page 90 184 | 0.00250 0.00251 0.00251 0.04651 CMYK OK 185 | Page 91 186 | 0.00000 0.00000 0.00000 0.05995 CMYK OK 187 | Page 92 188 | 0.00000 0.00000 0.00000 0.05347 CMYK OK 189 | Page 93 190 | 0.00000 0.00000 0.00000 0.04977 CMYK OK 191 | Page 94 192 | 0.00000 0.00000 0.00000 0.03561 CMYK OK 193 | Page 95 194 | 0.00783 0.00783 0.00783 0.04944 CMYK OK 195 | Page 96 196 | 0.00000 0.00000 0.00000 0.05000 CMYK OK 197 | Page 97 198 | 0.00000 0.00000 0.00000 0.04379 CMYK OK 199 | Page 98 200 | 0.00246 0.00246 0.00246 0.03331 CMYK OK 201 | Page 99 202 | 0.00252 0.00252 0.00252 0.03873 CMYK OK 203 | Page 100 204 | 0.00000 0.00000 0.00000 0.04987 CMYK OK 205 | Page 101 206 | 0.01344 0.01344 0.01344 0.01454 CMYK OK 207 | Page 102 208 | 0.00151 0.00172 0.00151 0.03167 CMYK OK 209 | Page 103 210 | 0.00000 0.00000 0.00000 0.04920 CMYK OK 211 | Page 104 212 | 0.00000 0.00000 0.00000 0.04611 CMYK OK 213 | Page 105 214 | 0.00000 0.00000 0.00000 0.04150 CMYK OK 215 | Page 106 216 | 0.00000 0.00000 0.00000 0.04747 CMYK OK 217 | Page 107 218 | 0.00811 0.00811 0.00811 0.00936 CMYK OK 219 | Page 108 220 | 0.00000 0.00000 0.00000 0.02819 CMYK OK 221 | Page 109 222 | 0.00514 0.00514 0.00514 0.03589 CMYK OK 223 | Page 110 224 | 0.00000 0.00000 0.00000 0.04802 CMYK OK 225 | Page 111 226 | 0.01465 0.01465 0.01465 0.01343 CMYK OK 227 | Page 112 228 | 0.00367 0.00367 0.00367 0.02988 CMYK OK 229 | Page 113 230 | 0.00485 0.00484 0.00485 0.03057 CMYK OK 231 | Page 114 232 | 0.00000 0.00000 0.00000 0.03723 CMYK OK 233 | Page 115 234 | 0.00241 0.00241 0.00241 0.03926 CMYK OK 235 | Page 116 236 | 0.00000 0.00000 0.00000 0.04579 CMYK OK 237 | Page 117 238 | 0.00000 0.00000 0.00000 0.03741 CMYK OK 239 | Page 118 240 | 0.00000 0.00000 0.00000 0.04701 CMYK OK 241 | Page 119 242 | 0.02436 0.03515 0.02055 0.03327 CMYK OK 243 | Page 120 244 | 0.00000 0.00000 0.00000 0.03042 CMYK OK 245 | Page 121 246 | 0.00000 0.00000 0.00000 0.04902 CMYK OK 247 | Page 122 248 | 0.00000 0.00000 0.00000 0.03867 CMYK OK 249 | Page 123 250 | 0.01975 0.01975 0.01893 0.01642 CMYK OK 251 | Page 124 252 | 0.01392 0.01392 0.01392 0.02290 CMYK OK 253 | Page 125 254 | 0.00550 0.00550 0.00550 0.03188 CMYK OK 255 | Page 126 256 | 0.00535 0.00535 0.00535 0.04584 CMYK OK 257 | Page 127 258 | 0.00000 0.00000 0.00000 0.04957 CMYK OK 259 | Page 128 260 | 0.00000 0.00000 0.00000 0.05514 CMYK OK 261 | Page 129 262 | 0.01050 0.01050 0.01050 0.03927 CMYK OK 263 | Page 130 264 | 0.00487 0.00487 0.00487 0.04204 CMYK OK 265 | Page 131 266 | 0.00000 0.00000 0.00000 0.03397 CMYK OK 267 | Page 132 268 | 0.01164 0.01164 0.01164 0.00855 CMYK OK 269 | Page 133 270 | 0.00000 0.00000 0.00000 0.05172 CMYK OK 271 | Page 134 272 | 0.00379 0.00379 0.00379 0.03688 CMYK OK 273 | Page 135 274 | 0.01229 0.01270 0.01179 0.01835 CMYK OK 275 | Page 136 276 | 0.00000 0.00000 0.00000 0.02675 CMYK OK 277 | Page 137 278 | 0.00000 0.00000 0.00000 0.03547 CMYK OK 279 | Page 138 280 | 0.00873 0.00912 0.00789 0.00664 CMYK OK 281 | Page 139 282 | 0.00267 0.00267 0.00217 0.03658 CMYK OK 283 | Page 140 284 | 0.01000 0.00999 0.00887 0.02353 CMYK OK 285 | Page 141 286 | 0.00711 0.00711 0.00711 0.03955 CMYK OK 287 | Page 142 288 | 0.00287 0.00287 0.00287 0.02844 CMYK OK 289 | Page 143 290 | 0.01024 0.01024 0.01024 0.04371 CMYK OK 291 | Page 144 292 | 0.00000 0.00000 0.00000 0.03779 CMYK OK 293 | Page 145 294 | 0.00955 0.00955 0.00955 0.03886 CMYK OK 295 | Page 146 296 | 0.00717 0.00845 0.00719 0.02302 CMYK OK 297 | Page 147 298 | 0.00000 0.00000 0.00000 0.04944 CMYK OK 299 | Page 148 300 | 0.00000 0.00000 0.00000 0.03742 CMYK OK 301 | Page 149 302 | 0.00000 0.00000 0.00000 0.05165 CMYK OK 303 | Page 150 304 | 0.01718 0.01907 0.01717 0.03111 CMYK OK 305 | Page 151 306 | 0.00000 0.00000 0.00000 0.03934 CMYK OK 307 | Page 152 308 | 0.00000 0.00000 0.00000 0.03739 CMYK OK 309 | Page 153 310 | 0.00000 0.00000 0.00000 0.02535 CMYK OK 311 | Page 154 312 | 0.00000 0.00000 0.00000 0.03882 CMYK OK 313 | Page 155 314 | 0.00000 0.00000 0.00000 0.03680 CMYK OK 315 | Page 156 316 | 0.00000 0.00000 0.00000 0.04460 CMYK OK 317 | Page 157 318 | 0.00356 0.00356 0.00356 0.02466 CMYK OK 319 | Page 158 320 | 0.00429 0.00429 0.00429 0.03418 CMYK OK 321 | Page 159 322 | 0.00000 0.00000 0.00000 0.04052 CMYK OK 323 | Page 160 324 | 0.00000 0.00000 0.00000 0.03296 CMYK OK 325 | Page 161 326 | 0.00000 0.00000 0.00000 0.03765 CMYK OK 327 | Page 162 328 | 0.00000 0.00000 0.00000 0.04629 CMYK OK 329 | Page 163 330 | 0.00773 0.00773 0.00773 0.03861 CMYK OK 331 | Page 164 332 | 0.00000 0.00000 0.00000 0.02673 CMYK OK 333 | Page 165 334 | 0.00000 0.00000 0.00000 0.03616 CMYK OK 335 | Page 166 336 | 0.01255 0.01255 0.00885 0.02983 CMYK OK 337 | Page 167 338 | 0.00834 0.00834 0.00834 0.03707 CMYK OK 339 | Page 168 340 | 0.00000 0.00000 0.00000 0.04825 CMYK OK 341 | Page 169 342 | 0.01501 0.01501 0.01501 0.01823 CMYK OK 343 | Page 170 344 | 0.00000 0.00000 0.00000 0.05533 CMYK OK 345 | Page 171 346 | 0.00000 0.00000 0.00000 0.04881 CMYK OK 347 | Page 172 348 | 0.00000 0.00000 0.00000 0.04636 CMYK OK 349 | Page 173 350 | 0.00000 0.00000 0.00000 0.04848 CMYK OK 351 | Page 174 352 | 0.00000 0.00000 0.00000 0.02835 CMYK OK 353 | Page 175 354 | 0.00000 0.00000 0.00000 0.03611 CMYK OK 355 | Page 176 356 | 0.00000 0.00000 0.00000 0.04674 CMYK OK 357 | Page 177 358 | 0.01541 0.01038 0.01541 0.03239 CMYK OK 359 | Page 178 360 | 0.00000 0.00000 0.00000 0.04890 CMYK OK 361 | Page 179 362 | 0.00000 0.00000 0.00000 0.03441 CMYK OK 363 | Page 180 364 | 0.00000 0.00000 0.00000 0.03453 CMYK OK 365 | Page 181 366 | 0.00000 0.00000 0.00000 0.04370 CMYK OK 367 | Page 182 368 | 0.00000 0.00000 0.00000 0.04756 CMYK OK 369 | Page 183 370 | 0.00000 0.00000 0.00000 0.03293 CMYK OK 371 | Page 184 372 | 0.00000 0.00000 0.00000 0.05284 CMYK OK 373 | Page 185 374 | 0.00000 0.00000 0.00000 0.04948 CMYK OK 375 | Page 186 376 | 0.00000 0.00000 0.00000 0.05811 CMYK OK 377 | Page 187 378 | 0.00000 0.00000 0.00000 0.04044 CMYK OK 379 | Page 188 380 | 0.00000 0.00000 0.00000 0.03086 CMYK OK 381 | Page 189 382 | 0.00000 0.00000 0.00000 0.04445 CMYK OK 383 | Page 190 384 | 0.00000 0.00000 0.00000 0.03530 CMYK OK 385 | Page 191 386 | 0.00000 0.00000 0.00000 0.05027 CMYK OK 387 | Page 192 388 | 0.00000 0.00000 0.00000 0.04463 CMYK OK 389 | Page 193 390 | 0.00000 0.00000 0.00000 0.02568 CMYK OK 391 | Page 194 392 | 0.00000 0.00000 0.00000 0.02042 CMYK OK 393 | Page 195 394 | 0.00000 0.00000 0.00000 0.04732 CMYK OK 395 | Page 196 396 | 0.00000 0.00000 0.00000 0.04756 CMYK OK 397 | Page 197 398 | 0.00000 0.00000 0.00000 0.05085 CMYK OK 399 | Page 198 400 | 0.00000 0.00000 0.00000 0.04286 CMYK OK 401 | Page 199 402 | 0.00000 0.00000 0.00000 0.04225 CMYK OK 403 | Page 200 404 | 0.00000 0.00000 0.00000 0.04703 CMYK OK 405 | Page 201 406 | 0.00000 0.00000 0.00000 0.05156 CMYK OK 407 | Page 202 408 | 0.00000 0.00000 0.00000 0.04379 CMYK OK 409 | Page 203 410 | 0.00000 0.00000 0.00000 0.04623 CMYK OK 411 | Page 204 412 | 0.00000 0.00000 0.00000 0.04895 CMYK OK 413 | Page 205 414 | 0.00000 0.00000 0.00000 0.04292 CMYK OK 415 | Page 206 416 | 0.00000 0.00000 0.00000 0.02067 CMYK OK 417 | -------------------------------------------------------------------------------- /intro.lhs: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | %include thesis.fmt 4 | 5 | \chapter{Introduction} 6 | \label{chap:intro} 7 | 8 | The theory of \term{algebraic data types} has had a profound impact on 9 | the practice of programming, especially in functional languages. The 10 | basic idea is that types can be built up \term{algebraically} from a 11 | small set of primitive types and combinators: a unit type, base types, 12 | sums (\ie\ tagged unions), products (\ie\ tupling), and recursion. 13 | Most languages with support for algebraic data types also add 14 | bells and whistles for convenience (such as labeled products and sums, 15 | convenient syntax for defining types as a ``sum of products'', and 16 | pattern matching), but the basic idea remains unchanged. 17 | 18 | For example, in Haskell~\citep{haskell} we can define a type of binary 19 | trees with integer values stored in the leaves as follows: 20 | \begin{code} 21 | data Tree = Leaf Int 22 | | Branch Tree Tree 23 | \end{code} 24 | Algebraically, we can think of this as defining the type which is the 25 | least solution to the equation $T = \Int + T \times T$. This 26 | description says that a |Tree| is either an |Int| (tagged with |Leaf|) 27 | or a pair of two recursive occurrences of |Trees| (tagged with 28 | |Branch|). 29 | 30 | This algebraic view of data types has many benefits. From a 31 | theoretical point of view, recursive algebraic data types can be 32 | interpreted as \emph{initial algebras} (or \emph{final coalgebras}), 33 | which gives rise to an entire theory---both semantically elegant and 34 | practical---of programming with recursive data structures via 35 | \term{folds} and \term{unfolds} \citep{bananas, gibbons-calcfp}. A 36 | fold gives a principled way to compute a ``summary value'' from a data 37 | structure; dually, an unfold builds up a data structure from an 38 | initial ``seed value''. % For example, a fold for |Tree| can be 39 | % implemented as 40 | % \begin{code} 41 | % treeFold :: (Int -> a) -> (a -> a -> a) -> Tree -> a 42 | % treeFold f _ (Leaf i) = f i 43 | % treeFold f g (Branch l r) = g (treeFold f g l) (treeFold f g r) 44 | % \end{code} 45 | % The |treeFold| function captures the essential pattern of recursion 46 | % over |Tree| data structures. We can use |treeFold| to, say, compute 47 | % the product of all the |Int| values stored in a tree: 48 | % \begin{code} 49 | % treeProd :: Tree -> Int 50 | % treeProd = treeFold id (*) 51 | % \end{code} 52 | % Indeed, |treeFold| is \emph{universal} in the sense that anything we 53 | % might wish to compute from a |Tree| can be accomplished with 54 | % |treeFold|. Such folds are guaranteed to exist for any algebraic data 55 | % type---in fact, it is not hard to automatically generate the fold for 56 | % a data type, given its algebraic description. There are several 57 | % Haskell libraries which can do this generation, including 58 | % |derive|~\citep{derive} and |DrIFT|~\citep{DrIFT}. The Charity 59 | % programming language~\citep{charity} was also designed so that all 60 | % computation over inductive types was based on automatically-derived 61 | % folds. 62 | 63 | % % Folds are ubiquitous---even languages without direct support for 64 | % % algebraic data types often make use of them. For example, \emph{How 65 | % % to Design Programs}~\cite[\S 9.4]{HTDP}, a popular introductory 66 | % % programming text using the Scheme (now Racket~\citep{racket}) 67 | % % programming language, teaches students to write folds over recursive 68 | % % data types (although it does not use that terminology). The 69 | % % \emph{visitor pattern}~\citep{GoF,palsberg:essence}, often used in 70 | % % object-oriented languages, can also be seen as a type of fold. 71 | 72 | Folds (and unfolds) satisfy theorems which aid in transforming, 73 | optimizing, and reasoning about programs defined in terms of them. As 74 | a simple example, a map (\ie\ applying the same function to every 75 | element of a data structure) followed by a fold can always be 76 | rewritten as a single fold. These laws, and others, allow Haskell 77 | compilers to eliminate intermediate data structures through an 78 | optimization called deforestation~\citep{Wadler:1988,Gill93ashort}. 79 | 80 | An algebraic view of data types also enables \term{datatype-generic 81 | programming}---writing functions that operate generically over 82 | values of \emph{any} algebraic data type by examining its algebraic 83 | structure. For example, the following function (defined using Generic 84 | Haskell-like 85 | syntax~\citep{Hinze-2000-generic-Haskell,generic-haskell}) finds the 86 | product of all the |Int| values contained in a value of \emph{any} 87 | algebraic data type. 88 | \begin{spec} 89 | genProd {| Int |} i = i 90 | genProd {| Sum t1 t2 |} (Inl x) = genProd {| t1 |} x 91 | genProd {| Sum t1 t2 |} (Inr x) = genProd {| t2 |} x 92 | genProd {| Prod t1 t2 |} (x,y) = genProd {| t1 |} x * genProd {| t2 |} y 93 | genProd {| _ |} _ = 1 94 | \end{spec} 95 | Datatype-generic programming is a powerful technique for reducing 96 | boilerplate, made possible by the algebraic view of data types, and 97 | supported by Haskell libraries and 98 | extensions~\citep{Jansson:PolyP,Lammel:SYB,Cheney:LIG,weirich:replib,weirich:erasure}. 99 | 100 | The theory of \term{combinatorial species} has been similarly 101 | successful in the area of combinatorics. First introduced by 102 | \citet{joyal}, it is a unified theory of \term{combinatorial 103 | structures} or \term{shapes}. Its immediate goal was to generalize 104 | the existing theory of \term{generating functions}, a central tool in 105 | enumerative combinatorics (the branch of mathematics concerned with 106 | counting abstract structures). More broadly, it introduced a framework--- 107 | similar to algebraic data types---in which many combinatorial objects 108 | of interest could be constructed algebraically, and in which those 109 | algebraic descriptions can be used to reason about, manipulate, and 110 | derive properties of the combinatorial structures. The theory of 111 | species has been used to give elegant new proofs of classical results 112 | (for example, Cayley's theorem giving the number of labelled 113 | trees~\citep{joyal}), and some new results as well (for example, a 114 | combinatorial interpretation and proof of Lagrange 115 | inversion~\citep[Chap. 3]{bll}). 116 | 117 | Not only do the theory of algebraic data types and the theory of 118 | combinatorial species have a similar algebraic flavor in general, but 119 | the specific details are tantalizingly parallel. For example, the 120 | \emph{species} of binary parenthesizations (\ie binary trees with data 121 | stored in the leaves) can be defined by the recursive species 122 | equation \[ \Sp{P} = \X + \Sp{P} \cdot \X \cdot \Sp{P} \] which 123 | closely parallels the Haskell definition given above. The theory of 124 | functional programming languages has a long history of fruitful 125 | borrowing from pure mathematics, as, for example, in the case of 126 | category theory; so the fruit seems ripe for picking in the case of 127 | combinatorial species. 128 | 129 | There has already been some initial progress in this direction. The 130 | connection between species and computation was first explored by 131 | Flajolet, Salvy, and Zimmermann, with their work on 132 | LUO~\citep{FlajoletSalvyZimmermann1989a,FlSa95}, allowing the use of 133 | species in automated algorithm analysis. However, they carried out 134 | their work in a dynamically typed setting. 135 | 136 | The first to think about species specifically in the context of 137 | strongly typed functional programming were 138 | \citet{Carette_Uszkay_2008_species}, who explored the potential of 139 | species as a framework to extend the usual notion of algebraic data 140 | types, and described some preliminary work adding species types to 141 | Haskell. More recently, Joachim Kock has done some theoretical work 142 | generalizing species, ``container types'', and other notions 143 | of ``extended data type''~\citep{kock2012data}. (Most interestingly, 144 | Kock's work points to the central relevance of homotopy type 145 | theory~\citep{hottbook}, which also emerges as a central player in 146 | this dissertation.) 147 | 148 | However, there has still yet to be a comprehensive treatment of the 149 | precise connections between the theory of algebraic data types and the 150 | theory of combinatorial species. \citet{bll} give a comprehensive 151 | treatment of the theory of species, but their book is written 152 | primarily from a mathematical point of view and is only tangentially 153 | concerned with issues of computation. It is also written in a style 154 | that makes it relatively inaccessible to researchers in the 155 | programming languages community---it assumes mathematical background 156 | that many PL researchers do not have. 157 | 158 | The investigations in this dissertation, therefore, all arise from 159 | considering the central question, \textbf{what is the connection 160 | between species and algebraic data types?} A precise connection 161 | between the two would have exciting implications. It would allow 162 | taking much of the mathematical theory developed on the basis of 163 | species---for example, enumeration, exhaustive generation, and uniform 164 | random generation of structures via Boltzmann sampling 165 | \citep{Duchon-2002-Boltzmann, duchon-2004-boltzmann, 166 | flajolet2007boltzmann, roussel2009boltzmann}---and applying it 167 | directly to algebraic data types. It is also possible that exploring 168 | the theory of species in an explicitly computational setting will 169 | yield additional insights into the combinatorial setting. 170 | 171 | There is also the promise of using species not just as a tool to 172 | understand and work with algebraic data types in better ways, but 173 | directly as a foundation upon which to build (a richer notion of) 174 | algebraic data types. This is particularly interesting due to the 175 | ability of the theory of species to talk about structures which do not 176 | correspond to algebraic data types in the usual sense---particularly 177 | structures which involve \term{symmetry} and \term{sharing}. 178 | 179 | A data structure with \term{symmetry} is one whose elements can be 180 | permuted in certain ways without affecting its identity. For example, 181 | permuting the elements of a bag always results in the same bag. 182 | Likewise, the elements of an ordered cycle may be cyclically permuted 183 | without affecting the cycle. By contrast, a typical binary tree 184 | structure has no symmetry: any permutation of the elements may result 185 | in a different tree. In fact, every structure of an algebraic 186 | data type has no symmetry, since every element in an algebraic 187 | structure can be uniquely identified by a \emph{path} from the root of 188 | the structure to the element, so permuting the elements always results 189 | in an observably different value. 190 | 191 | A data structure with \term{sharing} is one in which different parts 192 | of the structure may refer to the same subpart. For example, consider 193 | the type of undirected, simple graphs, consisting of a set of vertices 194 | together with a set of edges connecting pairs of vertices. In 195 | general, such graphs may involve sharing, since multiple edges may 196 | refer to the same vertex, and vice versa. 197 | 198 | In a language with first-class pointers, creating data structures with 199 | sharing is relatively easy, although writing correct programs that 200 | manipulate them may be another story. The same holds true for many 201 | languages without first-class pointers as well. Creating data 202 | structures with sharing in the heap is not difficult in Haskell, but 203 | it may be difficult or even impossible to express the programs that 204 | manipulate them. 205 | 206 | For example, in the following code, 207 | \begin{spec} 208 | t = let t3 = Leaf 1 209 | t2 = Branch t3 t3 210 | t1 = Branch t2 t2 211 | in Branch t1 t1 212 | \end{spec} 213 | only one ``Leaf'' and three ``Branch'' structures will be allocated in 214 | memory. The tree |t2| will be shared in the node |t1|, which will 215 | itself be shared in the node |t|. Furthermore, in a lazy language 216 | such as Haskell, recursive ``knot-tying'' allows even cyclic 217 | structures to be created. For example, 218 | \begin{spec} 219 | nums = 1 : 2 : 3 : nums 220 | \end{spec} 221 | actually creates a cycle of three numbers in memory. 222 | 223 | Semantically, however, |t| is a tree, not a DAG, and |nums| is an 224 | infinite list, not a cycle. It is impossible to observe the sharing 225 | (without resorting to compiler-specific 226 | tricks~\citep{Gill-2009-sharing}) in either of these examples. Even 227 | worse, applying standard functions such as |fold| and |map| destroys 228 | any sharing that might have been present and risks non-termination. 229 | 230 | When programmers wish to work with ``non-regular'' data 231 | types involving symmetry or sharing, they must instead work with 232 | suitable \emph{encodings} of them as regular data types. For example, 233 | a bag may be represented as a list, or a graph as an adjacency matrix. 234 | However, this encoding puts extra burden on the programmer, both to ensure that 235 | invariants are maintained (\eg\ that the adjacency matrix for an 236 | undirected graph is always symmetric) and that functions respect 237 | abstract structure (\eg\ any function on bags should give the same 238 | result when given permutations of the same elements as inputs). 239 | 240 | The promise of using the theory of species as a foundation for data 241 | types is to be able to declare data types with symmetry and sharing, 242 | with built-in compiler support ensuring that working with such data 243 | types is ``correct by construction''. 244 | 245 | The grand vision of this research program, then, is to create and 246 | exploit a bridge between the theory of species and the theory and 247 | practice of programming languages. This dissertation represents just a 248 | first step in this larger program, laying the theoretical groundwork 249 | necessary for its continued pursuit. 250 | 251 | \later{general paragraph here about equality vs isomorphism and so on? 252 | Big themes yet to mention: Principle of equivalence. Set theory vs 253 | type theory, constructive foundations.} 254 | 255 | To even get started building a bridge between species and data types 256 | requires more work than one might na\"ively expect. The fundamental 257 | problem is that the theory of species is traditionally couched in 258 | untyped, classical set theory. To talk about data types, however, we 259 | want to work in \emph{typed} and \emph{constructive} foundations. 260 | Attempting to port species to a typed, constructive setting reveals 261 | many implicit assumptions that must be made explicit, as well as 262 | implicit uses of reasoning principles, such as the axiom of choice, 263 | which are incompatible with constructive foundations. The bulk of 264 | \pref{chap:equality} defines the foundational groundwork which makes 265 | it possible to talk about species in a typed, constructive setting. 266 | In particular, the biggest issues are the difference between 267 | \term{equality} and \term{isomorphism}, and the constructive encoding 268 | of \term{finiteness} (which is itself related to issues of equality 269 | and isomorphism). The recently developed \term{homotopy type theory} 270 | \citep{hottbook} turns out to be exactly what is wanted to encode 271 | everything in a parsimonious way. The development of cardinal-finite 272 | sets in HoTT (along with a related concept I term ``manifestly finite 273 | sets'') is novel, as is the development of HoTT analogues of 274 | the set-theoretic groupoids $\B$ and $\P$. 275 | 276 | \pref{chap:species} presents the theory of species itself. 277 | Much of the chapter is not novel in a technical sense. One of the 278 | main contributions of the chapter, instead, is simply to organize and 279 | present some relevant aspects of the theory for a functional programming 280 | audience. The existing species literature is almost entirely written 281 | for either hard-core combinatorialists or hard-core category 282 | theorists, and is not very accessible to the typical FP practitioner. 283 | Any attempt to make species relevant to computer scientists must 284 | therefore first address this accessibility gap. 285 | 286 | \pref{chap:species} does also make a few novel technical 287 | contributions---for example, a characterization of equipotence in terms 288 | of manifestly finite sets, and a careful discussion of finite versus 289 | infinite families of structures and the relation to species 290 | composition. Most importantly, since \pref{chap:species} is already 291 | attempting to present at least two different variants of species---the 292 | traditional definition based on set theory, and a novel variant based 293 | on homotopy type theory---it ``bites the bullet'' and considers 294 | \emph{arbitrary} functor categories, elucidating the categorical 295 | properties required to support each species operation. Although many 296 | individual species generalizations have been considered in the past, 297 | this systematic consideration of the minimal features needed to 298 | support each operation is novel. This allows operations to be 299 | defined for whole classes of species-like things at once, and in some 300 | cases even allows for species-like things to be constructed in a 301 | modular way, by applying constructions known to preserve the required 302 | properties. 303 | 304 | \pref{chap:variants} goes on to explore particular species variants, 305 | evaluated through the framework of \pref{chap:species}. Some 306 | variants have already been considered in the literature; others, such 307 | as the notion of copartial species considered in 308 | \pref{sec:copartial-species-sec}, are novel. 309 | 310 | Finally, \pref{chap:labelled} considers extending species to 311 | \term{labelled data structures}, which intuitively consist of a 312 | labelled shape, or species structure, paired with a mapping from 313 | labels to data elements. The notion of \term{analytic functors}, as 314 | introduced by \citet{joyal86}, turns out to be exactly the right 315 | framework in which to consider labelled data structures. Analytic 316 | functors can be most generally defined in terms of \term{Kan 317 | extensions}, and so the chapter opens with a presentation of Kan 318 | extensions, once again aimed at functional programmers. Analytic 319 | functors are considered in the context of copartial species, which, 320 | can serve as a foundation for further work codifying data structures 321 | backed by memory storage (in applications where the memory layout 322 | really matters, \eg linear algebra libraries), and also for partial 323 | species, which may help model situations where data need not be 324 | associated to every label. 325 | -------------------------------------------------------------------------------- /liftproof.lhs: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | %include thesis.fmt 4 | 5 | \chapter{Lifting monoids} 6 | \label{chap:lifting-monoids} 7 | 8 | \numberwithin{thm}{chapter} 9 | 10 | This chapter contains a detailed proof showing how monoids (and many 11 | other structures of interest) can be lifted from a category $\Str$ to 12 | a functor category $\fc \Lab \Str$. The high-level ideas of this 13 | construction seem to be ``folklore'', but I have been unable to find 14 | any detailed published account, so it seemed good to include some 15 | proofs here for completeness. Unfortunately, the proof presented here 16 | is still incomplete; as future work I hope to completely understand 17 | the proof in detail. 18 | 19 | We must first develop some technical machinery regarding functor 20 | categories. In particular, we show how to lift objects, functors, and 21 | natural transformations based on the category $\Str$ into related ones 22 | based on the functor category $\Str^\Lab$. 23 | 24 | \begin{lem} \label{lem:lift-object} 25 | An object $D \in \D$ lifts to an object (\ie a functor) $D^\C \in 26 | \D^\C$, defined as the constant functor $\Delta_D$. 27 | \end{lem} 28 | 29 | \begin{lem} \label{lem:lift-functor} 30 | Any functor $F : \D \to \E$ lifts to a functor $F^\C : \D^\C \to 31 | \E^\C$ given by postcomposition with $F$. That is, $F^\C(G) = F 32 | \comp G = FG$, and $F^\C(\alpha) = F\alpha$. 33 | \end{lem} 34 | 35 | \begin{proof} 36 | $F\alpha$ denotes the ``right whiskering'' of $\alpha$ by $F$, 37 | \[ \xymatrix{ \C \rtwocell^G_H{\alpha} & \D \ar[r]^F & \E. } \] 38 | $F^\C$ preserves identities since 39 | \[ \xymatrix{ \C \ar[r]^G & \D \ar[r]^F & \E } \] 40 | can be seen as both $F \id_G$ and $\id_{FG}$, and it preserves 41 | composition since 42 | \[ \xymatrixrowsep{1pc} 43 | \xymatrix{ \C \ruppertwocell{\alpha} \rlowertwocell{\beta} \ar[r] 44 | & \D \ar[r]^F & \E } 45 | = 46 | \vcenter{ 47 | \xymatrix{ \C \ruppertwocell{\alpha} \ar[r] & \D \ar[r]^F & \E \\ 48 | \C \rlowertwocell{\beta} \ar[r] & \D \ar[r]_F & \E } 49 | } 50 | \] \later{Improve this picture with composition symbols?} 51 | by the interchange law for horizontal and vertical composition. 52 | \end{proof} 53 | 54 | Natural transformations lift in the same way: 55 | 56 | \begin{lem} \label{lem:lift-nt} Given functors $F,G : \D \to \E$, 57 | any natural transformation $\alpha : \nt F G$ lifts to a natural 58 | transformation $\alpha^\C : \nt {F^\C} {G^\C} : \D^\C \to \E^\C$ 59 | given by postcomposition with $\alpha$. That is, the component of 60 | $\alpha^\C$ at $H :\C \to \D$ is $\alpha^\C_H = \alpha H$. Moreover, 61 | if $\alpha$ is an isomorphism then so is $\alpha^\C$. 62 | \end{lem} 63 | 64 | \begin{proof} 65 | Here $\alpha H$ denotes the ``left whiskering'' of $\alpha$ by $H$, 66 | \[ \xymatrix{ \C \ar[r]^H & \D \rtwocell^F_G{\alpha} & \E. } \] 67 | Note that $\alpha^\C_H$ should be a morphism $\mor {F^\C H} {G^\C 68 | H}$ in $\E^\C$, that is, a natural transformation $\nt {FH} {GH}$, 69 | so $\alpha H$ has the right type. The naturality square for 70 | $\alpha^\C$ is 71 | \[ \xymatrix { 72 | FH \ar[r]^{\alpha^\C_H} \ar[d]_{F\beta} 73 | & GH \ar[d]^{G\beta} 74 | \\ FJ \ar[r]_{\alpha^\C_J} 75 | & GJ 76 | } 77 | \] 78 | which commutes by naturality of $\alpha$: at any particular $C \in 79 | \C$ the above diagram reduces to: 80 | \[ \xymatrix{ 81 | FHC \ar[r]^{\alpha_{HC}} \ar[d]_{F\beta_C} 82 | & GHC \ar[d]^{G\beta_C} 83 | \\ FJC \ar[r]_{\alpha_{JC}} 84 | & GJC 85 | } 86 | \] 87 | If $\alpha$ is an isomorphism, then $(\alpha^{-1})^\C$ is the 88 | inverse of $\alpha^\C$: for any $H$, $\alpha^{-1}H \cdot \alpha H = 89 | (\alpha^{-1} \cdot \alpha) H = \id_{FH}$. 90 | \[ {\xymatrixcolsep{5pc} \xymatrix{ \C \ar[r]^H & \D 91 | \ruppertwocell^F{\mathrlap{\alpha}} \ar[r] \rlowertwocell_F{\mathrlap{\alpha^{-1}}} & \E 92 | }} 93 | = 94 | \xymatrix{ \C \ar[r]^H & \D \ar[r]^F & \E } 95 | \] 96 | \end{proof} 97 | 98 | Finally, we need to know that \emph{laws}---expressed as commutative 99 | diagrams---also lift appropriately from $\D$ to $\D^\C$. For example, 100 | if we lift the functor and natural transformations defining a monoid 101 | in $\D$, we need to know that the resulting lifted functor and lifted 102 | natural transformations still define a valid monoid in $\D^\C$. 103 | 104 | The first step is to understand how to appropriately encode laws as 105 | categorical objects. Consider a typical commutative diagram, such as 106 | the following diagram expressing the coherence of the associator for a 107 | monoidal category. The parameters to all the instances of $\alpha$ 108 | have been written out explicitly, to make the subsequent discussion 109 | clearer, although in common practice these would be left implicit. 110 | \[ \xymatrix{ & ((A \oplus B) \oplus C) \oplus D 111 | \ar[dl]_{\alpha_{A,B,C} \oplus \id_D} \ar[dr]^{\alpha_{A \oplus 112 | B,C,D}} & \\ (A \oplus (B \oplus C)) \oplus D 113 | \ar[d]_{\alpha_{A,B \oplus C,D}} & & (A \oplus B) \oplus (C \oplus 114 | D) \ar[d]^{\alpha_{A,B,C \oplus D}} \\ A \oplus ((B \oplus C) \oplus 115 | D) \ar[rr]_{\id_A \oplus \alpha_{B,C,D}} & & A \oplus (B \oplus (C 116 | \oplus D)) } \] There are two important points to note. The first 117 | is that any commutative diagram has a particular \emph{shape} and can 118 | be represented as a functor from an ``index category'' representing 119 | the shape (in this case, a category having five objects and morphisms 120 | forming a pentagon, along with the required composites) into the 121 | category in which the diagram is supposed to live. Such a functor will 122 | pick out certain objects and morphisms of the right ``shape'' in the 123 | target category, and the functor laws will ensure that the target 124 | diagram commutes in the same ways as the index category. (This much 125 | should be familiar to anyone who has studied abstract limits and 126 | colimits.) The second point is that this diagram, like many such 127 | diagrams, is really supposed to hold for \emph{all} objects $A$, $B$, 128 | $C$, $D$. So instead of thinking of this diagram as living in a 129 | category $\C$, where the vertices of the diagram are objects of $\C$ 130 | and the edges are morphisms, we can think of it as living in $\fc 131 | {\C^4} \C$, where the vertices are \emph{functors} $\C^4 \to \C$ (for 132 | example, the top vertex is the functor which takes the quadruple of 133 | objects $(A,B,C,D)$ and sends them to the object $((A \oplus B) \oplus 134 | C) \oplus D$), and the edges are natural transformations. 135 | 136 | All told, then, we can think of a typical diagram $D$ in $\C$ as a 137 | functor $D : J \to (\fc {\C^A} \C)$, where $A$ is some (discrete) 138 | category recording the arity of the diagram. 139 | 140 | \begin{lem} 141 | Any diagram $D : J \to (\fc {\C^A} \C)$ in $\C$ lifts to a diagram 142 | $D^\D : J \to (\fc {(\C^\D)^A} {\C^\D})$ in $\C^\D$. 143 | \end{lem} 144 | 145 | \later{See Barr and Wells theory of sketches? (from Jacques)} 146 | \begin{proof} 147 | This amounts to implementing a higher-order function with the 148 | type \[ (J \to (A \to \C) \to \C) \to J \to (A \to \D \to \C) \to \D 149 | \to \C \] which can be easily done as follows: \[ \Phi\ D\ j\ g\ d = 150 | D\ j\ (\fun a {g\ a\ d}). \] Of course there are some technical 151 | conditions to check, but they all fall out easily. 152 | \end{proof} 153 | 154 | At this point there is a gap in the proof. To know that this lifting 155 | does the right thing, one must show that the lifted diagram defined 156 | above is ``about'' (\ie has as its vertices and edges) the lifted 157 | versions of the vertices and edges of the original diagram. Even this 158 | is still not quite enough; to really know that the lifted diagram 159 | ``says the same thing'' as the unlifted diagram, we need to show not 160 | just that the vertices and edges of the lifted diagram are lifted 161 | versions of the original diagram's vertices and edges, but that these 162 | lifted vertices and edges are themselves composed of lifted versions 163 | of the components of the originals. For example, we want to ensure 164 | that the lifting of the example diagram shown above still expresses 165 | coherence of the lifted associator with respect to the lifted tensor 166 | product. It is not enough to have vertices like $(((A \oplus B) \oplus 167 | C) \oplus D)^\D$; we must show this is the same as $((A^\D \oplus^\D 168 | B^\D) \oplus^\D C^\D) \oplus^\D D^\D$, so that it says something about 169 | the lifted tensor product $\oplus^\D$. 170 | 171 | The basic idea would be to write down a formal syntax for the functors 172 | and natural transformations that may constitute a diagram, and show 173 | that the lifting of an expression is the same as the original 174 | expression with its atomic elements each replaced by their lifting. 175 | 176 | Assuming this result for now, we can go on to show how monoids lift 177 | into a functor category. 178 | 179 | \begin{thm} \label{thm:lift-monoid} 180 | Any monoidal structure $(\otimes, I, \alpha, \lambda, \rho)$ on a 181 | category $\Str$ lifts pointwise to a monoidal structure $(\otimes^\Lab, 182 | I^\Lab, \alpha^\Lab, \lambda^\Lab, \rho^\Lab)$ on the functor category 183 | $\fc \Lab \Str$. 184 | \end{thm} 185 | 186 | \begin{proof} 187 | Immediate from Propositions \ref{lem:lift-object}, 188 | \ref{lem:lift-functor}, and \ref{lem:lift-nt}, and our assumed 189 | result that diagrams lift to diagrams which ``say the same thing'' 190 | as the original, but say it ``about'' lifted things. 191 | \end{proof} 192 | 193 | In \pref{prop:lift-monoid-simple} it was claimed that this lifting 194 | preserves products, coproducts, symmetry, and distributivity. We can 195 | already show that symmetry and distributivity are preserved: 196 | 197 | \begin{prop} 198 | The lifting defined in \pref{thm:lift-monoid} preserves symmetry. 199 | \end{prop} 200 | 201 | \begin{proof} 202 | Symmetry is given by a natural isomorphism $\all {X Y} {X \otimes Y 203 | \equiv Y \otimes X}$. By our previous assumption, this lifts to a 204 | natural isomorphism $\all {F G} {F \otimes^\Lab G \equiv G 205 | \otimes^\Lab F}$. 206 | \end{proof} 207 | 208 | \begin{prop} 209 | The lifting defined in \pref{thm:lift-monoid} preserves 210 | distributivity. 211 | \end{prop} 212 | 213 | \begin{proof} 214 | In any category with all products and coproducts, there is a natural 215 | transformation $\all {X Y Z} {X \times Y + X \times Z \to X \times 216 | (Y + Z)}$, given by 217 | $\fork{\choice{\pi_1}{\pi_1}}{\choice{\pi_2}{\pi_2}}$. The category 218 | is \term{distributive} if this is an isomorphism. Again by our 219 | assumption about lifting, such an isomorphism lifts to another 220 | natural isomorphism \[ \all {F G H} {(F \times^\Lab G) +^\Lab (F 221 | \times^\Lab H) \to F \times^\Lab (G +^\Lab H)}. \] 222 | \end{proof} 223 | 224 | To show that products and coproducts are preserved requires first 225 | showing that lifting preserves adjunctions. 226 | 227 | \begin{lem} \label{lem:lift-adj} 228 | Let $F : \D \to \E$ and $G : \D \leftarrow \E$ be functors. If $F 229 | \adj G$, then $F^\C \adj G^\C$. 230 | \end{lem} 231 | 232 | \begin{proof} 233 | Since $F \adj G$, assume we have $\gamma_{A,B} : \E(FA, B) \iso 234 | \D(A, GB)$. To show $F^\C \adj G^\C$, we must define a natural 235 | isomorphism $\gamma^\C_{H,J} : \E^\C(F \comp H, J) \iso \D^\C(H, G 236 | \comp J)$. Given $\phi \in \E^\C(FH,J)$, that is, $\phi : \nt {FH} 237 | J : \C \to \E$, and an object $C \in \C$, define \[ 238 | \gamma^\C_{H,J}(\phi)_C = \gamma_{HC,JC}(\phi_C). \] Note that 239 | $\gamma_{HC,JC} : \E(FHC,JC) \iso \D(HC,GJC)$, so it sends $\phi_C 240 | : FHC \to JC$ to a morphism $HC \to GJC$, as required. 241 | 242 | From the fact that $\gamma$ is an isomorphism it thus follows 243 | directly that $\gamma^\C$ is an isomorphism as well. Naturality of 244 | $\gamma^\C$ also follows straightforwardly from naturality of 245 | $\gamma$. For a more detailed proof, see 246 | \citet[pp. 17--18]{hinze2012kan}. 247 | \end{proof} 248 | 249 | \begin{prop} 250 | The lifting defined in \pref{thm:lift-monoid} preserves coproducts 251 | and products. 252 | \end{prop} 253 | 254 | \begin{proof} 255 | Consider a category $\Str$ with coproducts, given by a bifunctor $+ 256 | : \Str \times \Str \to \Str$. Lifting yields a functor $+^\Lab : 257 | (\Str \times \Str)^\Lab \to \Str^\Lab$. Note that $(\Str \times 258 | \Str)^\Lab \iso \Str^\Lab \times \Str^\Lab$, so we may consider 259 | $+^\Lab$ as a bifunctor $\Str^\Lab \times \Str^\Lab \to \Str^\Lab$. 260 | 261 | There is \latin{a priori} no guarantee that $+^\Lab$ has any special 262 | properties, but it turns out that $+^\Lab$ is a coproduct on 263 | $\Str^\Lab$, which we demonstrate as follows. The key idea is that 264 | the property of being a coproduct can be described in terms of an 265 | adjunction: in particular, $+$ is a coproduct if and only if it is 266 | left adjoint to the diagonal functor $\Delta : \Str \to \Str \times 267 | \Str$.\footnote{Proving this standard fact takes a bit of work but 268 | mostly just involves unfolding definitions, and is left as a nice 269 | exercise for the interested reader.} Since lifting preserves 270 | adjunctions (\pref{lem:lift-adj}), we must have $+^\Lab \adj 271 | \Delta^\Lab$. But note we have $\Delta^\Lab : \Str^\Lab \to (\Str 272 | \times \Str)^\Lab \iso \Str^\Lab \times \Str^\Lab$, with 273 | $\Delta^\Lab (F) = \Delta \comp F \iso (F,F)$, so in fact 274 | $\Delta^\Lab$ is the diagonal functor on $\Str^\Lab$. Hence 275 | $+^\Lab$, being left adjoint to the diagonal functor, is indeed a 276 | coproduct on $\Str^\Lab$. 277 | 278 | Of course, this dualizes to products as well, which are 279 | characterized by being right adjoint to the diagonal functor. 280 | \end{proof} 281 | 282 | 283 | -------------------------------------------------------------------------------- /notes.org: -------------------------------------------------------------------------------- 1 | + Include something about lifting type formers from U to U_Fin 2 | -------------------------------------------------------------------------------- /pages.txt: -------------------------------------------------------------------------------- 1 | 1: Gray 2 | 2: Gray 3 | 3: Gray 4 | 4: Gray 5 | 5: Gray 6 | 6: Color 7 | 7: Gray 8 | 8: Gray 9 | 9: Gray 10 | 10: Gray 11 | 11: Gray 12 | 12: Gray 13 | 13: Gray 14 | 14: Gray 15 | 15: Gray 16 | 16: Gray 17 | 17: Gray 18 | 18: Gray 19 | 19: Gray 20 | 20: Gray 21 | 21: Gray 22 | 22: Gray 23 | 23: Gray 24 | 24: Gray 25 | 25: Gray 26 | 26: Gray 27 | 27: Gray 28 | 28: Gray 29 | 29: Gray 30 | 30: Gray 31 | 31: Gray 32 | 32: Gray 33 | 33: Gray 34 | 34: Gray 35 | 35: Gray 36 | 36: Color 37 | 37: Gray 38 | 38: Gray 39 | 39: Gray 40 | 40: Gray 41 | 41: Gray 42 | 42: Gray 43 | 43: Gray 44 | 44: Gray 45 | 45: Color 46 | 46: Gray 47 | 47: Color 48 | 48: Gray 49 | 49: Gray 50 | 50: Gray 51 | 51: Gray 52 | 52: Gray 53 | 53: Gray 54 | 54: Gray 55 | 55: Gray 56 | 56: Color 57 | 57: Color 58 | 58: Gray 59 | 59: Gray 60 | 60: Gray 61 | 61: Gray 62 | 62: Gray 63 | 63: Gray 64 | 64: Color 65 | 65: Gray 66 | 66: Gray 67 | 67: Color 68 | 68: Gray 69 | 69: Color 70 | 70: Gray 71 | 71: Gray 72 | 72: Gray 73 | 73: Gray 74 | 74: Gray 75 | 75: Gray 76 | 76: Gray 77 | 77: Color 78 | 78: Color 79 | 79: Color 80 | 80: Color 81 | 81: Gray 82 | 82: Color 83 | 83: Gray 84 | 84: Gray 85 | 85: Color 86 | 86: Color 87 | 87: Color 88 | 88: Color 89 | 89: Color 90 | 90: Color 91 | 91: Gray 92 | 92: Gray 93 | 93: Gray 94 | 94: Gray 95 | 95: Color 96 | 96: Gray 97 | 97: Gray 98 | 98: Color 99 | 99: Color 100 | 100: Gray 101 | 101: Color 102 | 102: Color 103 | 103: Gray 104 | 104: Gray 105 | 105: Gray 106 | 106: Gray 107 | 107: Color 108 | 108: Gray 109 | 109: Color 110 | 110: Gray 111 | 111: Color 112 | 112: Color 113 | 113: Color 114 | 114: Gray 115 | 115: Color 116 | 116: Gray 117 | 117: Gray 118 | 118: Gray 119 | 119: Color 120 | 120: Gray 121 | 121: Gray 122 | 122: Gray 123 | 123: Color 124 | 124: Color 125 | 125: Color 126 | 126: Color 127 | 127: Gray 128 | 128: Gray 129 | 129: Color 130 | 130: Color 131 | 131: Gray 132 | 132: Color 133 | 133: Gray 134 | 134: Color 135 | 135: Color 136 | 136: Gray 137 | 137: Gray 138 | 138: Color 139 | 139: Color 140 | 140: Color 141 | 141: Color 142 | 142: Color 143 | 143: Color 144 | 144: Gray 145 | 145: Color 146 | 146: Color 147 | 147: Gray 148 | 148: Gray 149 | 149: Gray 150 | 150: Color 151 | 151: Gray 152 | 152: Gray 153 | 153: Gray 154 | 154: Gray 155 | 155: Gray 156 | 156: Gray 157 | 157: Color 158 | 158: Color 159 | 159: Gray 160 | 160: Gray 161 | 161: Gray 162 | 162: Gray 163 | 163: Color 164 | 164: Gray 165 | 165: Gray 166 | 166: Color 167 | 167: Color 168 | 168: Gray 169 | 169: Color 170 | 170: Gray 171 | 171: Gray 172 | 172: Gray 173 | 173: Gray 174 | 174: Gray 175 | 175: Gray 176 | 176: Gray 177 | 177: Color 178 | 178: Gray 179 | 179: Gray 180 | 180: Gray 181 | 181: Gray 182 | 182: Gray 183 | 183: Gray 184 | 184: Gray 185 | 185: Gray 186 | 186: Gray 187 | 187: Gray 188 | 188: Gray 189 | 189: Gray 190 | 190: Gray 191 | 191: Gray 192 | 192: Gray 193 | 193: Gray 194 | 194: Gray 195 | 195: Gray 196 | 196: Gray 197 | 197: Gray 198 | 198: Gray 199 | 199: Gray 200 | 200: Gray 201 | 201: Gray 202 | 202: Gray 203 | 203: Gray 204 | 204: Gray 205 | 205: Gray 206 | 206: Gray 207 | Gray pages: 208 | 1 2 3 4 5 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 37 38 39 40 41 42 43 44 46 48 49 50 51 52 53 54 55 58 59 60 61 62 63 65 66 68 70 71 72 73 74 75 76 81 83 84 91 92 93 94 96 97 100 103 104 105 106 108 110 114 116 117 118 120 121 122 127 128 131 133 136 137 144 147 148 149 151 152 153 154 155 156 159 160 161 162 164 165 168 170 171 172 173 174 175 176 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 209 | Color pages: 210 | 6 36 45 47 56 57 64 67 69 77 78 79 80 82 85 86 87 88 89 90 95 98 99 101 102 107 109 111 112 113 115 119 123 124 125 126 129 130 132 134 135 138 139 140 141 142 143 145 146 150 157 158 163 166 167 169 177 211 | -------------------------------------------------------------------------------- /proposal/Diagrams.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | module Diagrams where 3 | 4 | import Control.Arrow (first, second) 5 | import Data.List.Split 6 | import qualified Data.Map as M 7 | import Data.Maybe 8 | import Data.Tree 9 | import Diagrams.Prelude 10 | import Diagrams.TwoD.Layout.Tree 11 | 12 | 13 | import Diagrams.Backend.Cairo 14 | 15 | mlocColor = blend 0.5 white lightblue 16 | eltColor = blend 0.5 white lightgreen 17 | 18 | mloc m = text (show m) <> circle 0.8 # fc mlocColor 19 | elt x = text (show x) <> square 1.6 # fc eltColor 20 | 21 | arm m n r = ( mloc m # rotateBy (-r) 22 | ||| hrule 1.5 23 | ||| mloc n # rotateBy (-r) 24 | ) 25 | # translateX 3 26 | # rotateBy r 27 | 28 | arms elts = zipWith (\[e1,e2] r -> arm e1 e2 r) (chunksOf 2 elts) [1/8 + 0.001, 1/8+0.001 +1/4 .. 1] 29 | 30 | octo elts = (mconcat (arms elts) <> circle 3) # lw 0.03 31 | 32 | t = Node 3 [Node 4 (map lf [2,1,6]), Node 5 [], Node 0 [lf 7]] 33 | lf x = Node x [] 34 | 35 | tree :: Diagram Cairo R2 36 | tree = renderTree 37 | mloc 38 | (~~) 39 | (symmLayout' (with & slHSep .~ 4 & slVSep .~ 4) t) 40 | # lw 0.03 41 | 42 | drawBinTree :: SymmLayoutOpts (Maybe (Diagram Cairo R2)) 43 | -> BTree (Diagram Cairo R2) -> Diagram Cairo R2 44 | drawBinTree slOpts = drawRTree . symmLayout' slOpts . b2r 45 | 46 | b2r Empty = Node Nothing [] 47 | b2r (BNode a Empty Empty) = Node (Just a) [] 48 | b2r (BNode a l r) = Node (Just a) (map b2r [l,r]) 49 | drawRTree = renderTree' drawNode drawEdge 50 | drawNode Nothing = mempty 51 | drawNode (Just d) = d 52 | drawEdge _ (Nothing,_) = mempty 53 | drawEdge (_,pt1) (_,pt2) = pt1 ~~ pt2 54 | 55 | select :: [a] -> [(a,[a])] 56 | select [] = [] 57 | select (a:as) = (a,as) : (map . second) (a:) (select as) 58 | 59 | subsets :: [a] -> [([a],[a])] 60 | subsets [] = [([],[])] 61 | subsets (a:as) = (map . first) (a:) s ++ (map . second) (a:) s 62 | where s = subsets as 63 | 64 | type Edge = (Int,Int) 65 | type Graph = (M.Map Int P2, [Edge]) 66 | 67 | drawGraph drawLoc (locs, edges) = drawLocs <> drawEdges 68 | where 69 | drawLocs = mconcat . map (\(n,p) -> drawLoc n # moveTo p) . M.assocs $ locs 70 | drawEdges = mconcat . map drawEdge $ edges 71 | drawEdge (i1,i2) = lkup i1 ~~ lkup i2 72 | lkup i = fromMaybe origin $ M.lookup i locs 73 | 74 | gr = drawGraph loc 75 | ( M.fromList 76 | [ (0, 3 & (-1)) 77 | , (1, 8 & 0) 78 | , (2, origin) 79 | , (3, 8 & 2) 80 | , (4, 4 & 2) 81 | , (5, 3 & (-3)) 82 | ] # scale 1.5 83 | , [(2,0), (2,4), (0,4), (4,3), (3,1), (0,1), (0,5)] 84 | ) 85 | -------------------------------------------------------------------------------- /proposal/Shake.hs: -------------------------------------------------------------------------------- 1 | import Development.Shake 2 | import Development.Shake.FilePath 3 | 4 | lhs2TeX = "lhs2TeX" 5 | pdflatex = "pdflatex" 6 | rubber = "rubber" 7 | bibtex = "bibtex" 8 | 9 | main = shake shakeOptions $ do 10 | 11 | want ["proposal.pdf"] 12 | 13 | "*.tex" *> \output -> do 14 | let input = replaceExtension output "lhs" 15 | need [input] 16 | system' lhs2TeX $ ["--poly", "-o", output] ++ [input] 17 | 18 | "*.pdf" *> \output -> do 19 | let input = replaceExtension output "tex" 20 | need [input, "Diagrams.hs", "species.bib", "species.sty"] 21 | system' pdflatex $ ["--enable-write18", input] 22 | system' pdflatex $ ["--enable-write18", input] 23 | -------------------------------------------------------------------------------- /proposal/Species-old.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE TypeSynonymInstances #-} 5 | module Species where 6 | 7 | import Data.List (intersperse) 8 | import Data.Tree 9 | import Diagrams.Backend.Cairo.CmdLine 10 | import Diagrams.Core.Points 11 | import Diagrams.Prelude hiding ((&)) 12 | import Diagrams.TwoD.Layout.Tree 13 | 14 | import Control.Lens ((%~), (&), _head, _last) 15 | 16 | colors = [red, orange, green, blue, purple, brown, grey, black] 17 | 18 | labR = 0.3 19 | arrowGap = 0.2 20 | 21 | labT :: Int -> Diagram Cairo R2 22 | labT n = text (show n) # scale labR <> lab n 23 | 24 | lab :: Int -> Diagram Cairo R2 25 | lab n = lab' (colors !! n) 26 | 27 | lab' c = circle labR 28 | # fc white 29 | # lc c 30 | # lw (labR / 5) 31 | 32 | cyc :: [Int] -> Double -> Diagram Cairo R2 33 | cyc labs r = cyc' (map lab labs) r 34 | 35 | cyc' labs r 36 | = mconcat 37 | . zipWith (\l (p,a) -> l # moveTo p <> a) labs 38 | $ zipWith rotateBy 39 | [1/4, 1/4 + 1/(fromIntegral n) .. ] 40 | (map mkLink labs) 41 | where 42 | n = length labs 43 | mkLink l = ( origin # translateX r 44 | , 45 | ( arc startAngle endAngle 46 | # scale r 47 | <> 48 | eqTriangle 0.1 49 | # translateX r 50 | # rotate endAngle 51 | # fc black 52 | ) 53 | # lw (labR / 10) 54 | ) 55 | startAngle = Rad $ (labR + arrowGap)/r 56 | endAngle = Rad (tau/(fromIntegral n)) - startAngle 57 | 58 | newtype Cyc a = Cyc {getCyc :: [a]} 59 | deriving Functor 60 | 61 | data Pointed a = Plain a | Pointed a 62 | 63 | class Drawable d where 64 | draw :: d -> Diagram Cairo R2 65 | 66 | instance Drawable (Diagram Cairo R2) where 67 | draw = id 68 | 69 | instance Drawable a => Drawable (Cyc a) where 70 | draw (Cyc ls) = cyc' (map draw ls # sized (Width (labR*2))) 1 71 | 72 | instance Drawable a => Drawable [a] where 73 | draw ls = centerX . hcat' with {sep = 0.1} 74 | $ intersperse (arrow 0.5 mempty) (map draw ls) 75 | 76 | instance Drawable a => Drawable (Pointed a) where 77 | draw (Plain a) = draw a 78 | draw (Pointed a) = point (draw a) 79 | 80 | point d = d <> drawSpN Hole # sizedAs (d # scale 5) 81 | 82 | down :: Cyc (Diagram Cairo R2) -> Cyc (Cyc (Pointed (Diagram Cairo R2))) 83 | 84 | down (Cyc ls) = Cyc (map Cyc (pointings ls)) 85 | 86 | pointings [] = [] 87 | pointings (x:xs) = (Pointed x : map Plain xs) : map (Plain x :) (pointings xs) 88 | 89 | elimArrow :: Diagram Cairo R2 90 | elimArrow = (hrule 2 # lw 0.03) 91 | ||| eqTriangle 0.2 # rotateBy (-1/4) # fc black 92 | 93 | arrow len l = 94 | ( l 95 | === 96 | hrule len # lw 0.03 97 | ) 98 | # alignB 99 | ||| 100 | eqTriangle 0.2 # rotateBy (-1/4) # fc black 101 | 102 | x |-| y = x ||| strutX 1 ||| y 103 | 104 | data SpN = Lab Int | Leaf | Hole | Point | Sp (Diagram Cairo R2) CircleFrac | Bag 105 | 106 | type SpT = Tree SpN 107 | 108 | drawSpT' tr slopts 109 | = transform tr 110 | . renderTree' (drawSpN' (inv tr)) drawSpE 111 | . symmLayout' slopts 112 | 113 | drawSpT = drawSpT' (rotation (1/4 :: CircleFrac)) 114 | with {slHSep = 0.5, slVSep = 2} 115 | 116 | drawSpN' :: Transformation R2 -> SpN -> Diagram Cairo R2 117 | drawSpN' tr (Lab n) = lab n # scale 0.5 118 | drawSpN' tr Leaf = circle (labR/2) # fc black 119 | drawSpN' tr Hole = circle (labR/2) # lw (labR / 10) # fc white 120 | drawSpN' tr Point = drawSpN' tr Leaf <> drawSpN' tr Hole # scale 1.7 121 | drawSpN' tr (Sp s f) = ( arc (3/4 - f/2) (3/4 + f/2) 122 | ||| 123 | strutX 0.2 124 | ||| 125 | s # transform tr 126 | ) 127 | # scale 0.3 128 | drawSpN' tr Bag = 129 | ( (text "{" <> square 1 # lw 0) # scale 0.5 ||| strutX (labR/4) 130 | ||| circle (labR/2) # fc black 131 | ||| strutX (labR/4) ||| (text "}" <> square 1 # lw 0) # scale 0.5 132 | ) # centerX 133 | 134 | drawSpN = drawSpN' mempty 135 | 136 | drawSpE (_,p) (Hole,q) = (p ~~ q) # dashing [0.05,0.05] 0 137 | drawSpE (_,p) (_,q) = p ~~ q 138 | 139 | nd x = Node (Sp x (1/2)) 140 | lf x = Node x [] 141 | 142 | {- 143 | main = -- defaultMain (arrow 1 ((text "f" <> strutY 1) # scale 0.5)) 144 | 145 | defaultMain (draw (down (Cyc [lab 0, lab 1, lab 2]))) 146 | -} 147 | 148 | -- defaultMain (draw (Cyc [Cyc [lab 0, lab 4], Cyc [lab 1, lab 2, lab 3]])) 149 | -- (cyc' (replicate 5 (square 0.2 :: Diagram Cairo R2)) 1) 150 | 151 | -- defaultMain (drawSpT (nd 'F' [lf Leaf, lf Hole, Node Bag (map lf [Leaf, Leaf, Hole, Leaf])])) 152 | 153 | struct n x = drawSpT (struct' n x) 154 | # centerXY 155 | 156 | struct' n x = struct'' n (text x <> rect 2 1 # lw 0) 157 | 158 | struct'' n d = nd d (replicate n (lf Leaf)) 159 | 160 | txt s = text s <> square 1 # lw 0 161 | 162 | linOrd ls = 163 | connect 164 | . hcat' with {sep = 0.5} 165 | $ map labT ls & _head %~ named "head" & _last %~ named "last" 166 | where 167 | connect = 168 | withNames ["head", "last"] $ \[h,l] -> 169 | beneath (location h ~~ location l) 170 | 171 | unord [] = circle 1 # lw 0.1 # lc gray 172 | unord ds = elts # centerXY 173 | <> roundedRect w (mh + s*2) ((mh + s*2) / 5) 174 | where 175 | elts = hcat' with {sep = s} ds 176 | mw = maximum' 0 . map width $ ds 177 | s = mw * 0.5 178 | mh = maximum' 0 . map height $ ds 179 | w = ((fromIntegral (length ds + 1) * s) +) . sum . map width $ ds 180 | maximum' d [] = d 181 | maximum' _ xs = maximum xs 182 | 183 | enRect d = roundedRect (w+0.5) (h+0.5) 0.5 <> d # centerXY 184 | where (w,h) = size2D d 185 | -------------------------------------------------------------------------------- /proposal/Tree.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE NoImplicitPrelude #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# LANGUAGE UndecidableInstances #-} 7 | 8 | import Diagrams.TwoD.Layout.Tree 9 | import Math.Combinatorics.Species 10 | 11 | import NumericPrelude 12 | 13 | data Tree a = E | B (Tree a) a (Tree a) 14 | 15 | deriveDefaultSpecies ''Tree 16 | -------------------------------------------------------------------------------- /proposal/announce.txt: -------------------------------------------------------------------------------- 1 | Brent Yorgey 2 | Dissertation Proposal 3 | 4 | Title: 5 | Combinatorial Species and Algebraic Data Types 6 | 7 | Committee: 8 | Jacques Carette (McMaster University) 9 | Benjamin Pierce 10 | Val Tannen 11 | Steve Zdancewic (chair) 12 | 13 | Advisor: 14 | Stephanie Weirich 15 | 16 | Date: 17 | 1pm, Monday, March 4 18 | 19 | Location: 20 | Levine 307 21 | 22 | Abstract: 23 | 24 | The theory of algebraic data types has had a profound impact on the 25 | practice of programming, especially in functional languages. The 26 | basic idea is that types can be built up algebraically from a small 27 | set of primitive types and combinators: a unit type, base types, sums 28 | (i.e. tagged unions), products (i.e. tupling), and recursion. 29 | 30 | However, algebraic datatypes can only express types with tree-like 31 | structure. There are many such types, including tuples, records, 32 | options, variants, and lists, but this list does not include all 33 | common data structures. In particular, algebraic data types cannot 34 | directly represent data structures with symmetry (where nontrivial 35 | permutations of the data structure elements leave it unchanged, as in 36 | bags or cycles) or sharing (where multiple parts of the data structure 37 | refer to the same memory location). 38 | 39 | The theory of combinatorial species was first explored as a unifying 40 | framework for enumerative combinatorics, but the connections to the 41 | theory of algebraic data types are striking and deep. In this talk, I 42 | propose using the theory of species as a foundational theory of 43 | container data types, giving a principled way to work with a much 44 | wider range of data structures than is possible using algebraic data 45 | types alone. 46 | 47 | -------------------------------------------------------------------------------- /proposal/haskell.sty: -------------------------------------------------------------------------------- 1 | \newcommand{\ty}[1]{\mathsf{#1}} 2 | \newcommand{\con}[1]{{\color{blue}\mathsf{#1}}} 3 | \newcommand{\consyml}[1]{\mathrel{\con{\mathord{#1}}}} 4 | \newcommand{\consym}[1]{\mathrel{\con{\mathord{#1}}}} 5 | \newcommand{\id}[1]{\mathit{#1}} 6 | \newcommand{\tyid}[1]{{\color{red}\mathit{#1}}} 7 | \newcommand{\keyw}[1]{\mathbf{#1}} 8 | \newcommand{\tycon}[1]{{\color{red}\ty{#1}}} 9 | \newcommand{\tyconsyml}[1]{\mathrel{\tycon{\mathord{#1}}}} 10 | \newcommand{\tyconsym}[1]{\mathrel{\tycon{\mathord{#1}}}} 11 | \newcommand{\tycls}[1]{{\color{red}\ty{#1}}} 12 | \colorlet{darkgreen}{green!50!black} 13 | \newcommand{\kind}[1]{{\color{darkgreen}\ty{#1}}} 14 | \newcommand{\fun}[1]{\mathsf{#1}} 15 | -------------------------------------------------------------------------------- /proposal/images/BLL-cover.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/BLL-cover.jpg -------------------------------------------------------------------------------- /proposal/images/joyal-screencap.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/joyal-screencap.png -------------------------------------------------------------------------------- /proposal/images/joyal-species.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/joyal-species.png -------------------------------------------------------------------------------- /proposal/images/ocaml-logo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/ocaml-logo.gif -------------------------------------------------------------------------------- /proposal/images/ocaml-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/ocaml-logo.png -------------------------------------------------------------------------------- /proposal/images/oh-my.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/oh-my.png -------------------------------------------------------------------------------- /proposal/images/orange-tree.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/orange-tree.jpg -------------------------------------------------------------------------------- /proposal/images/plclub.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/plclub.png -------------------------------------------------------------------------------- /proposal/images/relabeling.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/relabeling.pdf -------------------------------------------------------------------------------- /proposal/images/species-package.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/species-package.png -------------------------------------------------------------------------------- /proposal/images/tree-holes-partition.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/tree-holes-partition.pdf -------------------------------------------------------------------------------- /proposal/images/universe.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/proposal/images/universe.jpg -------------------------------------------------------------------------------- /proposal/lhs2TeX-extra.fmt: -------------------------------------------------------------------------------- 1 | %include polycode.fmt 2 | %include forall.fmt 3 | 4 | %if not color 5 | \definecolor{blue}{named}{black} 6 | \definecolor{red}{named}{black} 7 | \definecolor{darkgreen}{named}{black} 8 | \definecolor{orange}{named}{black} 9 | \definecolor{green}{named}{black} 10 | \renewcommand{\ty}[1]{\mathsf{#1}} 11 | %endif 12 | 13 | %if style == newcode 14 | 15 | % Spacing 16 | %format ^ = 17 | %format ^^ = " " 18 | %format ^^. = 19 | %format ... = "undefined" 20 | %format .... = 21 | 22 | %else 23 | 24 | % Spacing 25 | %format ^ = " " 26 | %format ^^ = "\;" 27 | %format ^^^ = "\quad" 28 | %format ^^^^ = "\qquad" 29 | 30 | %format ~ = " \sim " 31 | 32 | % Pretty-printing 33 | %format ^^. = "\;." 34 | %format ... = "\ldots " 35 | %format .... = "\ldots " 36 | %format SIGN t k = t "::" k 37 | %format getType1 = getType "_1" 38 | 39 | % 'family' is keyword 40 | %format family = "\mathbf{family}" 41 | 42 | % Standard kinds 43 | %format * = "\kind{\star}" 44 | %format # = "\kind{\#}" 45 | %format Constraint = "\kind{Constraint}" 46 | 47 | % Kind variables 48 | %format kK = "\kind{\kappa}" 49 | %format kK1 = "\kind{\kappa_1}" 50 | %format kK2 = "\kind{\kappa_2}" 51 | 52 | % Type variables 53 | %format aT = "\tyid{a}" 54 | %format asT = "\tyid{as}" 55 | %format bT = "\tyid{b}" 56 | %format cT = "\tyid{c}" 57 | %format fT = "\tyid{f}" 58 | %format gT = "\tyid{g}" 59 | %format mT = "\tyid{m}" 60 | %format nT = "\tyid{n}" 61 | %format rT = "\tyid{r}" 62 | %format tT = "\tyid{t}" 63 | %format xT = "\tyid{x}" 64 | 65 | % Standard types 66 | %format Unit = "\tycon{()}" 67 | %format Pair = "\tycon{(,)}" 68 | %format Maybe = "\tycon{Maybe}" 69 | %format Option = "\tycon{Option}" 70 | %format Rational = "\tycon{Rational}" 71 | %format String = "\tycon{String}" 72 | %format Int = "\tycon{Int}" 73 | %format Bool = "\tycon{Bool}" 74 | %format ShowS = "\tycon{ShowS}" 75 | %format Char = "\tycon{Char}" 76 | %format TypeRep = "\tycon{TypeRep}" 77 | %format Either = "\tycon{Either}" 78 | %format List1_ = "\tycon{[\,]}" 79 | %format Max = "\tycon{Max}" 80 | %format Min = "\tycon{Min}" 81 | %format Sum = "\tycon{Sum}" 82 | %format Product = "\tycon{Product}" 83 | 84 | %format Envelope = "\tycon{Envelope}" 85 | %format Diagram = "\tycon{Diagram}" 86 | %format Prim = "\tycon{Prim}" 87 | 88 | % Standard constructors 89 | %format False = "\con{False}" 90 | %format True = "\con{True}" 91 | %format Left = "\con{Left}" 92 | %format Right = "\con{Right}" 93 | %format Just = "\con{Just}" 94 | %format Nothing = "\con{Nothing}" 95 | %format Cons_ = "\con{(:)}" 96 | %format cons_ = "\mathbin{\con{:}}" 97 | %format : = "\mathbin{\con{:}}" 98 | 99 | % Standard type classes 100 | %format Show = "\tycls{Show}" 101 | %format Functor = "\tycls{Functor}" 102 | %format Num = "\tycls{Num}" 103 | %format Typeable = "\tycls{Typeable}" 104 | %format Typeable1 = "\tycls{{Typeable}_1}" 105 | %format Typeable2 = "\tycls{{Typeable}_2}" 106 | %format Monoid = "\tycls{Monoid}" 107 | %format Semigroup = "\tycls{Semigroup}" 108 | 109 | % Standard function names 110 | %format head = "\fun{head}" 111 | %format error = "\fun{error}" 112 | 113 | %endif 114 | -------------------------------------------------------------------------------- /proposal/notes.org: -------------------------------------------------------------------------------- 1 | * species as basis of programming language 2 | * species on infinite sets/in terms of lattices/domains etc.? 3 | * L-species 4 | -------------------------------------------------------------------------------- /spe-closed-Cauchy.txt: -------------------------------------------------------------------------------- 1 | A functor category equipped with Day convolution is automatically 2 | closed! This is of course covered in Day's paper which I haven't yet 3 | read. But it's also given in Kelly ("On the Operads of JP May"): 4 | 5 | [S,T] L = \int_K [S K, T (K + L)] 6 | 7 | The [-,-] on the left is the internal hom in the category of species; 8 | the [-,-] on the right is the internal hom in Set. (I'll concretely 9 | use species = B -> Set for now; of course all this can be suitably 10 | generalized. I'm also going to just use = when I mean natural 11 | isomorphism.) Since \int_x [F x, G x] = Nat(F,G) we can rewrite this 12 | as 13 | 14 | [S,T] L = Nat(S, T(- + L)) 15 | 16 | (note that T(- + L) = T^(|L|), that is, the |L|-fold iterated 17 | derivative of T). Now, if this is really the internal hom in the 18 | category of species then we should have 19 | 20 | Hom(R*S, T) = Hom(R, [S,T]) 21 | 22 | Homs in a functor category are natural transformations; expanding them 23 | as ends (which I will now write using ∀, to give better computational 24 | intuition) gives 25 | 26 | Hom(R*S, T) = ∀ L. (R*S) L -> T L 27 | Hom(R, [S,T]) = ∀ L. R L -> [S,T] L = ∀ N. R N -> (∀ M. S M -> T (M + N)) 28 | 29 | and it actually makes sense that these are isomorphic: if we can 30 | naturally turn an R*S-structure into a T-structure, then we can turn 31 | an R-structure into a function which expects an S-structure and then 32 | constructs a T-structure out of the sum of their labels. 33 | 34 | I am not yet sure how useful this is. In particular, of course, it 35 | *doesn't* let us model function *datatypes*; species can still only 36 | model covariant datatypes. Still, it was an interesting surprise and 37 | enlightening to try wrapping my head around it. 38 | 39 | -Brent 40 | -------------------------------------------------------------------------------- /thesis-final-draft-2014-09-23.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/byorgey/thesis/b60af0501cdb2d1154d9303694884f461c0e499a/thesis-final-draft-2014-09-23.pdf -------------------------------------------------------------------------------- /thesis.fmt: -------------------------------------------------------------------------------- 1 | %include polycode.fmt 2 | %include forall.fmt 3 | 4 | %format `mappend` = "\mappend" 5 | %format mempty = "\mempty" -------------------------------------------------------------------------------- /thesis.log.pulp: -------------------------------------------------------------------------------- 1 | !(boring 2 | | info 3 | | message 4 | | under 5 | | over 6 | | 'Package [^ ]*[][0-9/ ]* emulated by memoir\\.' 7 | | "write18 enabled" 8 | | "runsystem\\(.*diagrams.*\\)\\.\\.\\.executed\\." 9 | | "Opening diagrams-latex stream" 10 | ) 11 | -------------------------------------------------------------------------------- /thesis.tex: -------------------------------------------------------------------------------- 1 | %% -*- mode: LaTeX; compile-command: "mk" -*- 2 | 3 | \newif \ifdraft \draftfalse 4 | \input{iflvn} 5 | 6 | \DeclareFontShape{OT1}{cmr}{bx}{sc}{<-> cmbcsc10}{} 7 | \PassOptionsToPackage{table}{xcolor} 8 | 9 | \documentclass[12pt,oneside]{book} 10 | 11 | \newcommand{\Title}{COMBINATORIAL SPECIES AND LABELLED STRUCTURES} 12 | 13 | \input{defs} 14 | 15 | \title{\Title} 16 | \author{Brent Yorgey} 17 | 18 | \begin{document} 19 | 20 | \hypersetup{pageanchor=false} 21 | \pagenumbering{roman} 22 | \pagestyle{fancy} 23 | \frenchspacing 24 | \numberwithin{equation}{section} 25 | 26 | \newcommand{\doublespaced}{\renewcommand{\baselinestretch}{2}\normalfont} 27 | \newcommand{\singlespaced}{\renewcommand{\baselinestretch}{1}\normalfont} 28 | 29 | \thispagestyle{empty} 30 | 31 | \doublespaced 32 | \large\newlength{\oldparskip}\setlength\oldparskip{\parskip}\parskip=.3in 33 | \begin{centering} 34 | \vfill 35 | {\Huge \Title} \\ 36 | Brent Abraham Yorgey \\ 37 | A DISSERTATION \\ 38 | in \\ 39 | Computer and Information Science 40 | 41 | \noindent\singlespaced\large 42 | Presented to the Faculties of the University of Pennsylvania \\ 43 | in \\ 44 | Partial Fulfillment of the Requirements for the \\ 45 | Degree of Doctor of Philosophy \\ 46 | \doublespaced\large 47 | 2014 \\ 48 | \end{centering} 49 | 50 | \vfill 51 | \singlespaced 52 | 53 | {\small 54 | 55 | \noindent 56 | Supervisor of Dissertation \\ 57 | \signature \\ 58 | Stephanie Weirich \\ 59 | Associate Professor of CIS \\ 60 | 61 | \noindent 62 | Graduate Group Chairperson \\ 63 | \signature \\ 64 | Lyle Ungar \\ 65 | Professor of CIS 66 | 67 | \vspace{-0.1in} 68 | \noindent 69 | Dissertation Committee \\ 70 | Steve Zdancewic (Associate Professor of CIS; Committee Chair) \\ 71 | Jacques Carette (Associate Professor of Computer Science, McMaster University)\\ 72 | Benjamin Pierce (Professor of CIS) \\ 73 | Val Tannen (Professor of CIS) \\ 74 | } 75 | 76 | \normalsize\parskip=\oldparskip 77 | 78 | \newpage 79 | 80 | \thispagestyle{empty} 81 | \begin{pagecentered} 82 | \doublespaced 83 | \parskip=.3in 84 | 85 | \Title \\ 86 | COPYRIGHT \\ 87 | 2014 \\ 88 | Brent Abraham Yorgey \bigskip 89 | 90 | \singlespaced 91 | \parskip=\oldparskip 92 | 93 | This work is licensed under a 94 | \href{http://creativecommons.org/licenses/by/4.0/}{Creative Commons 95 | Attribution 4.0 International License}. To view a copy of this 96 | license, visit \bigskip 97 | 98 | \url{http://creativecommons.org/licenses/by/4.0/} \bigskip 99 | 100 | The complete source code for this document is available from \bigskip 101 | 102 | \url{http://github.com/byorgey/thesis} 103 | \end{pagecentered} 104 | 105 | \newpage 106 | 107 | \begin{pagecentered} 108 | 109 | \ifgreek 110 | % see http://www.guyrutenberg.com/culmus-latex/ ? 111 | % 112 | % \begingroup 113 | % \selectlanguage{hebrew} \large 114 | 115 | % בְּרֵאשִׁית בָּרָא אֱלֹהִים אֵת הַשָּׁמַיִם וְאֵת הָאָרֶץ 116 | 117 | % \normalsize \hfill בראשית 1.1 118 | % \endgroup \bigskip 119 | 120 | \begingroup 121 | \selectlanguage{polutonikogreek} \large 122 | 123 | \begin{verse} 124 | ὅς ἐστιν εἰκὼν τοῦ θεοῦ τοῦ ἀοράτου, \\ 125 | πρωτότοκος πάσης κτίσεως, \\ 126 | ὅτι ἐν αὐτῷ ἐκτίσθη τὰ πάντα ἐν τοῖς οὐρανοῖς καὶ ἐπὶ τῆς γῆς, τὰ 127 | ὁρατὰ καὶ τὰ ἀόρατα, εἴτε θρόνοι εἴτε κυριότητες εἴτε ἀρχαὶ εἴτε 128 | ἐξουσίαι· τὰ πάντα δι’ αὐτοῦ καὶ εἰς αὐτὸν ἔκτισται· 129 | 130 | \vin καὶ αὐτός ἐστιν πρὸ πάντων 131 | 132 | \vin \vin καὶ τὰ πάντα ἐν αὐτῷ συνέστηκεν, 133 | 134 | \vin καὶ αὐτός ἐστιν ἡ κεφαλὴ τοῦ σώματος τῆς ἐκκλησίας· 135 | 136 | ὅς ἐστιν ἀρχή, \\ 137 | πρωτότοκος ἐκ τῶν νεκρῶν, ἵνα γένηται ἐν πᾶσιν αὐτὸς πρωτεύων, \\ 138 | ὅτι ἐν αὐτῷ εὐδόκησεν πᾶν τὸ πλήρωμα κατοικῆσαι καὶ δι’ αὐτοῦ 139 | ἀποκαταλλάξαι τὰ πάντα εἰς αὐτόν, εἰρηνοποιήσας διὰ τοῦ αἵματος τοῦ 140 | σταυροῦ αὐτοῦ, εἴτε τὰ ἐπὶ τῆς γῆς εἴτε τὰ ἐν τοῖς οὐρανοῖς· \bigskip 141 | \end{verse} 142 | 143 | \normalsize \hfill ΠΡΟΣ ΚΟΛΟΣΣΑΕΙΣ 1.15--20 144 | 145 | \endgroup 146 | \fi 147 | 148 | \end{pagecentered} 149 | 150 | \newpage 151 | 152 | \input{acks} 153 | 154 | \newpage 155 | 156 | \input{abstract} 157 | 158 | \tableofcontents 159 | 160 | \newpage 161 | 162 | \listoftables 163 | 164 | \listoffigures 165 | 166 | \newpage 167 | 168 | \begin{pagecentered} 169 | 170 | This document is typeset in \LaTeX\ using Computer Modern. \medskip 171 | 172 | It was edited using \texttt{emacs} and stored using \texttt{git} and 173 | \url{github.com}. \medskip 174 | 175 | The illustrations were produced with \texttt{diagrams} version 1.2 176 | (\url{http://projects.haskell.org/diagrams}). 177 | \end{pagecentered} 178 | 179 | 180 | \newpage 181 | \setcounter{page}{1} 182 | \pagenumbering{arabic} 183 | \hypersetup{pageanchor=true} 184 | 185 | \setcounter{chapter}{-1} 186 | 187 | \include{intro} 188 | \include{prelim} 189 | \include{equality} 190 | \include{species} 191 | \include{generalized} 192 | \include{variants} 193 | \include{labelled} 194 | \include{conclusion} 195 | 196 | \appendix 197 | \include{liftproof} 198 | 199 | \newpage 200 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 201 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 202 | \nochapter{Bibliography} 203 | \label{ch:bib} 204 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 205 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 206 | 207 | \ifcomments 208 | \begingroup 209 | \Large 210 | \textcolor{red}{TODOs: \arabic{todocount}} 211 | \endgroup 212 | \fi 213 | 214 | \bibliographystyle{plainnat} 215 | \bibliography{thesis} 216 | 217 | \end{document} 218 | -------------------------------------------------------------------------------- /timeline.txt: -------------------------------------------------------------------------------- 1 | Outline 2 | ======= 3 | 4 | + Chapter 0: Introduction + related work 5 | 6 | - Motivation 7 | - Summary of contributions 8 | 9 | + Chapter 1: preliminaries 10 | 11 | - Homotopy type theory. 12 | - Category theory. 13 | - Functor categories. 14 | - Groupoids. 15 | - Finiteness. 16 | - Parametricity. 17 | - Monoids and monoidal categories. 18 | 19 | + Chapter 2: Species 20 | CONTRIBUTIONS: 21 | - Generic categorical framework for species and generalizations thereof 22 | - with a target audience of type theorists/functional programmers 23 | novel parts: new audience, new gathering of material, 24 | once material is in once place, new connections 25 | (hopefully) see variants as instances of general framework 26 | new instantiation in type theory 27 | 28 | - Traditional definition of species. 29 | - Restart "from scratch": functor categories. Along the way, 30 | explain what extra structure is needed for each new feature, and 31 | give examples of categories we care about with those properties. 32 | - Lifting monoidal structure from codomain 33 | - Coproduct 34 | - Cartesian/Hadamard product 35 | - Day convolution. 36 | - Lifting monoidal structure from domain (via Day convolution) 37 | - partitional/Cauchy product 38 | - arithmetic product 39 | - Composition 40 | - Differentiation + Pointing 41 | - multisort species 42 | - weighted species 43 | - L-species 44 | 45 | - Think about how to incorporate material on elimination etc.? 46 | 47 | + Chapter 3: Labelled structures 48 | CONTRIBUTIONS: 49 | - new idea of a labelled structure 50 | 51 | - Joyal's definition of analytic functors. 52 | - Labelled structures 53 | - Operations on labelled structures, lifted from operations on 54 | species. 55 | - Abstracting over "storage exponentials". 56 | - Functions 57 | - Vectors 58 | - Tries 59 | 60 | + Chapter 4: Applications 61 | 62 | - Generic functions (map, partition, filter, etc.) 63 | - A theory of matrix operations and allocation 64 | - ? 65 | 66 | There is also a half-started chapter on computational interpretation 67 | of generating functions which I'm quite excited about, but at this 68 | point I think it's probably best to leave it out of the dissertation, 69 | and work it out/write it up at some point in the future. 70 | 71 | Timeline 72 | ======== 73 | 74 | Here's a proposed timeline for me to graduate in August. I don't know 75 | how realistic this is but I will sure try my best. Feedback welcome. 76 | Note in particular this does not include revising/writing/submitting 77 | any papers; we should talk more about whether/when/where that might 78 | happen. 79 | 80 | March 18--28 (2 weeks): write (most of) Chapter 2 81 | March 28--April 5 (1 week): Brent in London & Leipzig 82 | April 7--11: put together MFPS paper 83 | April 14--18: incorporate MFPS paper back into Chapter 2 84 | April 21--May 2 (2 weeks): finish chapter 2 85 | May (4 weeks): write chapter 3 86 | June (4 weeks): work out and write chapter 4, and turn material from Chapters 2 & 3 into a POPL submission? 87 | July (4 weeks): write Chapter 1 / miscellaneous / account for inevitable schedule slippage 88 | 89 | October 14: defend 90 | --------------------------------------------------------------------------------