diff --git a/cp2223t/BTree.hs b/cp2223t/BTree.hs new file mode 100644 index 0000000..2b09adf --- /dev/null +++ b/cp2223t/BTree.hs @@ -0,0 +1,205 @@ +{-# OPTIONS_GHC -XNPlusKPatterns #-} + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module BTree where + +import Cp +import Data.List +import Data.Monoid + +-- (1) Datatype definition ----------------------------------------------------- + +data BTree a = Empty | Node(a, (BTree a, BTree a)) deriving Show + +inBTree :: Either () (b,(BTree b,BTree b)) -> BTree b +inBTree = either (const Empty) Node + +outBTree :: BTree a -> Either () (a,(BTree a,BTree a)) +outBTree Empty = Left () +outBTree (Node (a,(t1,t2))) = Right(a,(t1,t2)) + +baseBTree g f = id -|- g >< (f >< f) + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +recBTree f = id -|- id >< (f >< f) -- = baseBTree id f + +cataBTree g = g . (recBTree (cataBTree g)) . outBTree + +anaBTree g = inBTree . (recBTree (anaBTree g) ) . g + +hyloBTree f g = cataBTree f . anaBTree g + +-- (3) Map --------------------------------------------------------------------- + +instance Functor BTree + where fmap f = cataBTree ( inBTree . baseBTree f id ) + +-- equivalent to: +-- where fmap f = anaBTree ( baseBTree f id . outBTree ) + +-- (4) Examples ---------------------------------------------------------------- + +-- (4.1) Inversion (mirror) ---------------------------------------------------- + +mirrorBTree = cataBTree (inBTree . (id -|- id >< swap)) + +-- (4.2) Count and depth ------------------------------------------------------- + +countBTree = cataBTree (either (const 0) (succ . (uncurry (+)) . p2)) + +depthBTree = cataBTree (either zero (succ.umax.p2)) + +-- (4.3) Serialization --------------------------------------------------------- + +inordt = cataBTree inord -- in-order traversal + +preordt = cataBTree preord -- pre-order traversal + +postordt = cataBTree posord -- post-order traversal + +-- where + +preord = either nil f where f(x,(l,r))=x:l++r +inord = either nil f where f(x,(l,r))=l++[x]++r +posord = either nil f where f(x,(l,r))=l++r++[x] + +-- (4.4) Quicksort ------------------------------------------------------------- + +qSort :: Ord a => [a] -> [a] +qSort = hyloBTree inord qsep -- the same as (cataBTree inord) . (anaBTree qsep) + +-- where + +qsep [] = i1 () +qsep (h:t) = i2 (h,(s,l)) where (s,l) = part ( Bool) -> [a] -> ([a], [a]) +part p [] = ([],[]) +part p (h:t) | p h = let (s,l) = part p t in (h:s,l) + | otherwise = let (s,l) = part p t in (s,h:l) + +{-- pointwise versions: +qSort [] = [] +qSort (h:t) = let (t1,t2) = part (= h ] + +--} + +-- (4.5) Traces ---------------------------------------------------------------- + +traces :: Eq a => BTree a -> [[a]] +traces = cataBTree (either (const [[]]) tunion) + where tunion(a,(l,r)) = union (map (a:) l) (map (a:) r) + +-- (4.6) Towers of Hanoi ------------------------------------------------------- + +-- pointwise: +-- hanoi(d,0) = [] +-- hanoi(d,n+1) = (hanoi (not d,n)) ++ [(n,d)] ++ (hanoi (not d, n)) + +hanoi = hyloBTree present strategy + +--- where + +present = inord -- same as in qSort + +strategy(d,0) = Left () +strategy(d,n+1) = Right ((n,d),((not d,n),(not d,n))) + +{-- + The Towers of Hanoi problem comes from a puzzle marketed in 1883 + by the French mathematician douard Lucas, under the pseudonym + Claus. The puzzle is based on a legend according to which + there is a temple, apparently in Bramah rather than in Hanoi as + one might expect, where there are three giant poles fixed in the + ground. On the first of these poles, at the time of the world's + creation, God placed sixty four golden disks, each of different + size, in decreasing order of size. The Bramin monks were given + the task of moving the disks, one per day, from one pole to another + subject to the rule that no disk may ever be above a smaller disk. + The monks' task would be complete when they had succeeded in moving + all the disks from the first of the poles to the second and, on + the day that they completed their task the world would come to + an end! + + There is a wellknown inductive solution to the problem given + by the pseudocode below. In this solution we make use of the fact + that the given problem is symmetrical with respect to all three + poles. Thus it is undesirable to name the individual poles. Instead + we visualize the poles as being arranged in a circle; the problem + is to move the tower of disks from one pole to the next pole in + a specified direction around the circle. The code defines H n d + to be a sequence of pairs (k,d') where n is the number of disks, + k is a disk number and d and d' are directions. Disks are numbered + from 0 onwards, disk 0 being the smallest. (Assigning number 0 + to the smallest rather than the largest disk has the advantage + that the number of the disk that is moved on any day is independent + of the total number of disks to be moved.) Directions are boolean + values, true representing a clockwise movement and false an anticlockwise + movement. The pair (k,d') means move the disk numbered k from + its current position in the direction d'. The semicolon operator + concatenates sequences together, [] denotes an empty sequence + and [x] is a sequence with exactly one element x. Taking the pairs + in order from left to right, the complete sequence H n d prescribes + how to move the n smallest disks onebyone from one pole to the + next pole in the direction d following the rule of never placing + a larger disk on top of a smaller disk. + + H 0 d = [], + H (n+1) d = H n d ; [ (n, d) ] ; H n d. + + (excerpt from R. Backhouse, M. Fokkinga / Information Processing + Letters 77 (2001) 71--76) + +--} + +-- (5) Depth and balancing (using mutual recursion) -------------------------- + +balBTree = p1.baldepth + +baldepthBTree = p2.baldepth + +baldepth = cataBTree g where + g = either (const(True,1)) (h.(id> (a -> c) -> Either () (a,(c, c)) -> c +tnat f = either (const mempty) (theta . (f >< theta)) + where theta = uncurry mappend + +-- monoid reduction + +monBTree f = cataBTree (tnat f) + +-- alternative to (4.2) serialization ---------------------------------------- + +preordt' = monBTree singl + +-- alternative to (4.1) counting --------------------------------------------- + +countBTree' = monBTree (const (Sum 1)) + +-- (7) Zipper ---------------------------------------------------------------- + +data Deriv a = Dr Bool a (BTree a) + +type Zipper a = [ Deriv a ] + +plug :: Zipper a -> BTree a -> BTree a +plug [] t = t +plug ((Dr False a l):z) t = Node (a,(plug z t,l)) +plug ((Dr True a r):z) t = Node (a,(r,plug z t)) + +---------------------------- end of library ---------------------------------- diff --git a/cp2223t/Cp.hs b/cp2223t/Cp.hs new file mode 100644 index 0000000..2e46cbe --- /dev/null +++ b/cp2223t/Cp.hs @@ -0,0 +1,260 @@ + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module Cp where + +infix 5 >< +infix 4 -|- + +-- (1) Product ----------------------------------------------------------------- + +split :: (a -> b) -> (a -> c) -> a -> (b,c) +split f g x = (f x, g x) + +(><) :: (a -> b) -> (c -> d) -> (a,c) -> (b,d) +f >< g = split (f . p1) (g . p2) + +-- the 0-adic split + +(!) :: a -> () +(!) = const () + +-- Renamings: + +p1 = fst +p2 = snd + +-- diagonal (dup) + +diag = split id id + +-- (2) Coproduct --------------------------------------------------------------- + +-- Renamings: + +i1 = Left +i2 = Right + +-- either is predefined + +(-|-) :: (a -> b) -> (c -> d) -> Either a c -> Either b d +f -|- g = either (i1 . f) (i2 . g) + +-- McCarthy's conditional: + +cond p f g = (either f g) . (grd p) + +-- codiagonal (join) + +codiag = either id id + +-- (3) Exponentiation --------------------------------------------------------- + +-- curry is predefined + +ap :: (a -> b,a) -> b +ap = uncurry ($) + +expn :: (b -> c) -> (a -> b) -> a -> c +expn f = curry (f . ap) + +p2p :: (a, a) -> Bool -> a +p2p p b = if b then (snd p) else (fst p) -- pair to predicate + +-- exponentiation functor is (a->) predefined + +-- instance Functor ((->) s) where fmap f g = f . g + +-- (4) Others ----------------------------------------------------------------- + +--const :: a -> b -> a st const a x = a is predefined + +-- guards + +grd :: (a -> Bool) -> a -> Either a a +grd p x = if p x then i1 x else i2 x + +-- (5) Natural isomorphisms ---------------------------------------------------- + +swap :: (a,b) -> (b,a) +swap = split p2 p1 + +assocr :: ((a,b),c) -> (a,(b,c)) +assocr = split ( p1 . p1 ) (p2 >< id) + +assocl :: (a,(b,c)) -> ((a,b),c) +assocl = split ( id >< p1 ) ( p2 . p2 ) + +undistr :: Either (a,b) (a,c) -> (a,Either b c) +undistr = either ( id >< i1 ) ( id >< i2 ) + +undistl :: Either (b, c) (a, c) -> (Either b a, c) +undistl = either ( i1 >< id ) ( i2 >< id ) + +flatr :: (a,(b,c)) -> (a,b,c) +flatr (a,(b,c)) = (a,b,c) + +flatl :: ((a,b),c) -> (a,b,c) +flatl ((b,c),d) = (b,c,d) + +br :: a -> (a, ()) +br = split id (!) -- 'bang' on the right + +bl :: a -> ((), a) +bl = swap . br -- 'bang' on the left + +coswap :: Either a b -> Either b a +coswap = either i2 i1 + +coassocr :: Either (Either a b) c -> Either a (Either b c) +coassocr = either (id -|- i1) (i2 . i2) + +coassocl :: Either b (Either a c) -> Either (Either b a) c +coassocl = either (i1.i1) (i2 -|- id) + +distl :: (Either c a, b) -> Either (c, b) (a, b) +distl = uncurry (either (curry i1)(curry i2)) + +distr :: (b, Either c a) -> Either (b, c) (b, a) +distr = (swap -|- swap) . distl . swap + +colambda :: (a, a) -> Bool -> a +colambda (a,b) = f where f True = a; f False = b + +lambda :: (Bool -> a) -> (a, a) +lambda f = (f False, f True) + +-- (6) Class bifunctor --------------------------------------------------------- + +class BiFunctor f where + bmap :: (a -> b) -> (c -> d) -> (f a c -> f b d) + +instance BiFunctor Either where + bmap f g = f -|- g + +instance BiFunctor (,) where + bmap f g = f >< g + +-- (7) Monads: ----------------------------------------------------------------- + +-- (7.1) Kleisli monadic composition ------------------------------------------- + +infix 4 .! + +(.!) :: Monad a => (b -> a c) -> (d -> a b) -> d -> a c +(f .! g) a = (g a) >>= f + +mult :: (Monad m) => m (m b) -> m b +mult = (>>= id) -- also known as join + +-- (7.2) Monadic binding --------------------------------------------------------- + +ap' :: (Monad m) => (a -> m b, m a) -> m b +ap' = uncurry (flip (>>=)) + +-- (7.3) Lists + +singl :: a -> [a] +singl = return + +-- (7.4) Strong monads ----------------------------------------------------------- + +class (Functor f, Monad f) => Strong f where + rstr :: (f a,b) -> f(a,b) + rstr(x,b) = do a <- x ; return (a,b) + lstr :: (b,f a) -> f(b,a) + lstr(b,x) = do a <- x ; return (b,a) + +instance Strong IO + +instance Strong [] + +instance Strong Maybe + +dstr :: Strong m => (m a, m b) -> m (a, b) --- double strength +dstr = rstr .! lstr + +splitm :: Strong ff => ff (a -> b) -> a -> ff b +-- Exercise 4.8.13 in Jacobs' "Introduction to Coalgebra" (2012) +splitm = curry (fmap ap . rstr) + +{-- +-- (7.5) Monad transformers ------------------------------------------------------ + +class (Monad m, Monad (t m)) => MT t m where -- monad transformer class + lift :: m a -> t m a + +-- nested lifting: + +dlift :: (MT t (t1 m), MT t1 m) => m a -> t (t1 m) a +dlift = lift . lift + +--} + +-- (8) Basic functions, abbreviations ------------------------------------------ + +bang = (!) + +dup = split id id + +zero = const 0 + +one = const 1 + +nil = const [] + +cons = uncurry (:) + +add = uncurry (+) + +mul = uncurry (*) + +conc = uncurry (++) + +umax :: Ord a => (a,a) -> a +umax = uncurry max + +true = const True + +nothing = const Nothing + +false = const False + +inMaybe :: Either () a -> Maybe a +inMaybe = either (const Nothing) Just + +nat0 = [0..] -- the natural numbers + +-- (9) Advanced ---------------------------------------------------------------- + +class (Functor f) => Unzipable f where + unzp :: f(a,b) -> (f a,f b) + unzp = split (fmap p1)(fmap p2) + +class Functor g => DistL g where + lamb :: Monad m => g (m a) -> m (g a) + +instance DistL [] where lamb = sequence + +instance DistL Maybe where + lamb Nothing = return Nothing + lamb (Just a) = fmap Just a -- where mp f = (return.f).!id + +aap :: Monad m => m (a->b) -> m a -> m b +-- to convert Monad into Applicative +-- (<*>) = curry(lift ap) where lift h (x,y) = do { a <- x; b <- y; return ((curry h a b)) } +aap mf mx = do { f <- mf ; x <- mx ; return (f x) } + +-- gather: n-ary split + +gather :: [a -> b] -> a -> [b] +gather l x = map (flip ($) x) l + +-- the dual of zip + +cozip :: (Functor f) => Either (f a) (f b) -> f (Either a b) +cozip = either (fmap Left)(fmap Right) + +tot :: (a -> b) -> (a -> Bool) -> a -> Maybe b +tot f p = cond p (return . f) nothing +-------------------------------------------------------------------------------- diff --git a/cp2223t/Cp2223data.hs b/cp2223t/Cp2223data.hs new file mode 100644 index 0000000..9e277ef --- /dev/null +++ b/cp2223t/Cp2223data.hs @@ -0,0 +1,2119 @@ + +module Cp2223data where + +acm_ccs = [ "CCS", + " General and reference", + " Document types", + " Surveys and overviews", + " Reference works", + " General conference proceedings", + " Biographies", + " General literature", + " Computing standards, RFCs and guidelines", + " Cross-computing tools and techniques", + " Reliability", + " Empirical studies", + " Measurement", + " Metrics", + " Evaluation", + " Experimentation", + " Estimation", + " Design", + " Performance", + " Validation", + " Verification", + " Hardware", + " Printed circuit boards", + " Electromagnetic interference and compatibility", + " PCB design and layout", + " Communication hardware, interfaces and storage", + " Signal processing systems", + " Digital signal processing", + " Beamforming", + " Noise reduction", + " Sensors and actuators", + " Buses and high-speed links", + " Displays and imagers", + " External storage", + " Networking hardware", + " Printers", + " Sensor applications and deployments", + " Sensor devices and platforms", + " Sound-based input / output", + " Tactile and hand-based interfaces", + " Touch screens", + " Haptic devices", + " Scanners", + " Wireless devices", + " Wireless integrated network sensors", + " Electro-mechanical devices", + " Integrated circuits", + " 3D integrated circuits", + " Interconnect", + " Input / output circuits", + " Metallic interconnect", + " Photonic and optical interconnect", + " Radio frequency and wireless interconnect", + " Semiconductor memory", + " Dynamic memory", + " Static memory", + " Non-volatile memory", + " Read-only memory", + " Digital switches", + " Transistors", + " Logic families", + " Logic circuits", + " Arithmetic and datapath circuits", + " Asynchronous circuits", + " Combinational circuits", + " Design modules and hierarchy", + " Finite state machines", + " Sequential circuits", + " Reconfigurable logic and FPGAs", + " Hardware accelerators", + " High-speed input / output", + " Programmable logic elements", + " Programmable interconnect", + " Reconfigurable logic applications", + " Evolvable hardware", + " Very large scale integration design", + " 3D integrated circuits", + " Analog and mixed-signal circuits", + " Data conversion", + " Clock generation and timing", + " Analog and mixed-signal circuit optimization", + " Radio frequency and wireless circuits", + " Wireline communication", + " Analog and mixed-signal circuit synthesis", + " Application-specific VLSI designs", + " Application specific integrated circuits", + " Application specific instruction set processors", + " Application specific processors", + " Design reuse and communication-based design", + " Network on chip", + " System on a chip", + " Platform-based design", + " Hard and soft IP", + " Design rules", + " Economics of chip design and manufacturing", + " Full-custom circuits", + " VLSI design manufacturing considerations", + " On-chip resource management", + " On-chip sensors", + " Standard cell libraries", + " VLSI packaging", + " Die and wafer stacking", + " Input / output styles", + " Multi-chip modules", + " Package-level interconnect", + " VLSI system specification and constraints", + " Power and energy", + " Thermal issues", + " Temperature monitoring", + " Temperature simulation and estimation", + " Temperature control", + " Temperature optimization", + " Energy generation and storage", + " Batteries", + " Fuel-based energy", + " Renewable energy", + " Reusable energy storage", + " Energy distribution", + " Energy metering", + " Power conversion", + " Power networks", + " Smart grid", + " Impact on the environment", + " Power estimation and optimization", + " Switching devices power issues", + " Interconnect power issues", + " Circuits power issues", + " Chip-level power issues", + " Platform power issues", + " Enterprise level and data centers power issues", + " Electronic design automation", + " High-level and register-transfer level synthesis", + " Datapath optimization", + " Hardware-software codesign", + " Resource binding and sharing", + " Operations scheduling", + " Hardware description languages and compilation", + " Logic synthesis", + " Combinational synthesis", + " Circuit optimization", + " Sequential synthesis", + " Technology-mapping", + " Transistor-level synthesis", + " Modeling and parameter extraction", + " Physical design (EDA)", + " Clock-network synthesis", + " Packaging", + " Partitioning and floorplanning", + " Placement", + " Physical synthesis", + " Power grid design", + " Wire routing", + " Timing analysis", + " Electrical-level simulation", + " Model-order reduction", + " Compact delay models", + " Static timing analysis", + " Statistical timing analysis", + " Transition-based timing analysis", + " Methodologies for EDA", + " Best practices for EDA", + " Design databases for EDA", + " Software tools for EDA", + " Hardware validation", + " Functional verification", + " Model checking", + " Coverage metrics", + " Equivalence checking", + " Semi-formal verification", + " Simulation and emulation", + " Transaction-level verification", + " Theorem proving and SAT solving", + " Assertion checking", + " Physical verification", + " Design rule checking", + " Layout-versus-schematics", + " Power and thermal analysis", + " Timing analysis and sign-off", + " Post-manufacture validation and debug", + " Bug detection, localization and diagnosis", + " Bug fixing (hardware)", + " Design for debug", + " Hardware test", + " Analog, mixed-signal and radio frequency test", + " Board- and system-level test", + " Defect-based test", + " Design for testability", + " Built-in self-test", + " Online test and diagnostics", + " Test data compression", + " Fault models and test metrics", + " Memory test and repair", + " Hardware reliability screening", + " Test-pattern generation and fault simulation", + " Testing with distributed and parallel systems", + " Robustness", + " Fault tolerance", + " Error detection and error correction", + " Failure prediction", + " Failure recovery, maintenance and self-repair", + " Redundancy", + " Self-checking mechanisms", + " System-level fault tolerance", + " Design for manufacturability", + " Process variations", + " Yield and cost modeling", + " Yield and cost optimization", + " Hardware reliability", + " Aging of circuits and systems", + " Circuit hardening", + " Early-life failures and infant mortality", + " Process, voltage and temperature variations", + " Signal integrity and noise analysis", + " Transient errors and upsets", + " Safety critical systems", + " Emerging technologies", + " Analysis and design of emerging devices and systems", + " Emerging architectures", + " Emerging languages and compilers", + " Emerging simulation", + " Emerging tools and methodologies", + " Biology-related information processing", + " Bio-embedded electronics", + " Neural systems", + " Circuit substrates", + " III-V compounds", + " Carbon based electronics", + " Cellular neural networks", + " Flexible and printable circuits", + " Superconducting circuits", + " Electromechanical systems", + " Microelectromechanical systems", + " Nanoelectromechanical systems", + " Emerging interfaces", + " Memory and dense storage", + " Emerging optical and photonic technologies", + " Reversible logic", + " Plasmonics", + " Quantum technologies", + " Single electron devices", + " Tunneling devices", + " Quantum computation", + " Quantum communication and cryptography", + " Quantum error correction and fault tolerance", + " Quantum dots and cellular automata", + " Spintronics and magnetic technologies", + " Computer systems organization", + " Architectures", + " Serial architectures", + " Reduced instruction set computing", + " Complex instruction set computing", + " Superscalar architectures", + " Pipeline computing", + " Stack machines", + " Parallel architectures", + " Very long instruction word", + " Interconnection architectures", + " Multiple instruction, multiple data", + " Cellular architectures", + " Multiple instruction, single data", + " Single instruction, multiple data", + " Systolic arrays", + " Multicore architectures", + " Distributed architectures", + " Cloud computing", + " Client-server architectures", + " n-tier architectures", + " Peer-to-peer architectures", + " Grid computing", + " Other architectures", + " Neural networks", + " Reconfigurable computing", + " Analog computers", + " Data flow architectures", + " Heterogeneous (hybrid) systems", + " Self-organizing autonomic computing", + " Optical computing", + " Quantum computing", + " Molecular computing", + " High-level language architectures", + " Special purpose systems", + " Embedded and cyber-physical systems", + " Sensor networks", + " Robotics", + " Robotic components", + " Robotic control", + " Evolutionary robotics", + " Robotic autonomy", + " External interfaces for robotics", + " Sensors and actuators", + " System on a chip", + " Embedded systems", + " Firmware", + " Embedded hardware", + " Embedded software", + " Real-time systems", + " Real-time operating systems", + " Real-time languages", + " Real-time system specification", + " Real-time system architecture", + " Dependable and fault-tolerant systems and networks", + " Reliability", + " Availability", + " Maintainability and maintenance", + " Processors and memory architectures", + " Secondary storage organization", + " Redundancy", + " Fault-tolerant network topologies", + " Networks", + " Network architectures", + " Network design principles", + " Layering", + " Naming and addressing", + " Programming interfaces", + " Network protocols", + " Network protocol design", + " Protocol correctness", + " Protocol testing and verification", + " Formal specifications", + " Link-layer protocols", + " Network layer protocols", + " Routing protocols", + " Signaling protocols", + " Transport protocols", + " Session protocols", + " Presentation protocols", + " Application layer protocols", + " Peer-to-peer protocols", + " OAM protocols", + " Time synchronization protocols", + " Network policy", + " Cross-layer protocols", + " Network File System (NFS) protocol", + " Network components", + " Intermediate nodes", + " Routers", + " Bridges and switches", + " Physical links", + " Repeaters", + " Middle boxes / network appliances", + " End nodes", + " Network adapters", + " Network servers", + " Wireless access points, base stations and infrastructure", + " Cognitive radios", + " Logical nodes", + " Network domains", + " Network algorithms", + " Data path algorithms", + " Packet classification", + " Deep packet inspection", + " Packet scheduling", + " Control path algorithms", + " Network resources allocation", + " Network control algorithms", + " Traffic engineering algorithms", + " Network design and planning algorithms", + " Network economics", + " Network performance evaluation", + " Network performance modeling", + " Network simulations", + " Network experimentation", + " Network performance analysis", + " Network measurement", + " Network properties", + " Network security", + " Security protocols", + " Web protocol security", + " Mobile and wireless security", + " Denial-of-service attacks", + " Firewalls", + " Network range", + " Short-range networks", + " Local area networks", + " Metropolitan area networks", + " Wide area networks", + " Very long-range networks", + " Network structure", + " Topology analysis and generation", + " Physical topologies", + " Logical / virtual topologies", + " Network topology types", + " Point-to-point networks", + " Bus networks", + " Star networks", + " Ring networks", + " Token ring networks", + " Fiber distributed data interface (FDDI)", + " Mesh networks", + " Wireless mesh networks", + " Hybrid networks", + " Network dynamics", + " Network reliability", + " Error detection and error correction", + " Network mobility", + " Network manageability", + " Network privacy and anonymity", + " Network services", + " Naming and addressing", + " Cloud computing", + " Location based services", + " Programmable networks", + " In-network processing", + " Network management", + " Network monitoring", + " Network types", + " Network on chip", + " Home networks", + " Storage area networks", + " Data center networks", + " Wired access networks", + " Cyber-physical networks", + " Sensor networks", + " Mobile networks", + " Overlay and other logical network structures", + " Peer-to-peer networks", + " World Wide Web (network structure)", + " Social media networks", + " Online social networks", + " Wireless access networks", + " Wireless local area networks", + " Wireless personal area networks", + " Ad hoc networks", + " Mobile ad hoc networks", + " Public Internet", + " Packet-switching networks", + " Software and its engineering", + " Software organization and properties", + " Contextual software domains", + " E-commerce infrastructure", + " Software infrastructure", + " Interpreters", + " Middleware", + " Message oriented middleware", + " Reflective middleware", + " Embedded middleware", + " Virtual machines", + " Operating systems", + " File systems management", + " Memory management", + " Virtual memory", + " Main memory", + " Allocation / deallocation strategies", + " Garbage collection", + " Distributed memory", + " Secondary storage", + " Process management", + " Scheduling", + " Deadlocks", + " Multithreading", + " Multiprocessing / multiprogramming / multitasking", + " Monitors", + " Mutual exclusion", + " Concurrency control", + " Power management", + " Process synchronization", + " Communications management", + " Buffering", + " Input / output", + " Message passing", + " Virtual worlds software", + " Interactive games", + " Virtual worlds training simulations", + " Software system structures", + " Embedded software", + " Software architectures", + " n-tier architectures", + " Peer-to-peer architectures", + " Data flow architectures", + " Cooperating communicating processes", + " Layered systems", + " Publish-subscribe / event-based architectures", + " Electronic blackboards", + " Simulator / interpreter", + " Object oriented architectures", + " Tightly coupled architectures", + " Space-based architectures", + " 3-tier architectures", + " Software system models", + " Petri nets", + " State systems", + " Entity relationship modeling", + " Model-driven software engineering", + " Feature interaction", + " Massively parallel systems", + " Ultra-large-scale systems", + " Distributed systems organizing principles", + " Cloud computing", + " Client-server architectures", + " Grid computing", + " Organizing principles for web applications", + " Real-time systems software", + " Abstraction, modeling and modularity", + " Software functional properties", + " Correctness", + " Synchronization", + " Functionality", + " Real-time schedulability", + " Consistency", + " Completeness", + " Access protection", + " Formal methods", + " Model checking", + " Software verification", + " Automated static analysis", + " Dynamic analysis", + " Extra-functional properties", + " Interoperability", + " Software performance", + " Software reliability", + " Software fault tolerance", + " Checkpoint / restart", + " Software safety", + " Software usability", + " Software notations and tools", + " General programming languages", + " Language types", + " Parallel programming languages", + " Distributed programming languages", + " Imperative languages", + " Object oriented languages", + " Functional languages", + " Concurrent programming languages", + " Constraint and logic languages", + " Data flow languages", + " Extensible languages", + " Assembly languages", + " Multiparadigm languages", + " Very high level languages", + " Language features", + " Abstract data types", + " Polymorphism", + " Inheritance", + " Control structures", + " Data types and structures", + " Classes and objects", + " Modules / packages", + " Constraints", + " Recursion", + " Concurrent programming structures", + " Procedures, functions and subroutines", + " Patterns", + " Coroutines", + " Frameworks", + " Formal language definitions", + " Syntax", + " Semantics", + " Compilers", + " Interpreters", + " Incremental compilers", + " Retargetable compilers", + " Just-in-time compilers", + " Dynamic compilers", + " Translator writing systems and compiler generators", + " Source code generation", + " Runtime environments", + " Preprocessors", + " Parsers", + " Context specific languages", + " Markup languages", + " Extensible Markup Language (XML)", + " Hypertext languages", + " Scripting languages", + " Domain specific languages", + " Specialized application languages", + " API languages", + " Graphical user interface languages", + " Window managers", + " Command and control languages", + " Macro languages", + " Programming by example", + " State based definitions", + " Visual languages", + " Interface definition languages", + " System description languages", + " Design languages", + " Unified Modeling Language (UML)", + " Architecture description languages", + " System modeling languages", + " Orchestration languages", + " Integration frameworks", + " Specification languages", + " Development frameworks and environments", + " Object oriented frameworks", + " Software as a service orchestration system", + " Integrated and visual development environments", + " Application specific development environments", + " Software configuration management and version control systems", + " Software libraries and repositories", + " Software maintenance tools", + " Software creation and management", + " Designing software", + " Requirements analysis", + " Software design engineering", + " Software design tradeoffs", + " Software implementation planning", + " Software design techniques", + " Software development process management", + " Software development methods", + " Rapid application development", + " Agile software development", + " Capability Maturity Model", + " Waterfall model", + " Spiral model", + " V-model", + " Design patterns", + " Risk management", + " Software development techniques", + " Software prototyping", + " Object oriented development", + " Flowcharts", + " Reusability", + " Software product lines", + " Error handling and recovery", + " Automatic programming", + " Genetic programming", + " Software verification and validation", + " Software prototyping", + " Operational analysis", + " Software defect analysis", + " Software testing and debugging", + " Fault tree analysis", + " Process validation", + " Walkthroughs", + " Pair programming", + " Use cases", + " Acceptance testing", + " Traceability", + " Formal software verification", + " Empirical software validation", + " Software post-development issues", + " Software reverse engineering", + " Documentation", + " Backup procedures", + " Software evolution", + " Software version control", + " Maintaining software", + " System administration", + " Collaboration in software development", + " Open source model", + " Programming teams", + " Search-based software engineering", + " Theory of computation", + " Models of computation", + " Computability", + " Lambda calculus", + " Turing machines", + " Recursive functions", + " Probabilistic computation", + " Quantum computation theory", + " Quantum complexity theory", + " Quantum communication complexity", + " Quantum query complexity", + " Quantum information theory", + " Interactive computation", + " Streaming models", + " Concurrency", + " Parallel computing models", + " Distributed computing models", + " Process calculi", + " Timed and hybrid models", + " Abstract machines", + " Formal languages and automata theory", + " Formalisms", + " Algebraic language theory", + " Rewrite systems", + " Automata over infinite objects", + " Grammars and context-free languages", + " Tree languages", + " Automata extensions", + " Transducers", + " Quantitative automata", + " Regular languages", + " Computational complexity and cryptography", + " Complexity classes", + " Problems, reductions and completeness", + " Communication complexity", + " Circuit complexity", + " Oracles and decision trees", + " Algebraic complexity theory", + " Quantum complexity theory", + " Proof complexity", + " Interactive proof systems", + " Complexity theory and logic", + " Cryptographic primitives", + " Cryptographic protocols", + " Logic", + " Logic and verification", + " Proof theory", + " Modal and temporal logics", + " Automated reasoning", + " Constraint and logic programming", + " Constructive mathematics", + " Description logics", + " Equational logic and rewriting", + " Finite Model Theory", + " Higher order logic", + " Linear logic", + " Programming logic", + " Abstraction", + " Verification by model checking", + " Type theory", + " Hoare logic", + " Separation logic", + " Design and analysis of algorithms", + " Graph algorithms analysis", + " Network flows", + " Sparsification and spanners", + " Shortest paths", + " Dynamic graph algorithms", + " Approximation algorithms analysis", + " Scheduling algorithms", + " Packing and covering problems", + " Routing and network design problems", + " Facility location and clustering", + " Rounding techniques", + " Stochastic approximation", + " Numeric approximation algorithms", + " Mathematical optimization", + " Discrete optimization", + " Network optimization", + " Optimization with randomized search heuristics", + " Simulated annealing", + " Evolutionary algorithms", + " Tabu search", + " Randomized local search", + " Continuous optimization", + " Linear programming", + " Semidefinite programming", + " Convex optimization", + " Quasiconvex programming and unimodality", + " Stochastic control and optimization", + " Quadratic programming", + " Nonconvex optimization", + " Bio-inspired optimization", + " Mixed discrete-continuous optimization", + " Submodular optimization and polymatroids", + " Integer programming", + " Bio-inspired optimization", + " Non-parametric optimization", + " Genetic programming", + " Developmental representations", + " Data structures design and analysis", + " Data compression", + " Pattern matching", + " Sorting and searching", + " Predecessor queries", + " Cell probe models and lower bounds", + " Online algorithms", + " Online learning algorithms", + " Scheduling algorithms", + " Caching and paging algorithms", + " K-server algorithms", + " Adversary models", + " Parameterized complexity and exact algorithms", + " Fixed parameter tractability", + " W hierarchy", + " Streaming, sublinear and near linear time algorithms", + " Bloom filters and hashing", + " Sketching and sampling", + " Lower bounds and information complexity", + " Random order and robust communication complexity", + " Nearest neighbor algorithms", + " Parallel algorithms", + " MapReduce algorithms", + " Self-organization", + " Shared memory algorithms", + " Vector / streaming algorithms", + " Massively parallel algorithms", + " Distributed algorithms", + " MapReduce algorithms", + " Self-organization", + " Algorithm design techniques", + " Backtracking", + " Branch-and-bound", + " Divide and conquer", + " Dynamic programming", + " Preconditioning", + " Concurrent algorithms", + " Randomness, geometry and discrete structures", + " Pseudorandomness and derandomization", + " Computational geometry", + " Generating random combinatorial structures", + " Random walks and Markov chains", + " Expander graphs and randomness extractors", + " Error-correcting codes", + " Random projections and metric embeddings", + " Random network models", + " Random search heuristics", + " Theory and algorithms for application domains", + " Machine learning theory", + " Sample complexity and generalization bounds", + " Boolean function learning", + " Unsupervised learning and clustering", + " Kernel methods", + " Support vector machines", + " Gaussian processes", + " Boosting", + " Bayesian analysis", + " Inductive inference", + " Online learning theory", + " Multi-agent learning", + " Models of learning", + " Query learning", + " Structured prediction", + " Reinforcement learning", + " Sequential decision making", + " Inverse reinforcement learning", + " Apprenticeship learning", + " Multi-agent reinforcement learning", + " Adversarial learning", + " Active learning", + " Semi-supervised learning", + " Markov decision processes", + " Regret bounds", + " Algorithmic game theory and mechanism design", + " Social networks", + " Algorithmic game theory", + " Algorithmic mechanism design", + " Solution concepts in game theory", + " Exact and approximate computation of equilibria", + " Quality of equilibria", + " Convergence and learning in games", + " Market equilibria", + " Computational pricing and auctions", + " Representations of games and their complexity", + " Network games", + " Network formation", + " Computational advertising theory", + " Database theory", + " Data exchange", + " Data provenance", + " Data modeling", + " Database query languages (principles)", + " Database constraints theory", + " Database interoperability", + " Data structures and algorithms for data management", + " Database query processing and optimization (theory)", + " Data integration", + " Logic and databases", + " Theory of database privacy and security", + " Incomplete, inconsistent, and uncertain databases", + " Theory of randomized search heuristics", + " Semantics and reasoning", + " Program constructs", + " Control primitives", + " Functional constructs", + " Object oriented constructs", + " Program schemes", + " Type structures", + " Program semantics", + " Algebraic semantics", + " Denotational semantics", + " Operational semantics", + " Axiomatic semantics", + " Action semantics", + " Categorical semantics", + " Program reasoning", + " Invariants", + " Program specifications", + " Pre- and post-conditions", + " Program verification", + " Program analysis", + " Assertions", + " Parsing", + " Abstraction", + " Mathematics of computing", + " Discrete mathematics", + " Combinatorics", + " Combinatoric problems", + " Permutations and combinations", + " Combinatorial algorithms", + " Generating functions", + " Combinatorial optimization", + " Combinatorics on words", + " Enumeration", + " Graph theory", + " Trees", + " Hypergraphs", + " Random graphs", + " Graph coloring", + " Paths and connectivity problems", + " Graph enumeration", + " Matchings and factors", + " Graphs and surfaces", + " Network flows", + " Spectra of graphs", + " Extremal graph theory", + " Matroids and greedoids", + " Graph algorithms", + " Approximation algorithms", + " Probability and statistics", + " Probabilistic representations", + " Bayesian networks", + " Markov networks", + " Factor graphs", + " Decision diagrams", + " Equational models", + " Causal networks", + " Stochastic differential equations", + " Nonparametric representations", + " Kernel density estimators", + " Spline models", + " Bayesian nonparametric models", + " Probabilistic inference problems", + " Maximum likelihood estimation", + " Bayesian computation", + " Computing most probable explanation", + " Hypothesis testing and confidence interval computation", + " Density estimation", + " Quantile regression", + " Max marginal computation", + " Probabilistic reasoning algorithms", + " Variable elimination", + " Loopy belief propagation", + " Variational methods", + " Expectation maximization", + " Markov-chain Monte Carlo methods", + " Gibbs sampling", + " Metropolis-Hastings algorithm", + " Simulated annealing", + " Markov-chain Monte Carlo convergence measures", + " Sequential Monte Carlo methods", + " Kalman filters and hidden Markov models", + " Resampling methods", + " Bootstrapping", + " Jackknifing", + " Random number generation", + " Probabilistic algorithms", + " Statistical paradigms", + " Queueing theory", + " Contingency table analysis", + " Regression analysis", + " Robust regression", + " Time series analysis", + " Survival analysis", + " Renewal theory", + " Dimensionality reduction", + " Cluster analysis", + " Statistical graphics", + " Exploratory data analysis", + " Stochastic processes", + " Markov processes", + " Nonparametric statistics", + " Distribution functions", + " Multivariate statistics", + " Mathematical software", + " Solvers", + " Statistical software", + " Mathematical software performance", + " Information theory", + " Coding theory", + " Mathematical analysis", + " Numerical analysis", + " Computation of transforms", + " Computations in finite fields", + " Computations on matrices", + " Computations on polynomials", + " Gr\246bner bases and other special bases", + " Number-theoretic computations", + " Interpolation", + " Numerical differentiation", + " Interval arithmetic", + " Arbitrary-precision arithmetic", + " Automatic differentiation", + " Mesh generation", + " Discretization", + " Mathematical optimization", + " Discrete optimization", + " Network optimization", + " Optimization with randomized search heuristics", + " Simulated annealing", + " Evolutionary algorithms", + " Tabu search", + " Randomized local search", + " Continuous optimization", + " Linear programming", + " Semidefinite programming", + " Convex optimization", + " Quasiconvex programming and unimodality", + " Stochastic control and optimization", + " Quadratic programming", + " Nonconvex optimization", + " Bio-inspired optimization", + " Mixed discrete-continuous optimization", + " Submodular optimization and polymatroids", + " Integer programming", + " Bio-inspired optimization", + " Non-parametric optimization", + " Genetic programming", + " Developmental representations", + " Differential equations", + " Ordinary differential equations", + " Partial differential equations", + " Differential algebraic equations", + " Differential variational inequalities", + " Calculus", + " Lambda calculus", + " Differential calculus", + " Integral calculus", + " Functional analysis", + " Approximation", + " Integral equations", + " Nonlinear equations", + " Quadrature", + " Continuous mathematics", + " Calculus", + " Lambda calculus", + " Differential calculus", + " Integral calculus", + " Topology", + " Point-set topology", + " Algebraic topology", + " Geometric topology", + " Continuous functions", + " Information systems", + " Data management systems", + " Database design and models", + " Relational database model", + " Entity relationship models", + " Graph-based database models", + " Hierarchical data models", + " Network data models", + " Physical data models", + " Data model extensions", + " Semi-structured data", + " Data streams", + " Data provenance", + " Incomplete data", + " Temporal data", + " Uncertainty", + " Inconsistent data", + " Data structures", + " Data access methods", + " Multidimensional range search", + " Data scans", + " Point lookups", + " Unidimensional range search", + " Proximity search", + " Data layout", + " Data compression", + " Data encryption", + " Record and block layout", + " Database management system engines", + " DBMS engine architectures", + " Database query processing", + " Query optimization", + " Query operators", + " Query planning", + " Join algorithms", + " Database transaction processing", + " Data locking", + " Transaction logging", + " Database recovery", + " Record and buffer management", + " Parallel and distributed DBMSs", + " Key-value stores", + " MapReduce-based systems", + " Relational parallel and distributed DBMSs", + " Triggers and rules", + " Database views", + " Integrity checking", + " Distributed database transactions", + " Distributed data locking", + " Deadlocks", + " Distributed database recovery", + " Main memory engines", + " Online analytical processing engines", + " Stream management", + " Query languages", + " Relational database query languages", + " Structured Query Language", + " XML query languages", + " XPath", + " XQuery", + " Query languages for non-relational engines", + " MapReduce languages", + " Call level interfaces", + " Database administration", + " Database utilities and tools", + " Database performance evaluation", + " Autonomous database administration", + " Data dictionaries", + " Information integration", + " Deduplication", + " Extraction, transformation and loading", + " Data exchange", + " Data cleaning", + " Wrappers (data mining)", + " Mediators and data integration", + " Entity resolution", + " Data warehouses", + " Federated databases", + " Middleware for databases", + " Database web servers", + " Application servers", + " Object-relational mapping facilities", + " Data federation tools", + " Data replication tools", + " Distributed transaction monitors", + " Message queues", + " Service buses", + " Enterprise application integration tools", + " Middleware business process managers", + " Information storage systems", + " Information storage technologies", + " Magnetic disks", + " Magnetic tapes", + " Optical / magneto-optical disks", + " Storage class memory", + " Flash memory", + " Phase change memory", + " Disk arrays", + " Tape libraries", + " Record storage systems", + " Record storage alternatives", + " Heap (data structure)", + " Hashed file organization", + " Indexed file organization", + " Linked lists", + " Directory structures", + " B-trees", + " Vnodes", + " Inodes", + " Extent-based file structures", + " Block / page strategies", + " Slotted pages", + " Intrapage space management", + " Interpage free-space management", + " Record layout alternatives", + " Fixed length attributes", + " Variable length attributes", + " Null values in records", + " Relational storage", + " Horizontal partitioning", + " Vertical partitioning", + " Column based storage", + " Hybrid storage layouts", + " Compression strategies", + " Storage replication", + " Mirroring", + " RAID", + " Point-in-time copies", + " Remote replication", + " Storage recovery strategies", + " Storage architectures", + " Cloud based storage", + " Storage network architectures", + " Storage area networks", + " Direct attached storage", + " Network attached storage", + " Distributed storage", + " Storage management", + " Hierarchical storage management", + " Storage virtualization", + " Information lifecycle management", + " Version management", + " Storage power management", + " Thin provisioning", + " Information systems applications", + " Enterprise information systems", + " Intranets", + " Extranets", + " Enterprise resource planning", + " Enterprise applications", + " Data centers", + " Collaborative and social computing systems and tools", + " Blogs", + " Wikis", + " Reputation systems", + " Open source software", + " Social networking sites", + " Social tagging systems", + " Synchronous editors", + " Asynchronous editors", + " Spatial-temporal systems", + " Location based services", + " Geographic information systems", + " Sensor networks", + " Data streaming", + " Global positioning systems", + " Decision support systems", + " Data warehouses", + " Expert systems", + " Data analytics", + " Online analytical processing", + " Mobile information processing systems", + " Process control systems", + " Multimedia information systems", + " Multimedia databases", + " Multimedia streaming", + " Multimedia content creation", + " Massively multiplayer online games", + " Data mining", + " Data cleaning", + " Collaborative filtering", + " Association rules", + " Clustering", + " Nearest-neighbor search", + " Data stream mining", + " Digital libraries and archives", + " Computational advertising", + " Computing platforms", + " World Wide Web", + " Web searching and information discovery", + " Web search engines", + " Web crawling", + " Web indexing", + " Page and site ranking", + " Spam detection", + " Content ranking", + " Collaborative filtering", + " Social recommendation", + " Personalization", + " Social tagging", + " Online advertising", + " Sponsored search advertising", + " Content match advertising", + " Display advertising", + " Social advertising", + " Web mining", + " Site wrapping", + " Data extraction and integration", + " Deep web", + " Surfacing", + " Search results deduplication", + " Web log analysis", + " Traffic analysis", + " Web applications", + " Internet communications tools", + " Email", + " Blogs", + " Texting", + " Chat", + " Web conferencing", + " Social networks", + " Crowdsourcing", + " Answer ranking", + " Trust", + " Incentive schemes", + " Reputation systems", + " Electronic commerce", + " Digital cash", + " E-commerce infrastructure", + " Electronic data interchange", + " Electronic funds transfer", + " Online shopping", + " Online banking", + " Secure online transactions", + " Online auctions", + " Web interfaces", + " Wikis", + " Browsers", + " Mashups", + " Web services", + " Simple Object Access Protocol (SOAP)", + " RESTful web services", + " Web Services Description Language (WSDL)", + " Universal Description Discovery and Integration (UDDI)", + " Service discovery and interfaces", + " Web data description languages", + " Semantic web description languages", + " Resource Description Framework (RDF)", + " Web Ontology Language (OWL)", + " Markup languages", + " Extensible Markup Language (XML)", + " Hypertext languages", + " Information retrieval", + " Document representation", + " Document structure", + " Document topic models", + " Content analysis and feature selection", + " Data encoding and canonicalization", + " Document collection models", + " Ontologies", + " Dictionaries", + " Thesauri", + " Information retrieval query processing", + " Query representation", + " Query intent", + " Query log analysis", + " Query suggestion", + " Query reformulation", + " Users and interactive retrieval", + " Personalization", + " Task models", + " Search interfaces", + " Collaborative search", + " Retrieval models and ranking", + " Rank aggregation", + " Probabilistic retrieval models", + " Language models", + " Similarity measures", + " Learning to rank", + " Combination, fusion and federated search", + " Information retrieval diversity", + " Top-k retrieval in databases", + " Novelty in information retrieval", + " Retrieval tasks and goals", + " Question answering", + " Document filtering", + " Recommender systems", + " Information extraction", + " Sentiment analysis", + " Expert search", + " Near-duplicate and plagiarism detection", + " Clustering and classification", + " Summarization", + " Business intelligence", + " Evaluation of retrieval results", + " Test collections", + " Relevance assessment", + " Retrieval effectiveness", + " Retrieval efficiency", + " Presentation of retrieval results", + " Search engine architectures and scalability", + " Search engine indexing", + " Search index compression", + " Distributed retrieval", + " Peer-to-peer retrieval", + " Retrieval on mobile devices", + " Adversarial retrieval", + " Link and co-citation analysis", + " Searching with auxiliary databases", + " Specialized information retrieval", + " Structure and multilingual text search", + " Structured text search", + " Mathematics retrieval", + " Chemical and biochemical retrieval", + " Multilingual and cross-lingual retrieval", + " Multimedia and multimodal retrieval", + " Image search", + " Video search", + " Speech / audio search", + " Music retrieval", + " Environment-specific retrieval", + " Enterprise search", + " Desktop search", + " Web and social media search", + " Security and privacy", + " Cryptography", + " Key management", + " Public key (asymmetric) techniques", + " Digital signatures", + " Public key encryption", + " Symmetric cryptography and hash functions", + " Block and stream ciphers", + " Hash functions and message authentication codes", + " Cryptanalysis and other attacks", + " Information-theoretic techniques", + " Mathematical foundations of cryptography", + " Formal methods and theory of security", + " Trust frameworks", + " Security requirements", + " Formal security models", + " Logic and verification", + " Security services", + " Authentication", + " Biometrics", + " Graphical / visual passwords", + " Multi-factor authentication", + " Access control", + " Pseudonymity, anonymity and untraceability", + " Privacy-preserving protocols", + " Digital rights management", + " Authorization", + " Intrusion/anomaly detection and malware mitigation", + " Malware and its mitigation", + " Intrusion detection systems", + " Artificial immune systems", + " Social engineering attacks", + " Spoofing attacks", + " Phishing", + " Security in hardware", + " Tamper-proof and tamper-resistant designs", + " Embedded systems security", + " Hardware security implementation", + " Hardware-based security protocols", + " Hardware attacks and countermeasures", + " Malicious design modifications", + " Side-channel analysis and countermeasures", + " Hardware reverse engineering", + " Systems security", + " Operating systems security", + " Mobile platform security", + " Trusted computing", + " Virtualization and security", + " Browser security", + " Distributed systems security", + " Information flow control", + " Denial-of-service attacks", + " Firewalls", + " Vulnerability management", + " Penetration testing", + " Vulnerability scanners", + " File system security", + " Network security", + " Security protocols", + " Web protocol security", + " Mobile and wireless security", + " Denial-of-service attacks", + " Firewalls", + " Database and storage security", + " Data anonymization and sanitization", + " Management and querying of encrypted data", + " Information accountability and usage control", + " Database activity monitoring", + " Software and application security", + " Software security engineering", + " Web application security", + " Social network security and privacy", + " Domain-specific security and privacy architectures", + " Software reverse engineering", + " Human and societal aspects of security and privacy", + " Economics of security and privacy", + " Social aspects of security and privacy", + " Privacy protections", + " Usability in security and privacy", + " Human-centered computing", + " Human computer interaction (HCI)", + " HCI design and evaluation methods", + " User models", + " User studies", + " Usability testing", + " Heuristic evaluations", + " Walkthrough evaluations", + " Laboratory experiments", + " Field studies", + " Interaction paradigms", + " Hypertext / hypermedia", + " Mixed / augmented reality", + " Command line interfaces", + " Graphical user interfaces", + " Virtual reality", + " Web-based interaction", + " Natural language interfaces", + " Collaborative interaction", + " Interaction devices", + " Graphics input devices", + " Displays and imagers", + " Sound-based input / output", + " Keyboards", + " Pointing devices", + " Touch screens", + " Haptic devices", + " HCI theory, concepts and models", + " Interaction techniques", + " Auditory feedback", + " Text input", + " Pointing", + " Gestural input", + " Interactive systems and tools", + " User interface management systems", + " User interface programming", + " User interface toolkits", + " Empirical studies in HCI", + " Interaction design", + " Interaction design process and methods", + " User interface design", + " User centered design", + " Activity centered design", + " Scenario-based design", + " Participatory design", + " Contextual design", + " Interface design prototyping", + " Interaction design theory, concepts and paradigms", + " Empirical studies in interaction design", + " Systems and tools for interaction design", + " Wireframes", + " Collaborative and social computing", + " Collaborative and social computing theory, concepts and paradigms", + " Social content sharing", + " Collaborative content creation", + " Collaborative filtering", + " Social recommendation", + " Social networks", + " Social tagging", + " Computer supported cooperative work", + " Social engineering (social sciences)", + " Social navigation", + " Social media", + " Collaborative and social computing design and evaluation methods", + " Social network analysis", + " Ethnographic studies", + " Collaborative and social computing systems and tools", + " Blogs", + " Wikis", + " Reputation systems", + " Open source software", + " Social networking sites", + " Social tagging systems", + " Synchronous editors", + " Asynchronous editors", + " Empirical studies in collaborative and social computing", + " Collaborative and social computing devices", + " Ubiquitous and mobile computing", + " Ubiquitous and mobile computing theory, concepts and paradigms", + " Ubiquitous computing", + " Mobile computing", + " Ambient intelligence", + " Ubiquitous and mobile computing systems and tools", + " Ubiquitous and mobile devices", + " Smartphones", + " Interactive whiteboards", + " Mobile phones", + " Mobile devices", + " Portable media players", + " Personal digital assistants", + " Handheld game consoles", + " E-book readers", + " Tablet computers", + " Ubiquitous and mobile computing design and evaluation methods", + " Empirical studies in ubiquitous and mobile computing", + " Visualization", + " Visualization techniques", + " Treemaps", + " Hyperbolic trees", + " Heat maps", + " Graph drawings", + " Dendrograms", + " Cladograms", + " Visualization application domains", + " Scientific visualization", + " Visual analytics", + " Geographic visualization", + " Information visualization", + " Visualization systems and tools", + " Visualization toolkits", + " Visualization theory, concepts and paradigms", + " Empirical studies in visualization", + " Visualization design and evaluation methods", + " Accessibility", + " Accessibility theory, concepts and paradigms", + " Empirical studies in accessibility", + " Accessibility design and evaluation methods", + " Accessibility technologies", + " Accessibility systems and tools", + " Computing methodologies", + " Symbolic and algebraic manipulation", + " Symbolic and algebraic algorithms", + " Combinatorial algorithms", + " Algebraic algorithms", + " Nonalgebraic algorithms", + " Symbolic calculus algorithms", + " Exact arithmetic algorithms", + " Hybrid symbolic-numeric methods", + " Discrete calculus algorithms", + " Number theory algorithms", + " Equation and inequality solving algorithms", + " Linear algebra algorithms", + " Theorem proving algorithms", + " Boolean algebra algorithms", + " Optimization algorithms", + " Computer algebra systems", + " Special-purpose algebraic systems", + " Representation of mathematical objects", + " Representation of exact numbers", + " Representation of mathematical functions", + " Representation of Boolean functions", + " Representation of polynomials", + " Parallel computing methodologies", + " Parallel algorithms", + " MapReduce algorithms", + " Self-organization", + " Shared memory algorithms", + " Vector / streaming algorithms", + " Massively parallel algorithms", + " Parallel programming languages", + " Artificial intelligence", + " Natural language processing", + " Information extraction", + " Machine translation", + " Discourse, dialogue and pragmatics", + " Natural language generation", + " Speech recognition", + " Lexical semantics", + " Phonology / morphology", + " Language resources", + " Knowledge representation and reasoning", + " Description logics", + " Semantic networks", + " Nonmonotonic, default reasoning and belief revision", + " Probabilistic reasoning", + " Vagueness and fuzzy logic", + " Causal reasoning and diagnostics", + " Temporal reasoning", + " Cognitive robotics", + " Ontology engineering", + " Logic programming and answer set programming", + " Spatial and physical reasoning", + " Reasoning about belief and knowledge", + " Planning and scheduling", + " Planning for deterministic actions", + " Planning under uncertainty", + " Multi-agent planning", + " Planning with abstraction and generalization", + " Robotic planning", + " Evolutionary robotics", + " Search methodologies", + " Heuristic function construction", + " Discrete space search", + " Continuous space search", + " Randomized search", + " Game tree search", + " Abstraction and micro-operators", + " Search with partial observations", + " Control methods", + " Robotic planning", + " Evolutionary robotics", + " Computational control theory", + " Motion path planning", + " Philosophical/theoretical foundations of artificial intelligence", + " Cognitive science", + " Theory of mind", + " Distributed artificial intelligence", + " Multi-agent systems", + " Intelligent agents", + " Mobile agents", + " Cooperation and coordination", + " Computer vision", + " Computer vision tasks", + " Biometrics", + " Scene understanding", + " Activity recognition and understanding", + " Video summarization", + " Visual content-based indexing and retrieval", + " Visual inspection", + " Vision for robotics", + " Scene anomaly detection", + " Image and video acquisition", + " Camera calibration", + " Epipolar geometry", + " Computational photography", + " Hyperspectral imaging", + " Motion capture", + " 3D imaging", + " Active vision", + " Computer vision representations", + " Image representations", + " Shape representations", + " Appearance and texture representations", + " Hierarchical representations", + " Computer vision problems", + " Interest point and salient region detections", + " Image segmentation", + " Video segmentation", + " Shape inference", + " Object detection", + " Object recognition", + " Object identification", + " Tracking", + " Reconstruction", + " Matching", + " Machine learning", + " Learning paradigms", + " Supervised learning", + " Ranking", + " Learning to rank", + " Supervised learning by classification", + " Supervised learning by regression", + " Structured outputs", + " Cost-sensitive learning", + " Unsupervised learning", + " Cluster analysis", + " Anomaly detection", + " Mixture modeling", + " Topic modeling", + " Source separation", + " Motif discovery", + " Dimensionality reduction and manifold learning", + " Reinforcement learning", + " Sequential decision making", + " Inverse reinforcement learning", + " Apprenticeship learning", + " Multi-agent reinforcement learning", + " Adversarial learning", + " Multi-task learning", + " Transfer learning", + " Lifelong machine learning", + " Learning under covariate shift", + " Learning settings", + " Batch learning", + " Online learning settings", + " Learning from demonstrations", + " Learning from critiques", + " Learning from implicit feedback", + " Active learning settings", + " Semi-supervised learning settings", + " Machine learning approaches", + " Classification and regression trees", + " Kernel methods", + " Support vector machines", + " Gaussian processes", + " Neural networks", + " Logical and relational learning", + " Inductive logic learning", + " Statistical relational learning", + " Learning in probabilistic graphical models", + " Maximum likelihood modeling", + " Maximum entropy modeling", + " Maximum a posteriori modeling", + " Mixture models", + " Latent variable models", + " Bayesian network models", + " Learning linear models", + " Perceptron algorithm", + " Factorization methods", + " Non-negative matrix factorization", + " Factor analysis", + " Principal component analysis", + " Canonical correlation analysis", + " Latent Dirichlet allocation", + " Rule learning", + " Instance-based learning", + " Markov decision processes", + " Partially-observable Markov decision processes", + " Stochastic games", + " Learning latent representations", + " Deep belief networks", + " Bio-inspired approaches", + " Artificial life", + " Evolvable hardware", + " Genetic algorithms", + " Genetic programming", + " Evolutionary robotics", + " Generative and developmental approaches", + " Machine learning algorithms", + " Dynamic programming for Markov decision processes", + " Value iteration", + " Q-learning", + " Policy iteration", + " Temporal difference learning", + " Approximate dynamic programming methods", + " Ensemble methods", + " Boosting", + " Bagging", + " Spectral methods", + " Feature selection", + " Regularization", + " Cross-validation", + " Modeling and simulation", + " Model development and analysis", + " Modeling methodologies", + " Model verification and validation", + " Uncertainty quantification", + " Simulation theory", + " Systems theory", + " Network science", + " Simulation types and techniques", + " Uncertainty quantification", + " Quantum mechanic simulation", + " Molecular simulation", + " Rare-event simulation", + " Discrete-event simulation", + " Agent / discrete models", + " Distributed simulation", + " Continuous simulation", + " Continuous models", + " Real-time simulation", + " Interactive simulation", + " Multiscale systems", + " Massively parallel and high-performance simulations", + " Data assimilation", + " Scientific visualization", + " Visual analytics", + " Simulation by animation", + " Artificial life", + " Simulation support systems", + " Simulation environments", + " Simulation languages", + " Simulation tools", + " Simulation evaluation", + " Computer graphics", + " Animation", + " Motion capture", + " Procedural animation", + " Physical simulation", + " Motion processing", + " Collision detection", + " Rendering", + " Rasterization", + " Ray tracing", + " Non-photorealistic rendering", + " Reflectance modeling", + " Visibility", + " Image manipulation", + " Computational photography", + " Image processing", + " Texturing", + " Image-based rendering", + " Antialiasing", + " Graphics systems and interfaces", + " Graphics processors", + " Graphics input devices", + " Mixed / augmented reality", + " Perception", + " Graphics file formats", + " Virtual reality", + " Image compression", + " Shape modeling", + " Mesh models", + " Mesh geometry models", + " Parametric curve and surface models", + " Point-based models", + " Volumetric models", + " Shape analysis", + " Distributed computing methodologies", + " Distributed algorithms", + " MapReduce algorithms", + " Self-organization", + " Distributed programming languages", + " Concurrent computing methodologies", + " Concurrent programming languages", + " Concurrent algorithms", + " Applied computing", + " Electronic commerce", + " Digital cash", + " E-commerce infrastructure", + " Electronic data interchange", + " Electronic funds transfer", + " Online shopping", + " Online banking", + " Secure online transactions", + " Online auctions", + " Enterprise computing", + " Enterprise information systems", + " Intranets", + " Extranets", + " Enterprise resource planning", + " Enterprise applications", + " Data centers", + " Business process management", + " Business process modeling", + " Business process management systems", + " Business process monitoring", + " Cross-organizational business processes", + " Business intelligence", + " Enterprise architectures", + " Enterprise architecture management", + " Enterprise architecture frameworks", + " Enterprise architecture modeling", + " Service-oriented architectures", + " Event-driven architectures", + " Business rules", + " Enterprise modeling", + " Enterprise ontologies, taxonomies and vocabularies", + " Enterprise data management", + " Reference models", + " Business-IT alignment", + " IT architectures", + " IT governance", + " Enterprise computing infrastructures", + " Enterprise interoperability", + " Enterprise application integration", + " Information integration and interoperability", + " Physical sciences and engineering", + " Aerospace", + " Avionics", + " Archaeology", + " Astronomy", + " Chemistry", + " Earth and atmospheric sciences", + " Environmental sciences", + " Engineering", + " Computer-aided design", + " Physics", + " Mathematics and statistics", + " Electronics", + " Avionics", + " Telecommunications", + " Internet telephony", + " Life and medical sciences", + " Computational biology", + " Molecular sequence analysis", + " Recognition of genes and regulatory elements", + " Molecular evolution", + " Computational transcriptomics", + " Biological networks", + " Sequencing and genotyping technologies", + " Imaging", + " Computational proteomics", + " Molecular structural biology", + " Computational genomics", + " Genomics", + " Computational genomics", + " Systems biology", + " Consumer health", + " Health care information systems", + " Health informatics", + " Bioinformatics", + " Metabolomics / metabonomics", + " Genetics", + " Population genetics", + " Proteomics", + " Computational proteomics", + " Transcriptomics", + " Law, social and behavioral sciences", + " Anthropology", + " Ethnography", + " Law", + " Psychology", + " Economics", + " Sociology", + " Computer forensics", + " Surveillance mechanisms", + " Investigation techniques", + " Evidence collection, storage and analysis", + " Network forensics", + " System forensics", + " Data recovery", + " Arts and humanities", + " Fine arts", + " Performing arts", + " Architecture (buildings)", + " Computer-aided design", + " Language translation", + " Media arts", + " Sound and music computing", + " Computers in other domains", + " Digital libraries and archives", + " Publishing", + " Military", + " Cyberwarfare", + " Cartography", + " Agriculture", + " Computing in government", + " Voting / election technologies", + " E-government", + " Personal computers and PC applications", + " Word processors", + " Spreadsheets", + " Computer games", + " Microcomputers", + " Operations research", + " Consumer products", + " Industry and manufacturing", + " Supply chain management", + " Command and control", + " Computer-aided manufacturing", + " Decision analysis", + " Multi-criterion optimization and decision-making", + " Transportation", + " Forecasting", + " Marketing", + " Education", + " Digital libraries and archives", + " Computer-assisted instruction", + " Interactive learning environments", + " Collaborative learning", + " Learning management systems", + " Distance learning", + " E-learning", + " Computer-managed instruction", + " Document management and text processing", + " Document searching", + " Document management", + " Text editing", + " Version control", + " Document metadata", + " Document capture", + " Document analysis", + " Document scanning", + " Graphics recognition and interpretation", + " Optical character recognition", + " Online handwriting recognition", + " Document preparation", + " Markup languages", + " Extensible Markup Language (XML)", + " Hypertext languages", + " Annotation", + " Format and notation", + " Multi / mixed media creation", + " Image composition", + " Hypertext / hypermedia creation", + " Document scripting languages", + " Social and professional topics", + " Professional topics", + " Computing industry", + " Industry statistics", + " Computer manufacturing", + " Sustainability", + " Management of computing and information systems", + " Project and people management", + " Project management techniques", + " Project staffing", + " Systems planning", + " Systems analysis and design", + " Systems development", + " Computer and information systems training", + " Implementation management", + " Hardware selection", + " Computing equipment management", + " Pricing and resource allocation", + " Software management", + " Software maintenance", + " Software selection and adaptation", + " System management", + " Centralization / decentralization", + " Technology audits", + " Quality assurance", + " Network operations", + " File systems management", + " Information system economics", + " History of computing", + " Historical people", + " History of hardware", + " History of software", + " History of programming languages", + " History of computing theory", + " Computing education", + " Computational thinking", + " Accreditation", + " Model curricula", + " Computing education programs", + " Information systems education", + " Computer science education", + " CS1", + " Computer engineering education", + " Information technology education", + " Information science education", + " Computational science and engineering education", + " Software engineering education", + " Informal education", + " Computing literacy", + " Student assessment", + " K-12 education", + " Adult education", + " Computing and business", + " Employment issues", + " Automation", + " Computer supported cooperative work", + " Economic impact", + " Offshoring", + " Reengineering", + " Socio-technical systems", + " Computing profession", + " Codes of ethics", + " Employment issues", + " Funding", + " Computing occupations", + " Computing organizations", + " Testing, certification and licensing", + " Assistive technologies", + " Computing / technology policy", + " Intellectual property", + " Digital rights management", + " Copyrights", + " Software reverse engineering", + " Patents", + " Trademarks", + " Internet governance / domain names", + " Licensing", + " Treaties", + " Database protection laws", + " Secondary liability", + " Soft intellectual property", + " Hardware reverse engineering", + " Privacy policies", + " Censorship", + " Pornography", + " Hate speech", + " Political speech", + " Technology and censorship", + " Censoring filters", + " Surveillance", + " Governmental surveillance", + " Corporate surveillance", + " Commerce policy", + " Taxation", + " Transborder data flow", + " Antitrust and competition", + " Governmental regulations", + " Online auctions policy", + " Consumer products policy", + " Network access control", + " Censoring filters", + " Broadband access", + " Net neutrality", + " Network access restrictions", + " Age-based restrictions", + " Acceptable use policy restrictions", + " Universal access", + " Computer crime", + " Social engineering attacks", + " Spoofing attacks", + " Phishing", + " Identity theft", + " Financial crime", + " Malware / spyware crime", + " Government technology policy", + " Governmental regulations", + " Import / export controls", + " Medical information policy", + " Medical records", + " Personal health records", + " Genetic information", + " Patient privacy", + " Health information exchanges", + " Medical technologies", + " Remote medicine", + " User characteristics", + " Race and ethnicity", + " Religious orientation", + " Gender", + " Men", + " Women", + " Sexual orientation", + " People with disabilities", + " Geographic characteristics", + " Cultural characteristics", + " Age", + " Children", + " Seniors", + " Adolescents" + ] + diff --git a/cp2223t/Exp.hs b/cp2223t/Exp.hs new file mode 100644 index 0000000..2e1456b --- /dev/null +++ b/cp2223t/Exp.hs @@ -0,0 +1,221 @@ + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module Exp where + +import Cp +import BTree +import LTree +import FTree +import System.Process +import GHC.IO.Exception +import St +import List hiding (lookup) +import Data.List +import RelCalc + +-- (0) Functions dependent on your OS ------------------------------------- + +wopen = ("start/b "++) +mopen = ("open "++) + +--1) Windows + +--open = wopen + +--2) Mac OS + +open = mopen + +expShow fn e = do { expDisplay fn (mirrorExp e) ; system(open fn) } + +-- (1) Datatype definition ----------------------------------------------------- + +data Exp v o = Var v -- expressions are either variables + | Term o [ Exp v o ] -- or terms involving operators and + -- subterms + deriving (Show,Eq) + +inExp = either Var (uncurry Term) +outExp(Var v) = i1 v +outExp(Term o l) = i2(o,l) + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +baseExp f g h = f -|- (g >< map h) + +recExp x = baseExp id id x + +cataExp g = g . recExp (cataExp g) . outExp + +anaExp g = inExp . recExp (anaExp g) . g + +hyloExp h g = cataExp h . anaExp g + +-- (3) Map --------------------------------------------------------------------- + +instance BiFunctor Exp + where bmap f g = cataExp ( inExp . baseExp f g id ) + +-- (4) Examples ---------------------------------------------------------------- + +mirrorExp = cataExp (inExp . (id -|- (id> [a] +expLeaves = cataExp (either singl (concat . p2)) + +expOps :: Exp a b -> [b] +expOps = cataExp (either nil (cons . (id> Int +expWidth = length . expLeaves + +expDepth :: Exp a b -> Int +expDepth = cataExp (either (const 1) (succ . (foldr max 0) . p2)) + +nodes :: Exp a a -> [a] +nodes = cataExp (either singl g) where g = cons . (id >< concat) + +graph :: Exp (a, b) (c, d) -> Exp a c +graph = bmap fst fst + +-- (5) Graphics (DOT / HTML) --------------------------------------------------- + +cExp2Dot :: Exp (Maybe String) (Maybe String) -> String +cExp2Dot x = beg ++ main (deco x) ++ end where + main b = concat $ (map f . nodes) b ++ (map g . lnks . graph) b + beg = "digraph G {\n /* edge [label=0]; */\n graph [ranksep=0.5];\n" + end = "}\n" + g(k1,k2) = " " ++ show k1 ++ " -> " ++ show k2 ++ "[arrowhead=none];\n" + f(k,Nothing) = " " ++ show k ++ " [shape=plaintext, label=\"\"];\n" + f(k,Just s) = " " ++ show k ++ " [shape=circle, style=filled, fillcolor=\"#FFFF00\", label=\"" ++ s ++ "\"];\n" + +dotpict t = do { writeFile "_.dot" (cExp2Dot t) ; system "open _.dot" } + +exp2Html n (Var v) = [ LCell v n 1 ] +exp2Html n (Term o l) = g (expWidth (Term o l)) o (map (exp2Html (n-1)) l) + where g i o k = [ ICell o 1 i ] ++ (foldr (++) [] k) + +expDisplay :: FilePath -> Exp String String -> IO () +expDisplay fn = writeFile fn . exp2txt + +exp2txt = concat . txtFlat . (html2Txt Str) . (uncurry exp2Html . (split expDepth id)) + +type Html a = [ Cell a ] + +data Cell a = ICell a Int Int | LCell a Int Int deriving Show + +data Txt = Str String | Blk [ Txt ] deriving Show + +inds :: [a] -> [Int] +inds [] = [] +inds (h:t) = inds t ++ [succ (length t)] + +seq2ff :: [a] -> [(Int,a)] +seq2ff = (uncurry zip) . (split inds id) + +ff2seq m = map p2 m + +txtFlat :: Txt -> [[Char]] +txtFlat (Str s) = [s] +txtFlat (Blk []) = [] +txtFlat (Blk (a:l)) = txtFlat a ++ txtFlat (Blk l) + +html2Txt :: (a -> Txt) -> Html a -> Txt +html2Txt f = html . table . (foldr g u) + where u = Str "\n" + g c (Str s) = g c (Blk [Str s]) + g (ICell a x y) (Blk b) = Blk ([ cell (f a) x y ] ++ b) + g (LCell a x y) (Blk b) = Blk ([ cell (f a) x y, Str "\n\n"] ++ b) + html t = Blk [ Str(""++"\n\n"), + t, + Str "\n" + ] + table t = Blk [ Str "", + t, + Str "
\n" + ] + cell c x y = Blk [ Str("\n\n"), + c, + Str "\n" + ] + itoa x = show x + +-- (6) Monad ------------------------------------------------------------------- + +muExp = cataExp (either id (uncurry Term)) + +-- (7) Auxiliary functions ----------------------------------------------------- + +class (Show t) => Expclass t where + pict :: t -> IO ExitCode +-------------------------------------------------------------------------------- +instance (Show v, Show o) => Expclass (Exp v o) where + pict = expShow "_.html" . bmap show show +-------------------------------------------------------------------------------- +instance (Show a) => Expclass (BTree a) where + pict = expShow "_.html" . cBTree2Exp . (fmap show) + +cBTree2Exp :: BTree a -> Exp [Char] a +cBTree2Exp = cataBTree (either (const (Var "nil")) h) + where h(a,(b,c)) = Term a [b,c] +-------------------------------------------------------------------------------- +instance (Show a) => Expclass [a] where + pict = expShow "_.html" . cL2Exp . (fmap show) + +cL2Exp [] = Var " " +cL2Exp l = Term "List" (map Var l) + +-------------------------------------------------------------------------------- +instance (Show a) => Expclass (LTree a) where + pict = expShow "_.html" . cLTree2Exp . (fmap show) + +cLTree2Exp = cataLTree (either Var h) + where h(a,b) = Term "Fork" [a,b] +-------------------------------------------------------------------------------- +cFTree2Exp = cataFTree (inExp . (id -|- (id> [(a, a)] +lnks (Var n) = [] +lnks (Term n x) = (x >>= lnks) ++ [ (n,m) | Term m _ <- x ] ++ [ (n,m) | Var m <- x ] +-------------------------------------------------------------------------------- +deco :: Num n => Exp v o -> Exp (n, v) (n, o) +deco e = fst (st (f e) 0) where + f (Var e) = do {n <- get ; put(n+1); return (Var(n,e)) } + f (Term o l) = do { n <- get ; put(n+1); + m <- sequence (map f l); + return (Term (n,o) m) + } +-------------------------------------------------------------------------------- +untar :: (Ord v, Ord o) => [([o], v)] -> [Exp v o] +untar = a . (base id id untar) . c where + a=sort.map inExp -- algebra + c=join.(id>< id)) -- coalgebra + base a b y = map(b -|- a >< y) + +tar = cataExp g where + g = either v o + v = singl . (split nil id) + o = (>>= f ) . lstr + f (o,l)=[(o:a,x)|(a,x)<-l] + +instance (Ord v, Ord o) => Ord (Exp v o) where + Var v <= Var u = v <= u + Var v <= Term o x = False + Term o x <= Var v = True + Term o x <= Term o' x' = o >= o' + +{-- instance Ord (Exp String String) where + Var v <= Var u = v <= u + Var v <= Term o x = False + Term o x <= Var v = True + Term o x <= Term o' x' = o >= o' +--} +------------------------------------------------------------------------------- diff --git a/cp2223t/FTree.hs b/cp2223t/FTree.hs new file mode 100644 index 0000000..61142aa --- /dev/null +++ b/cp2223t/FTree.hs @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -XNPlusKPatterns #-} + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module FTree where + +import Cp + +-- (1) Datatype definition ----------------------------------------------------- + +data FTree a c = Unit c | Comp a (FTree a c, FTree a c) deriving Show + +inFTree = either Unit (uncurry Comp) + +outFTree (Unit c) = Left c +outFTree (Comp a (t1,t2)) = Right(a,(t1,t2)) + +baseFTree f g h = f -|- (g >< (h >< h)) + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +recFTree f = baseFTree id id f + +cataFTree a = a . (recFTree (cataFTree a)) . outFTree + +anaFTree f = inFTree . (recFTree (anaFTree f) ) . f + +hyloFTree a c = cataFTree a . anaFTree c + +-- (3) Map --------------------------------------------------------------------- + +instance BiFunctor FTree + where bmap f g = cataFTree ( inFTree . baseFTree g f id ) + +-- (4) Examples ---------------------------------------------------------------- + +-- (4.1) Inversion (mirror) ---------------------------------------------------- + +invFTree = cataFTree (inFTree . (id -|- id >< swap)) + +-- (4.2) Counting -------------------------------------------------------------- + +countFTree = cataFTree (either (const 1) (succ . (uncurry (+)) . p2)) + +-- (4.3) Flattening ------------------------------------------------------------ + +flatFTree = cataFTree flt + +flt = either singl (cons.(id> LTree a +inLTree = either Leaf Fork + +outLTree :: LTree a -> Either a (LTree a,LTree a) +outLTree (Leaf a) = i1 a +outLTree (Fork (t1,t2)) = i2 (t1,t2) + +baseLTree g f = g -|- f >< f + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +recLTree f = baseLTree id f -- that is: id -|- (f >< f) + +cataLTree g = g . (recLTree (cataLTree g)) . outLTree + +anaLTree f = inLTree . (recLTree (anaLTree f) ) . f + +hyloLTree f g = cataLTree f . anaLTree g + +-- (3) Map --------------------------------------------------------------------- + +instance Functor LTree + where fmap f = cataLTree ( inLTree . baseLTree f id ) + +-- (4) Examples ---------------------------------------------------------------- + +-- (4.0) Inversion (mirror) ---------------------------------------------------- + +mirrorLTree = cataLTree (inLTree . (id -|- swap)) + +-- (4.1) Count and depth ------------------------------------------------------- + +countLTree = cataLTree (either one add) + +depth = cataLTree (either one (succ.umax)) + +-- (4.2) Serialization --------------------------------------------------------- + +tips = cataLTree (either singl conc) + +-- (4.3) Double factorial ------------------------------------------------------ + +dfac 0 = 1 +dfac n = hyloLTree (either id mul) dfacd (1,n) + +dfacd(n,m) | n==m = i1 n + | otherwise = i2 ((n,k),(k+1,m)) + where k = div (n+m) 2 + +-- (4.4) Double square function ------------------------------------------------ + +dsq 0 = 0 +dsq n = (cataLTree (either id add) . fmap (\n->2*n-1) . (anaLTree dfacd)) (1,n) + +{-- +dsq 0 = 0 +dsq n = (hyloLTree (either id add) (fdfacd nthodd)) (1,n) + where nthodd n = 2*n - 1 + fdfacd f (n,m) | n==m = i1 (f n) + | otherwise = i2 ((n,k),(k+1,m)) + where k = div (n+m) 2 +--} + +-- (4.5) Fibonacci ------------------------------------------------------------- + +fib = hyloLTree (either one add) fibd + +-- where + +fibd n | n < 2 = i1 () + | otherwise = i2 (n-1,n-2) + +-- (4.6) Merge sort ------------------------------------------------------------ + +mSort :: Ord a => [a] -> [a] +mSort [] = [] +mSort l = hyloLTree (either singl merge) lsplit l + +--where + +-- singl x = [x] + +merge (l,[]) = l +merge ([],r) = r +merge (x:xs,y:ys) | x < y = x : merge(xs,y:ys) + | otherwise = y : merge(x:xs,ys) + +lsplit [x] = i1 x +lsplit l = i2 (sep l) where + sep [] = ([],[]) + sep (h:t) = let (l,r) = sep t in (h:r,l) -- a List cata + +{-- pointwise version: + +mSort :: Ord a => [a] -> [a] +mSort [] = [] +mSort [x] = [x] +mSort l = let (l1,l2) = sep l + in merge(mSort l1, mSort l2) +--} + +-- (4.7) Double map (unordered lists) ------------------------------------------ + +dmap :: (b -> a) -> [b] -> [a] +dmap f [] = [] +dmap f x = (hyloLTree (either (singl.f) conc) lsplit) x + +-- (4.8) Double map (keeps the order) ------------------------------------------ + +dmap1 :: (b -> a) -> [b] -> [a] +dmap1 f [] = [] +dmap1 f x = (hyloLTree (either (singl.f) conc) divide) x + where divide [x] = i1 x + divide l = i2 (split (take m) (drop m) l) where m = div (length l) 2 + +-- (4.8) Combinations ---------------------------------------------------------- + +comb = hyloLTree (either id add) divide + where divide(n,k) = if k `elem` [0,n] then i1 1 else i2((n-1,k),(n-1,k-1)) + +{-- pointwise: comb (n,k) = if k `elem` [0,n] then 1 else comb(n-1,k)+comb(n-1,k-1) --} + +-- (5) Monads ------------------------------------------------------------------ + +instance Monad LTree where + return = Leaf + t >>= g = (mu . fmap g) t + +mu :: LTree (LTree a) -> LTree a +mu = cataLTree (either id Fork) + +instance Strong LTree + +{-- fmap :: (Monad m) => (t -> a) -> m t -> m a + fmap f t = do { a <- t ; return (f a) } +--} + +mcataLTree g = k where + k (Leaf a) = return(g1 a) + k (Fork(x,y)) = do { a <- k x; b <- k y; return(g2(a,b)) } + g1 = g . i1 + g2 = g . i2 + +-- (6) Going polytipic ------------------------------------------------------- + +-- natural transformation from base functor to monoid +tnat :: Monoid c => (a -> c) -> Either a (c, c) -> c +tnat f = either f (uncurry mappend) + +-- monoid reduction + +monLTree f = cataLTree (tnat f) + +-- alternative to (4.2) serialization ---------------------------------------- + +tips' = monLTree singl + +-- alternative to (4.1) counting --------------------------------------------- + +countLTree' = monLTree (const (Sum 1)) + +-- distributive law ---------------------------------------------------------- + +dlLTree :: Strong f => LTree (f a) -> f (LTree a) +dlLTree = cataLTree (either (fmap Leaf) (fmap Fork .dstr)) + +-- (7) Zipper ---------------------------------------------------------------- + +data Deriv a = Dr Bool (LTree a) + +type Zipper a = [ Deriv a ] + +plug :: Zipper a -> LTree a -> LTree a +plug [] t = t +plug ((Dr False l):z) t = Fork (plug z t,l) +plug ((Dr True r):z) t = Fork (r,plug z t) + +-- (8) Advanced -------------------------------------------------------------- + +instance Applicative LTree where + pure = return + (<*>) = aap + +-- (9) Spine representation -------------------------------------------------- + +roll = inLTree.(id -|- roll>< id).beta.(id>< id).spineOut + +spineOut = beta.(id>< id).outLTree + +alpha :: Either a ((a, t), t1) -> (a, Either () (t1, t)) +alpha(Left a) = (a,Left()) +alpha(Right ((a,ts),t)) = (a,Right(t,ts)) + +beta :: (a, Either () (t1, t)) -> Either a ((a, t), t1) +beta(a,Left()) = Left a +beta(a,Right(t,ts)) = Right ((a,ts),t) + +height = cataLTree (either id (uncurry ht)) where ht a b = 1 + (max a b) + +---------------------------- end of library ---------------------------------- + diff --git a/cp2223t/List.hs b/cp2223t/List.hs new file mode 100644 index 0000000..2736b07 --- /dev/null +++ b/cp2223t/List.hs @@ -0,0 +1,216 @@ + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module List where + +import Cp +import Data.List +import Nat hiding (fac) + +-- (1) Datatype definition ----------------------------------------------------- + +--- Haskell lists are already defined, so the following is a dummy, informal declaration: +--- data [a] = [] | (a : [a]) + +inList = either nil cons + +outList [] = i1 () +outList (a:x) = i2(a,x) + +baseList g f = id -|- g >< f + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +recList f = id -|- id >< f -- this is F f for this data type + +cataList g = g . recList (cataList g) . outList + +anaList g = inList . recList (anaList g) . g + +hyloList f g = cataList f . anaList g + +-- (3) Map --------------------------------------------------------------------- +-- NB: already in the Haskell Prelude + +-- (4) Examples ---------------------------------------------------------------- + +-- (4.1) number representation (base b) evaluator ------------------------------ + +eval b = cataList (either zero (add.(id><(b*)))) + +-- eval b [] = 0 +-- eval b (x:xs) = x + b * (eval b xs) + +-- (4.2) inversion ------------------------------------------------------------- + +reverse' = cataList (either nil snoc) where snoc(a,l) = l ++ [a] + +-- alternatively: snoc = conc . swap . (singl >< id) +-- where singl a = [a] +-- conc = uncurry (++) + +-- (4.3) Look-up function ------------------------------------------------------ + +lookup :: Eq a => a -> [(a,b)] -> Maybe b +lookup k = cataList (either nothing aux) + where nothing = const Nothing + aux((a,b),r) + | a == k = Just b + | otherwise = r + +-- (4.4) Insertion sort -------------------------------------------------------- + +iSort :: Ord a => [a] -> [a] +iSort = cataList (either nil insert) + where insert(x,[]) = [x] + insert(x,a:l) | x < a = [x,a]++l + | otherwise = a:(insert(x,l)) + +-- also iSort = hyloList (either (const []) insert) outList + +-- (4.5) take (cf GHC.List.take) ----------------------------------------------- + +utake = anaList aux + where aux(0,_) = i1() + aux(_,[]) = i1() + aux(n,x:xs) = i2(x,(n-1,xs)) + +-- pointwise version: +-- take 0 _ = [] +-- take _ [] = [] +-- take (n+1) (x:xs) = x : take n xs + +-- (4.6) Factorial-------------------------------------------------------------- + +fac :: Integer -> Integer +fac = hyloList (either (const 1) mul) natg + +natg = (id -|- (split succ id)) . outNat + +-- (4.6.1) Factorial (alternative) --------------------------------------------- + +fac' = hyloList (either (const 1) (mul . (succ >< id))) + ((id -|- (split id id)) . outNat) + +{-- cf: + +fac' = hyloList (either (const 1) g) natg' + where g(n,m) = (n+1) * m + natg' 0 = i1 () + natg' (n+1) = i2 (n,n) +--} + +-- (4.7) Square function ------------------------------------------------------- + +sq = hyloList summing oddd + +summing = either (const 0) add + +evens = anaList evend + +odds = anaList oddd + +evend = (id -|- (split (2*) id)) . outNat + +oddd = (id -|- (split odd id)) . outNat + where odd n = 2*n+1 + +{-- pointwise: +sq 0 = 0 +sq (n+1) = 2*n+1 + sq n + +cf. Newton's binomial: (n+1)^2 = n^2 + 2n + 1 +--} + +-- (4.7.1) Square function reusing anaList of factorial ---------------------------- + +sq' = (cataList summing) . fmap (\n->2*n-1) . (anaList natg) + +-- (4.8) Prefixes and suffixes ------------------------------------------------- + +prefixes :: Eq a => [a] -> [[a]] +prefixes = cataList (either (const [[]]) scan) + where scan(a,l) = [[]] ++ (map (a:) l) + +suffixes = anaList g + where g = (id -|- (split cons p2)).outList + +diff :: Eq a => [a] -> [a] -> [a] +diff x l = cataList (either nil (g l)) x + where g l (a,x) = if (a `elem` l) then x else (a:x) + +-- (4.9) Grouping -------------------------------------------------------------- + +chunksOf :: Int -> [a] -> [[a]] +chunksOf n = anaList (g n) where + g n [] = i1() + g n x = i2(take n x,drop n x) + +nest = chunksOf + +-- (4.10) Relationship with foldr, foldl ---------------------------------------- + +myfoldr :: (a -> b -> b) -> b -> [a] -> b +myfoldr f u = cataList (either (const u) (uncurry f)) + +myfoldl :: (a -> b -> a) -> a -> [b] -> a +myfoldl f u = cataList' (either (const u) (uncurry f . swap)) + where cataList' g = g . recList (cataList' g) . outList' + outList' [] = i1() + outList' x =i2(last x, blast x) + blast = tail . reverse + +-- (4.11) No repeats ------------------------------------------------------------ + +nr :: Eq a => [a] -> Bool +nr = p2 . aux where + aux = cataList (either f (split g h)) + f _ = ([],True) + g(a,(t,b)) = a:t + h(a,(t,b)) = not(a `elem` t) && b + +-- (4.12) Advanced -------------------------------------------------------------- + +-- (++) as a list catamorphism ------------------------------------------------ + +ccat :: [a] -> [a] -> [a] +ccat = cataList (either (const id) compose). map (:) where + -- compose(f,g) = f.g + compose = curry(ap.(id> [m a] -> m [a] +lam = cataList ( either (return.nil)(fmap cons.dstr) ) + +-- monadic catas + +mcataList :: Strong ff => (Either () (b, c) -> ff c) -> [b] -> ff c +mcataList g = g .! (dl . recList (mcataList g) . outList) + +dl :: Strong m => Either () (b, m a) -> m (Either () (b, a)) +dl = either (return.i1)(fmap i2. lstr) + +--lam' = mcataList (either (return.nil)(fmap cons.rstr)) + +-- streaming ------------------------------------------------------------------- + +stream f g c x = case f c of + Just (b, c') -> b : stream f g c' x + Nothing -> case x of + a:x' -> stream f g (g c a) x' + [] -> [] + +-- heterogeneous lists --------------------------------------------------------- + +join :: ([a], [b]) -> [Either a b] +join (a, b) = map i1 a ++ map i2 b + +sep = split s1 s2 where + s1 []=[]; s1(Left a:x) = a:s1 x; s1(Right b:x)=s1 x + s2 []=[]; s2(Left a:x) = s2 x; s2(Right b:x)=b:s2 x +---- end of List.hs ------------------------------------------------------------ diff --git a/cp2223t/ListUtils.hs b/cp2223t/ListUtils.hs new file mode 100644 index 0000000..4313bab --- /dev/null +++ b/cp2223t/ListUtils.hs @@ -0,0 +1,26 @@ +module ListUtils where + + +-- create a singleton list +-- +singleton :: a -> [a] +singleton x = [x] + + +-- create a list of length n +-- +--replicate :: Int -> a -> [a] +--replicate n x = take n (repeat x) + + +-- apply a function to the nth element of a list +-- +onNth :: Int -> (a -> a) -> [a] -> [a] +-- onNth n f xs | n<1 = xs +-- onNth 1 f (x:xs) = f x:xs +-- onNth n f (x:xs) = x:onNth (n-1) f xs + +onNth n f xs | n<1 = xs +onNth n f xs = case splitAt (n-1) xs of + (ys,[]) -> ys + (ys,z:zs') -> ys++f z:zs' diff --git a/cp2223t/Makefile b/cp2223t/Makefile new file mode 100644 index 0000000..0067590 --- /dev/null +++ b/cp2223t/Makefile @@ -0,0 +1,17 @@ +NAME = cp2223t + +quick: + lhs2TeX $(NAME).lhs > $(NAME).tex + pdflatex $(NAME).tex + open $(NAME).pdf + +full: + lhs2TeX $(NAME).lhs > $(NAME).tex + pdflatex $(NAME).tex + bibtex $(NAME) + makeindex $(NAME) + pdflatex $(NAME).tex + open $(NAME).pdf + +clean: + rm -f $(NAME).tex $(NAME).out $(NAME).aux $(NAME).bbl $(NAME).blg $(NAME).log $(NAME).ptb diff --git a/cp2223t/NEList.hs b/cp2223t/NEList.hs new file mode 100644 index 0000000..13c212d --- /dev/null +++ b/cp2223t/NEList.hs @@ -0,0 +1,49 @@ + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module NEList where + +import Cp + +-- (1) Datatype definition ----------------------------------------------------- + +-- data [a] = a | (:) a ( a) deriving Show + +inl = either singl (uncurry (:)) + +out [a] = Left a +out (a:x) = Right(a,x) + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +base g f = g -|- (g >< f) + +rec f = base id f + +cata g = g . rec (cata g) . out + +ana g = inl . (rec (ana g) ) . g + +hylo h g = cata h . ana g + + +-- (3) Examples ---------------------------------------------------------------- + +concatg ([],ys) = i1 ys +concatg (x:xs,ys) = i2([x],(xs,ys)) + +concath = either id f + where f([a],l) = a:l + +glast = cata (either id p2) + +{-- +merge (l,[]) = l +merge ([],r) = r +merge (x:xs,y:ys) | x < y = x : merge(xs,y:ys) + | otherwise = y : merge(x:xs,ys) +--} +mrg (l,[]) = i1 l +mrg ([],r) = i1 r +mrg (x:xs,y:ys) | x < y = i2(x,(xs,y:ys)) + | otherwise = i2(y,(x:xs,ys)) diff --git a/cp2223t/Nat.hs b/cp2223t/Nat.hs new file mode 100644 index 0000000..dd84bf9 --- /dev/null +++ b/cp2223t/Nat.hs @@ -0,0 +1,107 @@ +{-# OPTIONS_GHC -XNPlusKPatterns #-} + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module Nat where + +import Cp + +-- (1) Datatype definition ----------------------------------------------------- + +-- "data Nat = 0 | succ Nat" -- in fact: Haskell Integer is used as carrier type + +inNat = either (const 0) succ + +outNat 0 = i1 () +outNat (n+1) = i2 n + +-- NB: inNat and outNat are isomorphisms only if restricted to non-negative integers + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +recNat f = id -|- f -- this is F f for this datatype + +cataNat g = g . recNat (cataNat g) . outNat + +anaNat h = inNat . (recNat (anaNat h) ) . h + +hyloNat g h = cataNat g . anaNat h + +-- paraNat g = g . recNat (split id (paraNat g)) . outNat + +-- (3) Map --------------------------------------------------------------------- + +-- (4) Examples ---------------------------------------------------------------- + +-- (4.1) for is the "fold" of natural numbers + +for b i = cataNat (either (const i) b) + +somar a = cataNat (either (const a) succ) -- for succ a + +multip a = cataNat (either (const 0) (a+)) -- for (a+) 0 + +exp a = cataNat (either (const 1) (a*)) -- for (a*) 1 + +-- (4.2) sq (square of a natural number) + +sq 0 = 0 +sq (n+1) = oddn n + sq n where oddn n = 2*n+1 + +-- sq = paraNat (either (const 0) g)i + +sq' = p1 . aux + -- this is the outcome of calculating sq as a for loop using the + -- mutual recursion law + where aux = cataNat (either (split (const 0)(const 1)) (split (uncurry (+))((2+).p2))) + +sq'' n = -- the same as a for loop (putting variables in) + p1 (for body (0,1) n) + where body(s,o) = (s+o,2+o) + +-- (4.3) factorial + +fac = p2. facfor +facfor = for (split (succ.p1) mul) (1,1) + +-- factorial = paraNat (either (const 1) g) where g(n,r) = (n+1) * r + +-- (4.4) integer division as an anamorphism -------------- + +idiv :: Integer -> Integer -> Integer +{-- pointwise +x `idiv` y | x < y = 0 + | x >= y = (x - y) `idiv` y + 1 +--} + +idiv = flip aux + +aux y = anaNat divide where + divide x | x < y = i1 () + | x >= y = i2 (x - y) + +--- (4.5) bubble sort ----------------------------------- + +bSort xs = for bubble xs (length xs) where + bubble (x:y:xs) + | x > y = y : bubble (x:xs) + | otherwise = x : bubble (y:xs) + bubble x = x + +--- (5) While loop ------------------------------------- + +{-- pointwise + +while p f x | not (p x) = x + | otherwise = while p f (f x) +--} + +while :: (a -> Bool) -> (a -> a) -> a -> a +while p f = w where w = (either id id) . (w -|- id) . (f -|- id) . (grd p) + +--- (5) Monadic for ------------------------------------- + +mfor b i 0 = i +mfor b i (n+1) = do {x <- mfor b i n ; b x} + +--- end of Nat.hs ---------------------------------------- diff --git a/cp2223t/Probability.hs b/cp2223t/Probability.hs new file mode 100644 index 0000000..776ba2a --- /dev/null +++ b/cp2223t/Probability.hs @@ -0,0 +1,697 @@ + +-- Credits: Erwig, Martin and Kollmannsberger, Steve +-- FUNCTIONAL PEARLS: Probabilistic functional programming in Haskell, +-- JFP, 2006 +-- DOI: 10.1017/S0956796805005721 + +module Probability where + +import qualified System.Random +import Data.List (sort,sortBy,transpose) +import Control.Monad +import System.IO.Unsafe (unsafePerformIO) + +import ListUtils +import Show + +{- TO DO: + +* create export list + +* extend Dist by a constructor for continuous distributions: + + C (Float -> Float) + +* prove correctness of ||| + +-} + +--------- jno (to be checked) -------------- +import Control.Applicative +instance Applicative Dist where + pure = return + (<*>) = ap + +instance Alternative Dist where + empty = D [] + (<|>) = (>>) +--------- end jno -------------------------- + + +------------------------------------------------------------------------------ +-- CONTENTS: +-- +-- 0 AUXILIARY DEFINITIONS +-- 1 DETERMINISTIC AND PROBABILISTIC VALUES +-- 2 RANDOMIZED VALUES +-- 3 DETERMINISTIC AND PROBABILISTIC GENERATORS +-- 4 RANDOMIZED GENERATORS +-- 5 ITERATORS AND SIMULATORS +-- 6 TRACING +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------ +-- 0 AUXILIARY DEFINITIONS +-- +-- Event +-- Probability +------------------------------------------------------------------------------ + +-- +-- Events +-- +type Event a = a -> Bool + +oneOf :: Eq a => [a] -> Event a +oneOf = flip elem + +just :: Eq a => a -> Event a +just = oneOf . singleton + + +-- +-- Probabilities +-- +newtype Probability = P ProbRep + +type ProbRep = Float + +precision :: Int +precision = 1 + +showPfix :: ProbRep -> String +showPfix f | precision==0 = showR 3 (round (f*100))++"%" + | otherwise = showR (4+precision) (fromIntegral (round (f*100*d))/d)++"%" + where d = 10^precision + +-- -- mixed precision +-- -- +-- showP :: ProbRep -> String +-- showP f | f>=0.1 = showR 3 (round (f*100))++"%" +-- | otherwise = show (f*100)++"%" + +-- fixed precision +-- +showP :: ProbRep -> String +showP = showPfix + + +instance Show Probability where + show (P p) = showP p + +errorMargin :: ProbRep +errorMargin = 0.00001 + + +-- +-- Monad composition +-- +-- (>@>) binary composition +-- sequ composition of a list of monadic functions +-- +(>@>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c +f >@> g = (>>= g) . f + +sequ :: Monad m => [a -> m a] -> a -> m a +sequ = foldl (>@>) return + + + +------------------------------------------------------------------------------ +-- 1 DETERMINISTIC AND PROBABILISTIC VALUES +-- +-- Dist probability disribution +-- Spread functions to convert a list of values into a distribution +------------------------------------------------------------------------------ + +-- +-- Distributions +-- +newtype Dist a = D {unD :: [(a,ProbRep)]} + +instance Monad Dist where + return x = D [(x,1)] + d >>= f = D [(y,q*p) | (x,p) <- unD d, (y,q) <- unD (f x)] + + +-- note: mzero is a zero for >>= and a unit for mplus +-- +instance MonadPlus Dist where + mzero = D [] + mplus d d' | isZero d || isZero d' = mzero + | otherwise = unfoldD $ choose 0.5 d d' + +isZero :: Dist a -> Bool +isZero (D d) = null d + + +instance Functor Dist where + fmap f (D d) = D [(f x,p) | (x,p) <- d] + +instance (Ord a,Eq a) => Eq (Dist a) where + D xs == D ys = map fst (norm' xs)==map fst (norm' ys) && + all (\((_,p),(_,q))->abs (p-q) [(a,ProbRep)]) -> Dist a -> Dist a +onD f = D . f . unD + +sizeD :: Dist a -> Int +sizeD = length . unD + +checkD :: Dist a -> Dist a +checkD (D d) | abs (1-sumP d) < errorMargin = D d + | otherwise = error ("Illegal distribution: total probability = "++show (sumP d)) + +mkD :: [(a,ProbRep)] -> Dist a +mkD = checkD . D + +sumP :: [(a,ProbRep)] -> ProbRep +sumP = sum . map snd + +sortP :: [(a,ProbRep)] -> [(a,ProbRep)] +sortP = sortBy (\x y->compare (snd y) (snd x)) + + +-- normalization = grouping +-- +normBy :: Ord a => (a -> a -> Bool) -> Dist a -> Dist a +normBy f = onD $ accumBy f . sort + +accumBy :: Num b => (a -> a -> Bool) -> [(a,b)] -> [(a,b)] +accumBy f ((x,p):ys@((y,q):xs)) | f x y = accumBy f ((x,p+q):xs) + | otherwise = (x,p):accumBy f ys +accumBy _ xs = xs + +norm :: Ord a => Dist a -> Dist a +norm = normBy (==) + +norm' :: Ord a => [(a,ProbRep)] -> [(a,ProbRep)] +norm' = accumBy (==) . sort + + +-- pretty printing +-- +instance (Ord a,Show a) => Show (Dist a) where + show (D []) = "Impossible" + show (D xs) = concatMap (\(x,p)->showR w x++' ':showP p++"\n") (sortP (norm' xs)) + where w = maximum (map (length.show.fst) xs) + + +-- +-- Operations on distributions +-- + +-- product of independent distributions +-- +joinWith :: (a -> b -> c) -> Dist a -> Dist b -> Dist c +joinWith f (D d) (D d') = D [ (f x y,p*q) | (x,p) <- d, (y,q) <- d'] + +prod :: Dist a -> Dist b -> Dist (a,b) +prod = joinWith (,) + + +-- distribution generators +-- +type Spread a = [a] -> Dist a + +certainly :: Trans a +certainly = return + +impossible :: Dist a +impossible = mzero + +choose :: ProbRep -> a -> a -> Dist a +choose p x y = enum [p,1-p] [x,y] + +enum :: [ProbRep] -> Spread a +enum ps xs = mkD $ zip xs ps + +enumPC :: [ProbRep] -> Spread a +enumPC ps = enum (map (/100) ps) + +relative :: [Int] -> Spread a +relative ns = enum (map (\n->fromIntegral n/fromIntegral (sum ns)) ns) + +shape :: (Float -> Float) -> Spread a +shape _ [] = impossible +shape f xs = scale (zip xs ps) + where incr = 1 / fromIntegral ((length xs) - 1) + ps = map f (iterate (+incr) 0) + +linear :: Float -> Spread a +linear c = shape (c*) + +uniform :: Spread a +uniform = shape (const 1) + +negexp :: Spread a +negexp = shape (\x -> exp (-x)) + +normal :: Spread a +normal = shape (normalCurve 0.5 0.5) + +normalCurve :: Float -> Float -> Float -> Float +normalCurve mean stddev x = 1 / sqrt (2 * pi) * exp (-1/2 * u^2) + where u = (x - mean) / stddev + + +-- extracting and mapping the domain of a distribution +-- +extract :: Dist a -> [a] +extract = map fst . unD + +mapD :: (a -> b) -> Dist a -> Dist b +mapD = fmap + + +-- unfold a distribution of distributions into one distribution +-- +unfoldD :: Dist (Dist a) -> Dist a +unfoldD (D d) = D [ (x,p*q) | (d',q) <- d, (x,p) <- unD d' ] + + +-- conditional distribution +-- +cond :: Dist Bool -> Dist a -> Dist a -> Dist a +cond b d d' = unfoldD $ choose p d d' + where P p = truth b + +truth :: Dist Bool -> Probability +truth (D ((b,p):_)) = P (if b then p else 1-p) + + +-- conditional probability +-- +(|||) :: Dist a -> Event a -> Dist a +(|||) = flip filterD + + +-- filtering distributions +-- +data Select a = Case a | Other + deriving (Eq,Ord,Show) + +above :: Ord a => ProbRep -> Dist a -> Dist (Select a) +above p (D d) = D (map (\(x,q)->(Case x,q)) d1++[(Other,sumP d2)]) + where (d1,d2) = span (\(_,q)->q>=p) (sortP (norm' d)) + +scale :: [(a,ProbRep)] -> Dist a +scale xs = D (map (\(x,p)->(x,p/q)) xs) + where q = sumP xs + +filterD :: (a -> Bool) -> Dist a -> Dist a +filterD p = scale . filter (p . fst) . unD + + +-- selecting from distributions +-- +selectP :: Dist a -> ProbRep -> a +selectP (D d) p = scanP p d + +scanP :: ProbRep -> [(a,ProbRep)] -> a +scanP p ((x,q):ps) | p<=q || null ps = x + | otherwise = scanP (p-q) ps + +infix 8 ?? + +(??) :: Event a -> Dist a -> Probability +(??) p = P . sumP . filter (p . fst) . unD + + +-- TO DO: generalize Float to arbitrary Num type +-- +class ToFloat a where + toFloat :: a -> Float + +instance ToFloat Float where toFloat = id +instance ToFloat Int where toFloat = fromIntegral +instance ToFloat Integer where toFloat = fromIntegral + +class FromFloat a where + fromFloat :: Float -> a + +instance FromFloat Float where fromFloat = id +instance FromFloat Int where fromFloat = round +instance FromFloat Integer where fromFloat = round + +-- expected :: ToFloat a => Dist a -> Float +-- expected = sum . map (\(x,p)->toFloat x*p) . unD + +class Expected a where + expected :: a -> Float + +-- instance ToFloat a => Expected a where +-- expected = toFloat +instance Expected Float where expected = id +instance Expected Int where expected = toFloat +instance Expected Integer where expected = toFloat + +instance Expected a => Expected [a] where + expected xs = sum (map expected xs) / toFloat (length xs) + +instance Expected a => Expected (Dist a) where + expected = sum . map (\(x,p)->expected x*p) . unD + +instance Expected a => Expected (IO a) where + expected r = expected (System.IO.Unsafe.unsafePerformIO r) + + +-- statistical analyses +-- +variance :: Expected a => Dist a -> Float +variance d@(D ps) = sum $ map (\(x,p)->p*sqr (expected x - ex)) ps + where sqr x = x * x + ex = expected d + +stddev :: Expected a => Dist a -> Float +stddev = sqrt . variance + + + +------------------------------------------------------------------------------ +-- 2 RANDOMIZED VALUES +-- +-- R random value +-- RDist random distribution +------------------------------------------------------------------------------ + + +-- +-- Random values +-- +type R a = IO a + +printR :: Show a => R a -> R () +printR = (>>= print) + +instance Show (IO a) where + show _ = "" + +pick :: Dist a -> R a +-- pick d = do {p <- Random.randomRIO (0,1); return (selectP p d)} +pick d = System.Random.randomRIO (0,1) >>= return . selectP d + + +-- +-- Randomized distributions +-- +type RDist a = R (Dist a) + +rAbove :: Ord a => ProbRep -> RDist a -> RDist (Select a) +rAbove p rd = do D d <- rd + let (d1,d2) = span (\(_,q)->q>=p) (sortP (norm' d)) + return (D (map (\(x,q)->(Case x,q)) d1++[(Other,sumP d2)])) + + + +------------------------------------------------------------------------------ +-- 3 DETERMINISTIC AND PROBABILISTIC GENERATORS +-- +-- Change deterministic generator +-- Trans probabilistic generator +-- SpreadC functions to convert a list of changes into a transition +-- SpreadT functions to convert a list of transitions into a transition +------------------------------------------------------------------------------ + +-- +-- transitions +-- +type Change a = a -> a + +type Trans a = a -> Dist a + +idT :: Trans a +idT = certainlyT id + + +-- mapT maps a change function to the result of a transformation +-- (mapT is somehow a lifted form of mapD) +-- The restricted type of f results from the fact that the +-- argument to t cannot be changed to b in the result Trans type. +-- +mapT :: Change a -> Trans a -> Trans a +mapT f t = mapD f . t + + +-- unfold a distribution of transitions into one transition +-- +-- NOTE: The argument transitions must be independent +-- +unfoldT :: Dist (Trans a) -> Trans a +unfoldT (D d) x = D [ (y,p*q) | (f,p) <- d, (y,q) <- unD (f x) ] + + +-- spreading changes into transitions +-- +type SpreadC a = [Change a] -> Trans a + +certainlyT :: Change a -> Trans a +certainlyT f = certainly . f +-- certainlyT = (certainly .) +-- certainlyT = maybeC 1 + +maybeT :: ProbRep -> Change a -> Trans a +maybeT p f = enumT [p,1-p] [f,id] + +liftC :: Spread a -> [Change a] -> Trans a +liftC s cs x = s [f x | f <- cs] +-- liftC s cs x = s $ map ($ x) cs + +uniformT = liftC uniform +normalT = liftC normal +linearT c = liftC (linear c) +enumT xs = liftC (enum xs) + + +-- spreading transitions into transitions +-- +type SpreadT a = [Trans a] -> Trans a + +liftT :: Spread (Trans a) -> [Trans a] -> Trans a +liftT s = unfoldT . s + +uniformTT = liftT uniform +normalTT = liftT normal +linearTT c = liftT (linear c) +enumTT xs = liftT (enum xs) + + + +------------------------------------------------------------------------------ +-- 4 RANDOMIZED GENERATORS +-- +-- RChange random change +-- RTrans random transition +------------------------------------------------------------------------------ + + +-- +-- Randomized changes +-- +type RChange a = a -> R a + +random :: Trans a -> RChange a +random t = pick . t +-- random = (pick .) + + +-- +-- Randomized transitions +-- +type RTrans a = a -> RDist a +type ApproxDist a = R [a] + + +-- rDist converts a list of randomly generated values into +-- a distribution by taking equal weights for all values +-- +rDist :: Ord a => [R a] -> RDist a +rDist = fmap (norm . uniform) . sequence + + + +------------------------------------------------------------------------------ +-- 5 ITERATION AND SIMULATION +-- +-- Iterate class defining *. +-- Sim class defining ~. +------------------------------------------------------------------------------ + +{- + +Naming convention: + +* takes n :: Int and a generator and iterates the generator n times +. produces a single result +.. produces a trace +~ takes k :: Int [and n :: Int] and a generator and simulates + the [n-fold repetition of the] generator k times + +n *. t iterates t and produces a distribution +n *.. t iterates t and produces a trace + +k ~. t simulates t and produces a distribution +(k,n) ~*. t simulates the n-fold repetition of t and produces a distribution +(k,n) ~.. t simulates the n-fold repetition of t and produces a trace + +-} + +-- Iteration captures three iteration strategies: +-- iter builds an n-fold composition of a (randomized) transition +-- while and until implement conditional repetitions +-- +-- The class Iterate allows the overloading of iteration for different +-- kinds of generators, namely transitions and random changes: +-- +-- Trans a = a -> Dist a ==> c = Dist +-- RChange a = a -> R a ==> c = R = IO +-- +class Iterate c where + (*.) :: Int -> (a -> c a) -> (a -> c a) + while :: (a -> Bool) -> (a -> c a) -> (a -> c a) + until :: (a -> Bool) -> (a -> c a) -> (a -> c a) + until p = while (not.p) + +infix 8 *. + +-- iteration of transitions +-- +instance Iterate Dist where + n *. t = head . (n *.. t) + while p t x = if p x then t x >>= while p t else certainly x + +-- iteration of random changes +-- +instance Iterate IO where + n *. r = (>>= return . head) . rWalk n r + while p t x = do {l <- t x; if p l then while p t l else return l} + + + +-- Simulation means to repeat a random chage many times and +-- to accumulate all results into a distribution. Therefore, +-- simulation can be regarded as an approximation of distributions +-- through randomization. +-- +-- The Sim class contains two functions: +-- +-- ~. returns the final randomized transition +-- ~.. returns the whole trace +-- +-- The Sim class allows the overloading of simulation for different +-- kinds of generators, namely transitions and random changes: +-- +-- Trans a = a -> Dist a ==> c = Dist +-- RChange a = a -> R a ==> c = R = IO +-- +class Sim c where + (~.) :: Ord a => Int -> (a -> c a) -> RTrans a + (~..) :: Ord a => (Int,Int) -> (a -> c a) -> RExpand a + (~*.) :: Ord a => (Int,Int) -> (a -> c a) -> RTrans a + +infix 6 ~. +infix 6 ~.. + +-- simulation for transitions +-- +instance Sim Dist where + (~.) x = (~.) x . random + (~..) x = (~..) x . random + (~*.) x = (~*.) x . random + + +-- simulation for random changes +-- +instance Sim IO where + (~.) n t = rDist . replicate n . t + (~..) (k,n) t = mergeTraces . replicate k . rWalk n t + (~*.) (k,n) t = k ~. n *. t + +infix 8 ~*. + +--(~*.) :: (Iterate c,Sim c,Ord a) => (Int,Int) -> (a -> c a) -> RTrans a +--(k,n) ~*. t = + + +------------------------------------------------------------------------------ +-- 7 TRACING +-- +-- (R)Trace +-- (R)Space +-- (R)Walk +-- (R)Expand +------------------------------------------------------------------------------ + +type Trace a = [a] +type Space a = Trace (Dist a) +type Walk a = a -> Trace a +type Expand a = a -> Space a + + +-- >>: composes the result of a transition with a space +-- (transition is composed on the left) +-- +-- (a -> m a) -> (a -> [m a]) -> (a -> [m a]) +(>>:) :: Trans a -> Expand a -> Expand a +f >>: g = \x -> let ds@(D d:_)=g x in + D [ (z,p*q) | (y,p) <- d, (z,q) <- unD (f y)]:ds + +infix 6 >>: + +-- walk is a bounded version of the predefined function iterate +-- +walk :: Int -> Change a -> Walk a +walk n f = take n . iterate f + +-- *.. is identical to *., but returns the list of all intermediate +-- distributions +-- +(*..) :: Int -> Trans a -> Expand a +0 *.. _ = singleton . certainly +1 *.. t = singleton . t +n *.. t = t >>: (n-1) *.. t + +infix 8 *.. + + +type RTrace a = R (Trace a) +type RSpace a = R (Space a) +type RWalk a = a -> RTrace a +type RExpand a = a -> RSpace a + +-- (a -> m a) -> (a -> m [a]) -> (a -> m [a]) +composelR :: RChange a -> RWalk a -> RWalk a +composelR f g x = do {rs@(r:_) <- g x; s <- f r; return (s:rs)} + + +-- rWalk computes a list of values by +-- randomly selecting one value from a distribution in each step. +-- +rWalk :: Int -> RChange a -> RWalk a +rWalk 0 _ = return . singleton +rWalk 1 t = (>>= return . singleton) . t +rWalk n t = composelR t (rWalk (n-1) t) + + +-- mergeTraces converts a list of RTraces, into a list of randomized +-- distributions, i.e., an RSpace, by creating a randomized +-- distribution for each list position across all traces +-- +mergeTraces :: Ord a => [RTrace a] -> RSpace a +mergeTraces = fmap (zipListWith (norm . uniform)) . sequence + where + zipListWith :: ([a] -> b) -> [[a]] -> [b] + zipListWith f = map f . transpose + +{- + +LAWS + + const . pick = random . const + +-} + diff --git a/cp2223t/RelCalc.hs b/cp2223t/RelCalc.hs new file mode 100644 index 0000000..1e06e43 --- /dev/null +++ b/cp2223t/RelCalc.hs @@ -0,0 +1,209 @@ +{-# OPTIONS_GHC -XNoMonomorphismRestriction #-} + +-- (c) CP/MFP (2007/2022) + +module RelCalc where + +import Data.List +import Cp hiding (tot) + +--- composition (left to right to be consistent with Alloy) ---- + +comp :: (Eq b, Ord a, Ord c) => [(a, b)] -> [(b, c)] -> [(a, c)] +comp m n = set [ (a,c) | (a,b) <- m, (b',c) <- n, b==b' ] + +--- converse + +conv :: (Ord b, Ord a) => [(a, b)] -> [(b, a)] +conv = smap swap + +--- composition with a function + +fcomp r f = smap (id> [c] -> [(c, c)] +crflx = smap (split id id) + +point :: Ord c => c -> [(c, c)] +point = crflx . singl + +-- domain and range + +dom :: Ord a => [(a, b)] -> [a] +dom = smap p1 + +rng :: Ord b => [(a, b)] -> [b] +rng = smap p2 + +rho = crflx . rng + +delta = rho . conv + +-- properties of relations + +coreflexive = all (uncurry(==)) + +injective = simple . conv + +simple :: (Ord b, Ord a) => [(a, b)] -> Bool +simple = coreflexive . img + +consistent m n = coreflexive (conv m `comp` n) + +-- restriction operators + +domr :: (Ord a, Ord t) => [a] -> [(a, t)] -> [(a, t)] -- domain restrict +domr s r = (crflx s) `comp` r + +doms s r = r \\ (domr s r) -- domain subtract + +r.-.s = doms (dom s) r + +-- relation overriding + +plus :: (Ord a, Ord t) => [(a, t)] -> [(a, t)] -> [(a, t)] +plus m n = runion (drminus (dom n) m) n + +drminus s r = domr (sdiff (dom r) s) r + +drplus s r = domr (inter (dom r) s) r + +-- relation coproduct + +reither a b = (set.conv) (runion (conv a `fcomp` i1) (conv b `fcomp` i2)) + +unreither r = (a,b) where + a = set [(x,y) | (Left x,y) <- r] + b = set [(x,y) | (Right x,y) <- r] + +-- pairing + +rjoin r s = discollect $ smap (id> (pap m k, pap n k) | k <- inter (dom m) (dom n)] -- assumes m and n simple + +rzipWith f a b = (rjoin a b `fcomp` f) + +-- relation 'currying' + +unvec = smap f where f(a,(c,b)) = ((a,b),c) + +vec = smap f where f((a,b),c) = (a,(c,b)) + +-- constant relation on a set + +pconst k s = smap (split id (const k)) s + +--- power transpose + +pT = flip tot [] . collect -- power transpose + +collect :: (Ord b, Ord a) => [(b, a)] -> [(b, [a])] +collect x = set [ k |-> set [ d' | (k',d') <- x , k'==k ] | (k,d) <- x ] + +-- Maybe transpose (assumes simplicity) + +mT :: Eq a => [(a, b)] -> a -> Maybe b +mT = flip lookup + +pap :: Eq a => [(a, t)] -> a -> t +pap m = unJust . (mT m) where unJust (Just a) = a -- partial inspector of simple relation A->B + +-- tot m b a = if a `elem` dom m then pap m a else b -- total inspector of simple relation A->B +tot m b = maybe b id . mT m + +-- tap m a = if a `elem` dom m then pap m a else a -- total inspector of simple relation, A->A +tap m a = tot m a a + +condid p f = cond p f id + +pmap = map . pap -- mapping a simple relation + +idx x = pap (zip x [0..]) + +--- sets modelled by sorted, repeat-free lists (naive but useful) + +set = sort . nub + +card = length . set + +smap :: Ord a => (b -> a) -> [b] -> [a] +smap f = set . (map f) + +--- histograms and distributions + +hist :: Eq a => [a] -> [(a, Int)] +hist l = nub [ (x, count x l) | x <- l ] + where count a l = length [ x | x <- l, x == a] + +dist :: (Eq a, Fractional b) => [a] -> [(a, b)] +dist l = [ (x, (fromIntegral n) / (fromIntegral t)) | (x,n) <- hist l ] where t = length l + +histpair h1 h2 = both `fcomp` (split (tot h1 0)(tot h2 0)) where both = crflx (dom h1 `union` dom h2) + +-- miscellaneous + +discollect :: [(a, [b])] -> [(a, b)] +discollect = (>>=lstr) + +presort f = map snd . sort . (map (split f id)) -- pre-sorting on f-preorder + +rpresort f = reverse . (presort f) -- the same in reverse ordering + +sdiff x y = set [ a | a <- x, not(elem a y) ] + +a |-> b = (a,b) + +(f `is` v) x = (f x) == v + +(f `belongs` v) x = (f x) `elem` v + +(v `can_be_found_in` f) x = v `elem` (f x) + +(f `isnot` v) x = (f x) /= v + +unpair(a,b)=[a,b] + +pair [a,b]=(a,b) + +a .><. b = [ (x,y) | x <- a, y <- b ] +x .+. y = map Left x ++ map Right y +----------------------------------------------------------------------------- +proj k a = map (split k a) +{----------------------------------------------------------------------------- +-- Sample data + +data A = A1 | A2 | A3 | A4 | A5 deriving (Show,Eq,Ord,Enum) +data B = B1 | B2 | B3 | B4 | B5 deriving (Show,Eq,Ord,Enum) + +tA = [A1 .. A5] +tB = [B1 .. B5] + +idA = crflx tA +idB = crflx tB +-----------------------------------------------------------------------------} + +rcons(x,a) = x++[a] + diff --git a/cp2223t/Rose.hs b/cp2223t/Rose.hs new file mode 100644 index 0000000..117e3b7 --- /dev/null +++ b/cp2223t/Rose.hs @@ -0,0 +1,53 @@ + +{-# OPTIONS_GHC -XNPlusKPatterns #-} + +-- (c) MP-I (1998/9-2006/7) and CP (2005/6-2022/23) + +module Rose where + +import Cp +import BTree +import Exp +import Data.List +import Data.Monoid + +-- (1) Datatype definition ----------------------------------------------------- + +data Rose a = Rose a [Rose a] deriving Show + +inRose = uncurry Rose + +outRose (Rose a x) = (a,x) + +-- (2) Ana + cata + hylo ------------------------------------------------------- + +recRose g = baseRose id g + +cataRose g = g . (recRose (cataRose g)) . outRose + +anaRose g = inRose . (recRose (anaRose g) ) . g + +hyloRose h g = cataRose h . anaRose g + +baseRose f g = f >< map g + +-- (3) Map --------------------------------------------------------------------- + +instance Functor Rose + where fmap f = cataRose ( inRose . baseRose f id ) + +-- (4) Examples ---------------------------------------------------------------- + +-- count + +count = cataRose (succ.sum.p2) + +sumRose = cataRose (add.(id> Int -> a -> String +showL n x = s++rep (n-length s) ' ' + where s=show x + +showR :: Show a => Int -> a -> String +showR n x = rep (n-length s) ' '++s + where s=show x + +--showP :: Float -> String +--showP f = showR 3 (round (f*100))++"%" + +rep :: Int -> a -> [a] +rep n x = take n (repeat x) + diff --git a/cp2223t/St.hs b/cp2223t/St.hs new file mode 100644 index 0000000..e16c3dc --- /dev/null +++ b/cp2223t/St.hs @@ -0,0 +1,96 @@ + +-- (c) MP-I and CP (1998/99-2022/23) + +module St where + +import Cp +import Control.Applicative + +------------------------------------------------------------------ +-- NB: This is a small, pointfree "summary" of Control.Monad.State +------------------------------------------------------------------ + +data St s a = St { st :: (s -> (a, s)) } + +inSt = St +outSt = st + +-- NB: "values" of this monad are actions rather than states. +-- So this should be called the "action monad" and not the +-- "state monad". +-- (Unfortunately, it is to late to change terminology.) + +-------------------------------------------------------------------------- +instance Monad (St s) where + return = St . (curry id) + (St x) >>= g = St (uncurry(st . g) . x ) +{-- ie: + (St x) >>= g = St (\s -> let (a,s') = x s + St k = g a + in k s') +--} +-------------------------------------------------------------------------- +instance Functor (St s) where + fmap f t = do { a <- t ; return (f a) } -- as in every monad +-- ie: fmap f (St g) = St(\s -> let (a,s') = g s in (f a,s')) + +-------------------------------------------------------------------------- +-- action execution + +exec :: St s a -> s -> (a, s) +exec (St g) s = g s -- splits evalState and execState + +-- generic actions + +get :: St s s -- as in class MonadState +get = St(split id id) + +modify :: (s -> s) -> St s () +modify f = St(split (!) f) + +put :: s -> St s () -- as in class MonadState +put s = modify (const s) + +query :: (s -> a) -> St s a +query f = St(split f id) + +trans :: (s -> s) -> (s -> a) -> St s a -- a simple transation +trans g f = do { modify g ; query f } + +-- actions with input + +meth :: ((a, s) -> (b, s)) -> a -> St s b +meth f = St.(curry f) -- create "method" from function + +-- update state, then query + +updfst :: (a -> s -> s) -> (a -> s -> b) -> a -> St s b +updfst g f a = St (split (f a) id . (g a)) + +-- updfst g f a = do { modify (g a) ; query (f a)} + +-- example (ATM credit) + +credit = updfst (+) (bal) + where bal a s = "credited= "++show a ++ ", bal= "++ show s + +-- query state, then update + +qryfst :: (a -> s -> s) -> (a -> s -> b) -> a -> St s b +qryfst g f a = St(split (f a) (g a)) + +-- qryfst g f a = do { b <- query (f a); modify (g a) ; return b } + +-- example (pop) +pop_action = qryfst (\_ -> tail) (\_ -> head) + +-- execute forever + +loop :: Monad m => m a -> m b +loop x = do { x ; loop x } + +-------------------------------------------------------------------------- +instance Applicative (St s) where + (<*>) = aap + pure = return +-------------------------------------------------------------------------- diff --git a/cp2223t/Svg.hs b/cp2223t/Svg.hs new file mode 100644 index 0000000..895ec83 --- /dev/null +++ b/cp2223t/Svg.hs @@ -0,0 +1,580 @@ +{-# OPTIONS_GHC -XNPlusKPatterns #-} + +-- (c) Ensico & UM (2022) + +module Svg where + +import Data.Ratio +import Data.Char +import Data.List +import System.Process +import Cp + +--- Basic ----------- + +open h = do { writeFile "_.html" h ; system ("open _.html") } + +converse = map swap + +a .><. b = [ (x,y) | x <- a, y <- b ] + +a # b = zip a b + +unrstr = (id >< head) . unzip + +collapse = map unrstr . transpose + +match p l i = p `isPrefixOf` (drop i l) + +r2 = (/100) . fromIntegral . round .(100*) + +-- Generic "derivative" / "integral" + +gderiv :: a -> (a -> a -> c) -> [a] -> [c] +gderiv z f s = ttl (zipWith f s (z:s)) + where ttl [] = [] + ttl (a:t) = t + +ginteg :: (a -> b -> b) -> b -> [a] -> [b] +ginteg f i s = i:aux i s + where aux i [] = [] + aux i (h:t) = i':(aux i' t) + where i'=f h i + +-- Repetitions + +-- repeat anything + +rep x = map (const x) [0..] + +-- (9) Misc. + +cut :: Int -> Int -> [a] -> [a] +cut n m = (take (m-n+1)) . drop (n-1) + +inds :: [b] -> [Int] +inds = (map fst) . (zip [1..]) + +elems :: (Ord a) => [a] -> [a] +elems = sort . nub + +-- misc + +sing a = [a] +dup a = [a,a] + +a != b = not(a == b) + +a |-> b = (a,b) + +supermap f [] = [] +supermap f (a:l) = a:(map f (supermap f l)) + +show2 = show.show + +--- list of pairs to list + +lp2l :: [(b, b)] -> [b] +lp2l = (concat . map f) where f(a,b)=[a,b] + +frac n m = n%m + +-- for combinator + +for b i 0 = i +for b i (n+1) = b(for b i n) + +presort f = map snd . sort . (map (split f id)) -- pre-sorting on f-preorder + +apl :: [a -> b] -> [a] -> [b] +apl f l = map ap (zip f l) + +--- HTML minimal API ("shallow embedding") + +tag t l x = "<"++t++" "++ps++">"++x++"" + where ps = unwords [concat[t,"=",v]| (t,v)<-l] + +tg t l = "<"++t++" "++ps++"/>" + where ps = unwords [concat[t,"=",v]| (t,v)<-l] + +htm = tag "html" [] + +strong = tag "strong" [] + +tr = tag "tr" [] + +img fn = tag "img" [ "src" |-> (show fn) ] "" + +uli = ul . (>>= li) where + li = tag "li" [] + ul = tag "ul" [] + +htable = nest "table" [ "border" |-> "1" , "data-toggle" |-> "\"table\"" ] + (nest "tr" [] (tag "td" [ "align" |-> "center"])) + where nest t p f = (tag t p) . (>>=f) + +pretty = (open . htm . htable) + +--- remove diacritics where needed + +cl '\237'= 'i' +cl '\243'= 'o' +cl '\227'= 'a' +cl '\231'= 'c' +cl c = c + +--- basic ----------- + +mT :: Eq a => [(a, b)] -> a -> Maybe b +mT = flip lookup + +pap :: Eq a => [(a, t)] -> a -> t +pap m = unJust . (mT m) where unJust (Just a) = a -- partial inspector of simple relation A->B + +-- Abstract (point) level + +infix 5 .| +infix 4 .+ +infix 4 .- + +a .| (x,y) = (a*x,a*y) + +trans p = map (p .+) + +(x,y) .+ (x',y') = (x+x',y+y') + +(x,y) .- (x',y') = (x-x',y-y') + +a .* (x,y) = (a*x,a*y) + +amplia r = map (r .*) + +amplia' s p = trans (p .- s .* p) . amplia s + +reduz r = amplia (1/r) + +-- SVG ----------------------------------- + +s = (200*) + +sstep (x,y) = (200*x,-200*y) + +scl p = sstep p .+ (-1400,1400) + +shp (x,y) = show x ++ "," ++ show y -- format for coord list + +shpts xs = intercalate " " (map (shp.scl) xs) -- with offset + +shpts' xs = intercalate " " (map (shp.sstep) xs) + +rscale p = let (x,y) = scl p in (round x,round y) + +-- paths + +path d = tg "path" [ "d" |-> show d ] + +slice r (p1,p2) = path $ " M " ++ shp (scl p1) ++ arc (s r) (scl p2) ++ " L " ++ shp (scl p3) where + arc r p = " A " ++ shp (r,r) ++ " 0 0 0 " ++ shp p ++ " " + p3 = (0,0) + +-- polylines + +poly xs = tg "polyline" ["points" |-> show (shpts xs), "style" |-> show "fill:none;stroke-width:5" ] + +poly' xs = tg "polyline" ["points" |-> show (shpts xs), "style" |-> show "fill:none;stroke-width:8" ] -- thicker + +seg p q = poly [p,q] + +-- polygons + +polyg xs = tg "polygon" ["points" |-> show (shpts xs)] + +tri = polyg + +squ = polyg + +rect x y = polyg [(0,0),(x,0),(x,y),(0,y),(0,0)] + +sqr x = rect x x + +cir (x,y) r = tg "circle" [ + "cx" |-> show2 x',"cy" |-> show2 y', "r" |-> show2 r', + "stroke" |-> show "black", "stroke-width" |-> show2 3 ] where + (x',y') = scl (x,y) + (r',_) = sstep (r,0) + +elp (x,y) (rx,ry) = tg "ellipse" [ + "cx" |-> show2 x',"cy" |-> show2 y', "rx" |-> show2 rx', "ry" |-> show2 ry', + "stroke" |-> show "black", "stroke-width" |-> show2 3 ] where + (x',y') = scl (x,y) + (rx',_) = sstep (rx,0) + (ry',_) = sstep (ry,0) + +-- points + +point p = let (x,y) = scl p in tg "circle" ["cx" |-> show2 x,"cy" |-> show2 y, "r" |-> show2 15] +point' p = tag "g" ["font-size" |-> show2 60] (point p ++ black(stext (scl (p.+(-0.5,0.2))) (shows p))) where + shows(x,y) = "("++ s x ++ "," ++ s y ++ ")" + s x = if abs(x-fromIntegral (round x)) < 0.001 then show (round x) else show (r2 x) + +points' = (>>= point') +points = (>>= point) + +-- rotation + +polar (x,y) = (atan2 y x,sqrt(x^2+y^2)) + +cart (a,r) = (cos a * r, sin a * r) + +rad r = r*pi/180 + +rot r p = (x',y') where + (a,c) = polar p + a' = a + rad r + y' = c*sin a' + x' = c*cos a' + +rotate r p a = tag "g" [ "transform" |-> show ("rotate(" ++ t ++ ")") ] a where + (x,y) = scl p + t = unwords [show r, show x, show y] + +-- translation + +translate p = tag "g" [ "transform" |-> show ("translate"++p') ] where p' = show(sstep p) + +put = translate + +-- (static) scaling + +scale k p = translate (p' .- k .* p') . + tag "g" ["transform" |-> show("scale(" ++ show k ++ ")") ] + where p' = p .- (7,7) + +-- colored regions + +color c = tag "g" ["fill" |-> show c, "stroke" |-> show c] +white = color "white" +black = color "black" +gray = color "gray" +yellow = color "yellow" +green = color "green" +red = color "red" +blue = color "blue" +orange = color "orange" +magenta = color "magenta" +brown = color "brown" + +-- grouping + +grp = tag "g" [] . concat + +-- vectors, lines and grid + +vec p q = + let (x1,y1) = scl p + (x2,y2) = scl q + in tg "line" [ + "x1" |-> show2 x1, "y1" |-> show2 y1, "x2" |-> show2 x2, "y2" |-> show2 y2, + "stroke-width" |-> show2 8, "marker-end" |-> show "url(#arrowhead)" ] + +-- line (x1,y1)(x2,y2) = tag "line" ["x1" |-> x1, "y1" |-> y1, "x2" |-> x2, "y2" |-> y2] + +lin (x1,y1) (x2,y2) = tg "line" ["x1" |-> show2 x1, "y1" |-> show2 y1, "x2" |-> show2 x2, "y2" |-> show2 y2] + + +grid n = f n ++ map (sym> show "arrowhead", + "markerWidth" |-> show2 10, + "markerHeight"|-> show2 8, + "refX" |-> show2 9, + "refY" |-> show2 4, + "orient" |-> show "auto"] $ + tg "polygon" [ "fill" |-> show "gray", "points" |-> show "0,0 10,4 0,8" ] + +-- the grid and X-Y plane + +planoxy p x = wrap (dfs ++ grd ++ coords ++ axes ++ concat x) + where + wrap = tag "svg" [ + "width" |-> show2 500, + "height" |-> show2 500, + "viewBox" |-> show "-1500 -1500 3000 3000", + "version" |-> show "1.1", + "xmlns" |-> show "http://www.w3.org/2000/svg" + ] + trans p = tag "g" [ "transform" |-> show ("translate"++p') ] where p' = show p + xarrowhead = polyg [(0,-0.1),(0.3,0),(0,0.1)] + yarrowhead = polyg [(0.1,0),(0,0.3),(-0.1,0)] + base = let a =[0,40..1500] in a ++ map ((-1)*) a + xs = [0..13] >>= coordx + ys = [1..13] >>= coordy + coordx i = stext (scl (i,-0.4)) (show i) + coordy i = stext (scl (-0.4,i)) (show i) + coordy' i = stext (scl (-0.55,i)) (show i) + lx i = lin (i,-1400) (i,1400) ++ lin (-1400,i) (1400,i) + ly i = lin (-1400,i) (1400,i) + --- axes ------------------------------------------------- + axes = blacklines [((-1400.0,1480.0),(-1400.0,-1480.0)),((-1480.0,1400.0),(1480.0,1400.0))] ++ + trans (sstep (14.2,0)) xarrowhead ++ + trans (sstep (0,14.2)) yarrowhead ++ + tag "g" ["font-style" |-> show "italic", "font-size" |-> show2 100] (gray ( + stext (scl (14,-0.5)) "x" ++ + stext (scl (-0.5,14)) "y" + )) + blacklines ls = tag "g" ["stroke" |-> show "black", "stroke-width" |-> show2 5.0] (ls >>= uncurry lin) + --- grid ------------------------------------------------- + grd = graylines (base >>= grid) ++ + tag "g" ["stroke" |-> show "gray", "stroke-width" |-> show2 3] ([-1400,-1200..1400] >>= lx) + graylines ls = tag "g" ["stroke" |-> show "gray", "stroke-width" |-> show2 p] (ls >>= uncurry lin) + --- coords ----------------------------------------------- + coords = tag "g" ["font-size" |-> show2 80] (xs ++ ys) + ---------------------------------------------------------- + +-- Show in X-Y Cartesian plane + +picd = open . htm . planoxy 0.9 + +picd' = open . htm . planoxy 0 -- gray intensity = 0 + +picd'' = open . htm . wrap . concat + +wrap = tag "svg" [ + "width" |-> show2 500, + "height" |-> show2 500, + "viewBox" |-> show "-1500 -1500 3000 3000", + "version" |-> show "1.1", + "xmlns" |-> show "http://www.w3.org/2000/svg" + ] + +-- HELPER: para mostrar polygs (apenas): + +polyd t = picd [ green(polyg t) ++ points'' t ] + +points'' ps = blue(points' ps) ++ red(points projs) + where projs = map f ps ++ map (swap.f.swap) ps + f(x,_) = (x,0) + +--- Vectors + +pnt p = red (vec (0,0) p) + +pnts = grp . map pnt + +--- Plotting + +plt f = map (pnt f . (/10)) . take width $ [0..] where + pnt f x = (x, f x) + width = 142 + +plot = poly . plt + +plot' = poly' . plt + +-- Images + +image fn d = tg "image" [ "href" |-> show fn, "height" |-> show2 h, "width" |-> show2 w ] + where (w,h) = (s >< s) d + +-- Animations + +anima t f x = animamea x p (show t++"s") where p = take t . map f $ [0..] + +anima' t d (i,n,v) x = animamea x p (show d++"s") where + p = map v (take m y) -- v is the "view" extracting (x,y) + y = ana n i + ana n s = s : ana n (n s) + m = sample t d + +anims d f t o = translate (-7,-7) x where + x = tag "g" [] (o' ++ st) + f' = unwords [show f,show f] + t' = unwords [show t,show t] + o' = translate (7,7) o + st = animT "0s" (show d++"s") "scale" f' t' "0" + +animf t f a = animamea a (plt f) t --- animation over function graph + +animamea o p t = tag "g" [] (o ++ (animM (shpath p) t "0")) + +shpath p = "M " ++ shpts' p ++ " " -- no way back, cf shpath p = "M " ++ shpts' p ++ " Z" + +animM p d c = tg "animateMotion" [ + "path" |-> show p, + "dur" |-> show d, + "repeatCount" |-> show c + ] + +sample :: Float -> Float -> Int +sample t d = round(d/t) + +-- animd o p t = picd [ animamea o p t ] +-- path i n = i : map n (path i n) + +-- Reflections + +refl q p = q .+ (q .- p) + +hrefl y0 p = [ (x,2*y0-y) | (x,y) <- p ] + +vrefl x0 p = [ (2*x0-x,y) | (x,y) <- p ] + + +-- Rotations + +animT b d k f t c = tg "animateTransform" [ + "attributeName" |-> show "transform", + "begin" |-> show b, + "dur" |-> show d, + "type" |-> show k, + "from" |-> show f, + "to" |-> show t, + "repeatCount" |-> show c + ] + +animr d f t o = animarot o d f t + +animarot o d (f,p) (t,q) = + tag "g" [] (o ++ animT "0s" (show d ++ "s") "rotate" fs ts "indefinite") where + fs = unwords [show f, show x, show y] + ts = unwords [show t, show x', show y'] + (x,y) = scl p + (x',y') = scl q + +-- Text + +txt p = tag "text" [ "x" |-> show2 x, "y" |-> show2 y, "font-size" |-> show2 100 ] where (x,y) = scl p + +italic = tag "g" [ "font-style" |-> "italic" ] + +anchor k = tag "g" [ "text-anchor" |-> show k ] -- k = "end" + +-- Pie diagrams + +mkp r ps = a # rtl a where -- polar coordinates + a = aux r ps + rtl [] = [] + rtl x = tail x ++ [ head x ] + aux r = map (cart . curry swap r . (2*pi*)) . ginteg (+) 0 + +dist x = map (/t) x where t = sum x -- distribution + +perc x = map (/t) x where t = maximum x -- percentage + +dom = map fst +rng = map snd + +pied db = picd' (pie (map snd db) ++ map f a) where + a = colours # [1,2..] # map sh (dom db # dist(rng db)) + sh (a,n) = a ++ ": " ++ sprec n + f((c,y),s) = ap(c, txt (1,y) s) + +pie d = y where + r = 4 -- radius + y = map (translate (9,9) . ap) (colours # x) + x = map (slice r) . mkp r . dist $ d + +colours = [blue,green,yellow,orange,red,magenta,gray,brown,black] ++ colours + +sprec n = show (round(n*100)) ++ " %" + +-- histograms in svg + +histd db = picd'' $ (db' >>= bar) where + span db = 13 / fromIntegral(length db) + wth db = 9 / fromIntegral(length db) + ylabels = (fromIntegral . maximum . map length . dom) db `min` 5 + small p = tag "text" [ "x" |-> show2 x, "y" |-> show2 y, "font-size" |-> show2 80 ] where (x,y) = scl p + r = map fromIntegral (rng db) + db'=sort $ db # (perc r # [ span db * fromIntegral i | i <- [1..]] ) + bar ((s,v),(p,x)) = + [ (brown . translate (x-w/2,y0)) (rect w y), + (blue . rotate 90 (x,y0-0.5) . txt (x,y0-0.5)) s, + (gray . anchor "middle" . small (x,y0+y + 0.2 ) . show) v + ] where y = p*(12-y0) + w = wth db + y0 = ylabels + +stext (x,y) = tag "text" [ "x" |-> show2 x, "y" |-> show2 y ] -- simple text + + +text x y t = tag "text" [ "x" |-> show2 x, "y" |-> show2 y, "dy" |-> show "0.35em", "font-size" |-> show2 5] t + +title t s = tag "title" ["id" |-> show "title"] t ++ s + +bar s (y,(a,n)) = tag "g" [ "class" |-> show "bar", "transform" |-> show ("translate(0,"++show y++")") ] + $ aux (a,n) where + s' n = s (fromIntegral n) + aux (t,x) = rect (s' x) ++ + tag "text" [ "x" |-> show2 (s' x+5), + "y" |-> show2 7.5, + "dy" |-> show "0.30em"] (t ++ " [ " ++ show (x) ++ " ]") + rect x = tag "rect" [ "width" |-> show2 x, "height" |-> show2 10, "style" |-> show "fill:rgb(185,181,180);stroke-width:1;stroke:rgb(256,256,256)"] "" + +fdiv :: Int -> Int -> Float +fdiv n m = fromIntegral n / fromIntegral m + +svg' x y = tag "svg" + [ "version" |-> show "1.1", + "xmlns" |-> show "http://www.w3.org/2000/svg", + "xmlns:xlink" |-> show "http://www.w3.org/1999/xlink", + "class" |-> show "chart", + "width" |-> show2 1000, + "height" |-> show2 (y * 24), + "aria-labelledby" |-> show "title", + "role" |-> show "img" + ] + +------ SETS AND FUNCTIONS + +src (x,y) t = grp [ + red (point (x,y)), + blue (end (txt (x-0.29,y-0.15) t)) + ] where end = anchor "end" + +dst (x,y) t = grp [ + red (point (x,y)), + blue (txt (x+0.29,y-0.15) t) + ] + +ffdAux ff = (map (g>< nub) . unzip $ ff + g y = (5,y) + h y = (9,y) + +bold = tag "g" [ "font-weight" |-> show "bold" ] + +container n c x a = grp [ + c (elp (x, (m+1)/2) (2,m')), + (red . center . bold) (txt (x,m + 2) n) + ] where m = fromIntegral (length a) + m' = 0.6 * m + center = anchor "middle" + +-- diagrams of functions + +fund f = ffd (graph f [minBound .. maxBound]) + +ffd ff na nb = picd'' . singl . (translate (0,3)) . scale 1 (0,0) . grp $ + [ container na yellow 4 a, + container nb orange 10 b, + gray (p >>= uncurry vec), + a >>= uncurry src, + b >>= uncurry dst + ] where (a,b,p) = ffdAux ff + +graph f = map (split show (show.f)) + +graph' f = map (split show f) + +mhd f = histd (graph' f [minBound .. maxBound]) -- measure histograms + +--- diff --git a/cp2223t/cp2223t.bib b/cp2223t/cp2223t.bib new file mode 100644 index 0000000..a223ab7 --- /dev/null +++ b/cp2223t/cp2223t.bib @@ -0,0 +1,84 @@ + +@String{pub-SUCSLI = "Stanford University Center for the + Study of Language and Information"} +@String{pub-SUCSLI:adr = "Stanford, CA, USA"} + +@book{KR78, + author = "B.W. Kernighan and D.M. Richtie", + title= {The {C} Programming Language}, + publisher= {Prentice Hall, Englewood Cliffs, N.J.}, + year={1978} +} +@book{Hu00, + KEY = "Hu00", + AUTHOR = "P. Hudak", + TITLE = {\htmladdnormallink{The Haskell School of Expression - Learning Functional Programming Through Multimedia}{http://www.haskell.org/soe/}}, + PUBLISHER = "Cambridge University Press", + EDITION = "1st", + YEAR = "2000", + NOTE = "ISBN 0-521-64408-9" +} +@article{EK06, + longauthor = {Erwig, Martin and Kollmansberger, Steve}, + author = {Erwig, M. and Kollmansberger, S.}, + title = {FUNCTIONAL PEARLS: Probabilistic functional programming in {Haskell}}, + journal = {J. Funct. Program.}, + volume = {16}, + issue = {1}, + month = {January}, + year = {2006}, + noissn = {0956-7968}, + pages = {21--34}, + numpages = {14}, + nourl = {http://dl.acm.org/citation.cfm?id=1114008.1114013}, + nodoi = {10.1017/S0956796805005721}, + acmid = {1114013}, + publisher = {Cambridge University Press}, + address = {New York, NY, USA}, +} +@Book{Kn92, + author = "D.E. Knuth", + longauthor = "Donald E. Knuth", + title = "Literate Programming", + publisher = pub-SUCSLI, + address = pub-SUCSLI:adr, + pages = "xv + 368", + year = "1992", + ISBN = "0-937073-80-6 (paper), 0-937073-81-4 (cloth)", + ISBN-13 = "978-0-937073-80-3 (paper), 978-0-937073-81-0 (cloth)", + LCCN = "QA76.6.K644", + bibdate = "Sun Jul 10 01:09:29 1994", + price = "US\$24.95", + series = "CSLI Lecture Notes Number 27" +} + +@book{Kn86 + , author = {D.E. Knuth} + , title = {The \TeX book} + , publisher = {Addison-Wesley Publishing Company} + , edition = {7th} + , year = {1986} +} + +@book{GRM97 + , title = {The LaTeX Graphics Companion} + , author = {Michel Goossens and Sebastian Rahtz and Frank Mittelbach} + , publisher = {Addison-Wesley} + , year = {1997} + , note = {ISBN 0-201-85469-4} +} + +@misc{Ol18 +, author = {J.N. Oliveira} +, title = {\href{https://www.di.uminho.pt/~jno/ps/pdbc.pdf}{Program Design by Calculation}} +, note = {Textbook in preparation, 310 pages. Informatics Department, University of Minho. Current version: Sept. 2022} +, year = {2022} +} + +@misc{Se19 +, author = {SelfKey} +, year = {2015} +, title = {What is a {Merkle} Tree and How Does it Affect Blockchain Technology?} +, note = {Blog:\\ \url{https://selfkey.org/what-is-a-merkle-tree-and-how-does-it-affect-blockchain-technology/}. Last read: \today.} +} + diff --git a/cp2223t/cp2223t.idx b/cp2223t/cp2223t.idx new file mode 100644 index 0000000..5b78b7f --- /dev/null +++ b/cp2223t/cp2223t.idx @@ -0,0 +1,85 @@ +\indexentry{U.Minho!Departamento de Inform\IeC {\'a}tica|hyperpage}{1} +\indexentry{C\IeC {\'a}lculo de Programas|hyperpage}{1} +\indexentry{Haskell|hyperpage}{1} +\indexentry{Haskell|hyperpage}{1} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {for}|hyperpage}{2} +\indexentry{U.Minho!Departamento de Inform\IeC {\'a}tica|hyperpage}{2} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!Exp.hs|hyperpage}{2} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!Exp.hs|hyperpage}{2} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!Exp.hs|hyperpage}{2} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!Exp.hs|hyperpage}{3} +\indexentry{Fractal!Tapete de Sierpinski|hyperpage}{3} +\indexentry{Fractal|hyperpage}{3} +\indexentry{C\IeC {\'a}lculo de Programas|hyperpage}{3} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!Rose.hs|hyperpage}{4} +\indexentry{Functor|hyperpage}{5} +\indexentry{Functor|hyperpage}{5} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!LTree.hs|hyperpage}{6} +\indexentry{Combinador ``pointfree''!\emph {either}|hyperpage}{7} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!LTree.hs|hyperpage}{7} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{7} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{8} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!LTree.hs|hyperpage}{8} +\indexentry{Functor|hyperpage}{8} +\indexentry{Functor|hyperpage}{8} +\indexentry{Functor|hyperpage}{8} +\indexentry{Functor|hyperpage}{9} +\indexentry{Combinador ``pointfree''!\emph {either}|hyperpage}{9} +\indexentry{Programa\IeC {\c c}\IeC {\~a}o!liter\IeC {\'a}ria|hyperpage}{9} +\indexentry{Programa\IeC {\c c}\IeC {\~a}o!liter\IeC {\'a}ria|hyperpage}{9} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico|hyperpage}{9} +\indexentry{Haskell!Literate Haskell|hyperpage}{9} +\indexentry{\LaTeX !\texttt {lhs2TeX}|hyperpage}{10} +\indexentry{\LaTeX |hyperpage}{10} +\indexentry{Haskell|hyperpage}{10} +\indexentry{Haskell!interpretador!GHCi|hyperpage}{10} +\indexentry{C\IeC {\'a}lculo de Programas|hyperpage}{10} +\indexentry{\LaTeX !\texttt {bibtex}|hyperpage}{10} +\indexentry{\LaTeX !\texttt {makeindex}|hyperpage}{10} +\indexentry{Haskell|hyperpage}{10} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _1$|hyperpage}{10} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _2$|hyperpage}{10} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _1$|hyperpage}{10} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _2$|hyperpage}{10} +\indexentry{N\IeC {\'u}meros naturais ($I\tmspace -\thinmuskip {.1667em}\tmspace -\thinmuskip {.1667em}N$)|hyperpage}{11} +\indexentry{N\IeC {\'u}meros naturais ($I\tmspace -\thinmuskip {.1667em}\tmspace -\thinmuskip {.1667em}N$)|hyperpage}{11} +\indexentry{N\IeC {\'u}meros naturais ($I\tmspace -\thinmuskip {.1667em}\tmspace -\thinmuskip {.1667em}N$)|hyperpage}{11} +\indexentry{Programa\IeC {\c c}\IeC {\~a}o!din\IeC {\^a}mica|hyperpage}{11} +\indexentry{N\IeC {\'u}meros naturais ($I\tmspace -\thinmuskip {.1667em}\tmspace -\thinmuskip {.1667em}N$)|hyperpage}{11} +\indexentry{Functor|hyperpage}{11} +\indexentry{C\IeC {\'a}lculo de Programas|hyperpage}{11} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _1$|hyperpage}{11} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {for}|hyperpage}{11} +\indexentry{N\IeC {\'u}meros naturais ($I\tmspace -\thinmuskip {.1667em}\tmspace -\thinmuskip {.1667em}N$)|hyperpage}{11} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _1$|hyperpage}{11} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {for}|hyperpage}{11} +\indexentry{Haskell!Biblioteca!Probability|hyperpage}{12} +\indexentry{Functor|hyperpage}{12} +\indexentry{Functor|hyperpage}{12} +\indexentry{Functor|hyperpage}{12} +\indexentry{Haskell!interpretador!GHCi|hyperpage}{12} +\indexentry{Functor|hyperpage}{12} +\indexentry{Functor|hyperpage}{12} +\indexentry{Functor|hyperpage}{12} +\indexentry{Haskell!Biblioteca!Probability|hyperpage}{12} +\indexentry{Haskell!Biblioteca!PFP|hyperpage}{12} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{13} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{13} +\indexentry{C\IeC {\'a}lculo de Programas!Material Pedag\IeC {\'o}gico!Exp.hs|hyperpage}{13} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {length}|hyperpage}{13} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {length}|hyperpage}{13} +\indexentry{SVG (Scalable Vector Graphics)|hyperpage}{13} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{14} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _2$|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _2$|hyperpage}{15} +\indexentry{Functor|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _1$|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _2$|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!\emph {map}|hyperpage}{15} +\indexentry{Fun\IeC {\c c}\IeC {\~a}o!$\pi _2$|hyperpage}{15} +\indexentry{Functor|hyperpage}{16} +\indexentry{Functor|hyperpage}{16} diff --git a/cp2223t/cp2223t.ilg b/cp2223t/cp2223t.ilg new file mode 100644 index 0000000..05ef72c --- /dev/null +++ b/cp2223t/cp2223t.ilg @@ -0,0 +1,6 @@ +This is makeindex, version 2.15 [TeX Live 2017] (kpathsea + Thai support). +Scanning input file cp2223t.idx....done (85 entries accepted, 0 rejected). +Sorting entries....done (547 comparisons). +Generating output file cp2223t.ind....done (62 lines written, 0 warnings). +Output written in cp2223t.ind. +Transcript written in cp2223t.ilg. diff --git a/cp2223t/cp2223t.ind b/cp2223t/cp2223t.ind new file mode 100644 index 0000000..864bae6 --- /dev/null +++ b/cp2223t/cp2223t.ind @@ -0,0 +1,62 @@ +\begin{theindex} + + \item \LaTeX , \hyperpage{10} + \subitem \texttt {bibtex}, \hyperpage{10} + \subitem \texttt {lhs2TeX}, \hyperpage{10} + \subitem \texttt {makeindex}, \hyperpage{10} + + \indexspace + + \item C\IeC {\'a}lculo de Programas, \hyperpage{1}, \hyperpage{3}, + \hyperpage{10, 11} + \subitem Material Pedag\IeC {\'o}gico, \hyperpage{9} + \subsubitem Exp.hs, \hyperpage{2, 3}, \hyperpage{13} + \subsubitem LTree.hs, \hyperpage{6--8} + \subsubitem Rose.hs, \hyperpage{4} + \item Combinador ``pointfree'' + \subitem \emph {either}, \hyperpage{7}, \hyperpage{9} + + \indexspace + + \item Fractal, \hyperpage{3} + \subitem Tapete de Sierpinski, \hyperpage{3} + \item Fun\IeC {\c c}\IeC {\~a}o + \subitem $\pi _1$, \hyperpage{10, 11}, \hyperpage{15} + \subitem $\pi _2$, \hyperpage{10}, \hyperpage{15} + \subitem \emph {for}, \hyperpage{2}, \hyperpage{11} + \subitem \emph {length}, \hyperpage{13} + \subitem \emph {map}, \hyperpage{7, 8}, \hyperpage{13--15} + \item Functor, \hyperpage{5}, \hyperpage{8, 9}, \hyperpage{11, 12}, + \hyperpage{15, 16} + + \indexspace + + \item Haskell, \hyperpage{1}, \hyperpage{10} + \subitem Biblioteca + \subsubitem PFP, \hyperpage{12} + \subsubitem Probability, \hyperpage{12} + \subitem interpretador + \subsubitem GHCi, \hyperpage{10}, \hyperpage{12} + \subitem Literate Haskell, \hyperpage{9} + + \indexspace + + \item N\IeC {\'u}meros naturais ($I\tmspace -\thinmuskip {.1667em}\tmspace -\thinmuskip {.1667em}N$), + \hyperpage{11} + + \indexspace + + \item Programa\IeC {\c c}\IeC {\~a}o + \subitem din\IeC {\^a}mica, \hyperpage{11} + \subitem liter\IeC {\'a}ria, \hyperpage{9} + + \indexspace + + \item SVG (Scalable Vector Graphics), \hyperpage{13} + + \indexspace + + \item U.Minho + \subitem Departamento de Inform\IeC {\'a}tica, \hyperpage{1, 2} + +\end{theindex} diff --git a/cp2223t/cp2223t.lhs b/cp2223t/cp2223t.lhs new file mode 100644 index 0000000..8f50301 --- /dev/null +++ b/cp2223t/cp2223t.lhs @@ -0,0 +1,1186 @@ +\documentclass[a4paper]{article} +\usepackage[a4paper,left=3cm,right=2cm,top=2.5cm,bottom=2.5cm]{geometry} +\usepackage[sfdefault, book, lf]{FiraSans} % lf - lined numbers +\usepackage[colorlinks=true]{hyperref} +\usepackage{graphicx} +\usepackage{cp2223t} +\usepackage{subcaption} +\usepackage{adjustbox} +\usepackage[indent=12pt]{parskip} + +%================= lhs2tex=====================================================% +%include polycode.fmt +%format (div (x)(y)) = x "\div " y +%format succ = "\succ " +%format ==> = "\Longrightarrow " +%format map = "\map " +%format length = "\length " +%format fst = "\p1" +%format p1 = "\p1" +%format snd = "\p2" +%format p2 = "\p2" +%format Left = "i_1" +%format Right = "i_2" +%format i1 = "i_1" +%format i2 = "i_2" +%format >< = "\times" +%format >|< = "\bowtie " +%format |-> = "\mapsto" +%format . = "\comp " +%format .=?=. = "\mathbin{\stackrel{\mathrm{?}}{=}}" +%format -|- = "+" +%format conc = "\mathsf{conc}" +%format summation = "{\sum}" +%format (either (a) (b)) = "\alt{" a "}{" b "}" +%format (frac (a) (b)) = "\frac{" a "}{" b "}" +%format (uncurry f) = "\uncurry{" f "}" +%format (const (f)) = "\underline{" f "}" +%format (lcbr (x)(y)) = "\begin{lcbr}" x "\\" y "\end{lcbr}" +%format (lcbr3 (x)(y)(z)) = "\begin{lcbr}" x "\\" y "\\" z "\end{lcbr}" +%format (split (x) (y)) = "\conj{" x "}{" y "}" +%format (for (f) (i)) = "\for{" f "}\ {" i "}" +%format <$> = "\mathbin{\mathopen{\langle}\$\mathclose{\rangle}}" +%format Either a b = a "+" b +%format fmap = "\mathsf{fmap}" +%format NA = "\textsc{na}" +%format NB = "\textbf{NB}" +%format inT = "\mathsf{in}" +%format outT = "\mathsf{out}" +%format outLTree = "\mathsf{out}_{\tiny\ \textit{LTree}}" +%format inLTree = "\mathsf{in}_{\tiny\ \textit{LTree}}" +%format inFTree = "\mathsf{in}_{\tiny\ \textit{FTree}}" +%format outFTree = "\mathsf{out}_{\tiny\ \textit{FTree}}" +%format inExp = "\mathsf{in}_{\tiny\ \textit{Exp}}" +%format outExp = "\mathsf{out}_{\tiny\ \textit{Exp}}" +%format Null = "1" +%format (Prod (a) (b)) = a >< b +%format fF = "\fun F " +%format l2 = "l_2 " +%format Dist = "\fun{Dist}" +%format IO = "\fun{IO}" +%format LTree = "{\LTree}" +%format FTree = "{\FTree}" +%format inNat = "\mathsf{in}" +%format (cata (f)) = "\llparenthesis\, " f "\,\rrparenthesis" +%format (cataNat (g)) = "\llparenthesis\, " g "\,\rrparenthesis" +%format (cataList (g)) = "\llparenthesis\, " g "\,\rrparenthesis" +%format (cataLTree (x)) = "\llparenthesis\, " x "\,\rrparenthesis" +%format (cataFTree (x)) = "\llparenthesis\, " x "\,\rrparenthesis" +%format (cataRose (x)) = "\llparenthesis\, " x "\,\rrparenthesis_\textit{\tiny R}" +%format (cataExp (x)) = "\llparenthesis\, " x "\,\rrparenthesis_\textit{\tiny Exp}" +%format (ana (g)) = "\ana{" g "}" +%format (anaList (g)) = "\anaList{" g "}" +%format (anaLTree (g)) = "\lanabracket\;\!" g "\;\!\ranabracket" +%format (anaRose (g)) = "\lanabracket\;\!" g "\;\!\ranabracket_\textit{\tiny R}" +%format (anaExp (g)) = "\lanabracket\;\!" g "\;\!\ranabracket_\textit{\tiny Exp}" +%format (hylo (g) (h)) = "\llbracket\, " g ",\," h "\,\rrbracket" +%format (hyloRose (g) (h)) = "\llbracket\, " g ",\," h "\,\rrbracket_\textit{\tiny R}" +%format (hyloExp (g) (h)) = "\llbracket\, " g ",\," h "\,\rrbracket_\textit{\tiny Exp}" +%format Nat0 = "\N_0" +%format Rational = "\Q " +%format toRational = " to_\Q " +%format fromRational = " from_\Q " +%format muB = "\mu " +%format (frac (n)(m)) = "\frac{" n "}{" m "}" +%format (fac (n)) = "{" n "!}" +%format (underbrace (t) (p)) = "\underbrace{" t "}_{" p "}" +%format matrix = "matrix " +%format `ominus` = "\mathbin{\ominus}" +%format <-> = "{\,\leftrightarrow\,}" +%format <|> = "{\,\updownarrow\,}" +%format `minusNat`= "\mathbin{-}" +%format ==> = "\Rightarrow" +%format .==>. = "\Rightarrow" +%format .<==>. = "\Leftrightarrow" +%format .==. = "\equiv" +%format .<=. = "\leq" +%format .&&&. = "\wedge" +%format cdots = "\cdots " +%format pi = "\pi " +%format (curry (f)) = "\overline{" f "}" +%format delta = "\Delta " +%format (plus (f)(g)) = "{" f "}\plus{" g "}" +%format ++ = "\mathbin{+\!\!\!+}" +%format Integer = "\mathbb{Z}" +%format (Cp.cond (p) (f) (g)) = "\mcond{" p "}{" f "}{" g "}" +\def\plus{\mathbin{\dagger}} +%format square (x) = x "^2" +%format a1 = "a_1 " +%format a2 = "a_2 " +%format a3 = "a_3 " +%format a4 = "a_4 " +%format b1 = "b_1 " +%format b2 = "b_2 " +%format b3 = "b_3 " +%format b4 = "b_4 " +%format c1 = "c_1 " +%format c2 = "c_2 " +%format c3 = "c_3 " +%format c4 = "c_4 " +%format d1 = "d_1 " +%format d2 = "d_2 " +%format d3 = "d_3 " +%format d4 = "d_4 " +%format r1 = "r_1 " +%format r2 = "r_2 " +%format s1 = "s_1 " +%format s2 = "s_2 " +%format e1 = "e_1 " +%format e2 = "e_2 " +\def\kcomp{\mathbin{\bullet}} +%format (kcomp (f) (g)) = f "\kcomp " g +%format .! = "\kcomp" +%--------------------------------------------------------------------------- + +\title{ + \textbf{Cálculo de Programas} +\\ + Trabalho Prático +\\ + LEI --- 2022/23 +} + +\author{ + \dium +\\ + Universidade do Minho +} + + +\date\mydate + +\makeindex +\newcommand{\rn}[1]{\textcolor{Red}{#1}} +\begin{document} +\emergencystretch 3em +%\sloppy + +\maketitle + +\begin{center}\large +\begin{tabular}{ll} +Grupo nr. & 99 (preencher) +\\\hline +a11111 & Nome1 (preencher) +\\ +a22222 & Nome2 (preencher) +\\ +a33333 & Nome3 (preencher) +\\ +a44444 & Nome4 (preencher, se aplicável) +\end{tabular} +\end{center} + +\section*{Preâmbulo} + +\CP\ tem como objectivo principal ensinar +a progra\-mação de computadores como uma disciplina científica. Para isso +parte-se de um repertório de \emph{combinadores} que formam uma álgebra da +programação (conjunto de leis universais e seus corolários) e usam-se esses +combinadores para construir programas \emph{composicionalmente}, isto é, +agregando programas já existentes. + +Na sequência pedagógica dos planos de estudo dos cursos que têm +esta disciplina, opta-se pela aplicação deste método à programação +em \Haskell\ (sem prejuízo da sua aplicação a outras linguagens +funcionais). Assim, o presente trabalho prático coloca os +alunos perante problemas concretos que deverão ser implementados em +\Haskell. Há ainda um outro objectivo: o de ensinar a documentar +programas, a validá-los e a produzir textos técnico-científicos de +qualidade. + +Antes de abodarem os problemas propostos no trabalho, os grupos devem ler +com atenção o anexo \ref{sec:documentacao} onde encontrarão as instruções +relativas ao sofware a instalar, etc. + +%if False +\begin{code} +{-# OPTIONS_GHC -XNPlusKPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, FlexibleInstances #-} +module Main where +import Cp +import List hiding (fac) +import NEList (out) +import Exp +import Nat hiding (aux) +import LTree +import Rose hiding (g) +import Probability +import Data.List hiding (find) +import Data.List.Split hiding (split,chunksOf) +import Svg hiding (for,wrap) +import Control.Concurrent +import Cp2223data + +main = undefined +instance Strong Dist +\end{code} +%endif + +\Problema +Suponha-se uma sequência numérica semelhante à sequência de Fibonacci tal +que cada termo subsequente aos três primeiros corresponde à soma dos três +anteriores, sujeitos aos coeficientes |a|, |b| e |c|: +\begin{code} +f a b c 0 = 0 +f a b c 1 = 1 +f a b c 2 = 1 +f a b c (n+3) = a * f a b c (n+2) + b * f a b c (n+1) + c * f a b c n +\end{code} +Assim, por exemplo, |f 1 1 1| irá dar como resultado a sequência: +\begin{spec} +1, 1, 2, 4, 7, 13, 24, 44, 81, 149, ... +\end{spec} +|f 1 2 3| irá gerar a sequência: +\begin{spec} +1,1,3,8,17,42,100,235,561,1331, ... +\end{spec} +etc. + +A definição de |f| dada é muito ineficiente, tendo uma degradação do tempo +de execução exponencial. +Pretende-se otimizar a função dada convertendo-a para um ciclo \textit{for}. +Recorrendo à lei de recursividade mútua, calcule |loop| e |initial| em +\begin{code} +fbl a b c = wrap . (for ((loop a b c)) initial) +\end{code} +por forma a |f| e |fbl| serem (matematicamente) a mesma função. +Para tal, poderá usar a regra prática explicada no anexo \ref{sec:mr}. + +\textbf{Valorização}: apresente testes de \textit{performance} que mostrem +quão mais rápida é |fbl| quando comparada com |f|. + +\Problema +Pretende-se vir a classificar os conteúdos programáticos de todas as +\href{https://web.di.uminho.pt/sitedi/ucs/}{UCs} lecionadas no \dium\ de +acordo com o \href{https://dl.acm.org/ccs}{ACM Computing Classification System}. +A listagem da taxonomia desse sistema está disponível no ficheiro +\texttt{Cp2223data}, +começando com +\begin{spec} +acm_ccs = [ "CCS", + " General and reference", + " Document types", + " Surveys and overviews", + " Reference works", + " General conference proceedings", + " Biographies", + " General literature", + " Computing standards, RFCs and guidelines", + " Cross-computing tools and techniques", +\end{spec} +(10 primeiros ítens) etc., etc.\footnote{Informação obtida a partir do site +\href{https://dl.acm.org/ccs}{ACM CCS} selecionando \emph{Flat View}.} + +Pretende-se representar a mesma informação sob a forma de uma árvore de expressão, +usando para isso a biblioteca \Exp\ que consta do material padagógico da disciplina e +que vai incluída no zip do projecto, por ser mais conveniente para os alunos. + +\begin{enumerate} +\item Comece por definir a função de conversão do texto dado em |acm_ccs| +(uma lista de \emph{strings}) para uma tal árvore como um anamorfismo de \Exp: +% +\begin{code} +tax :: [String] -> Exp String String +tax = anaExp gene +\end{code} +Ou seja, defina o |gene| do anamorfismo, +tendo em conta o seguinte diagrama\footnote{|S| abrevia |String|.}: +\begin{eqnarray*} +\xymatrix{ + |Exp S S| & & S + S \times (|Exp S S|)^*\ar[ll]_{|inExp|} \\ + S^*\ar@@/_1.5pc/[rr]_{|gene|}\ar[r]^(0.35){|out|}\ar[u]^{|tax|} & S + S \times S^*\ar[r]^(0.45){\cdots} & S + S \times (S^*)^*\ar[u]_{id + id \times tax^*} +} +\end{eqnarray*} +Para isso, tome em atenção que cada nível da hierarquia é, em |acm_ccs|, +marcado pela indentação de 4 espaços adicionais --- como se mostra no fragmento acima. + +Na figura \ref{fig:P1} mostra-se a representação gráfica da árvore de tipo \Exp\ que representa o fragmento de |acm_ccs| mostrado acima. + +\begin{figure}[ht!] +\centering +\begin{tikzpicture} +[-,every node/.style={shape=rectangle,inner sep=3pt,draw}] +\footnotesize +\node {CSS} [edge from parent fork down] + [sibling distance=4cm] + child {node [align=center] {General and\\reference} + [sibling distance=4cm] + child {node {Document types} + [sibling distance=2.25cm] + child {node [align=center] {Surveys and\\overviews}} + child {node [align=center] {Reference\\works}} + child {node [align=center] {General\\conference\\proceedings}} + child {node [align=center] {Biographies}} + child {node [align=center] {General\\literature}} + child {node [align=center, xshift=0.75cm] {Computing standards,\\RFCs and\\guidelines}} + } + child {node [align=center] {Cross-computing tools and\\techniques}} + } + ; +\end{tikzpicture} +\caption{Fragmento de |acm_ccs| representado sob a forma de uma árvore do tipo \Exp.} +\label{fig:P1} +\end{figure} + +\item De seguida vamos querer todos os caminhos da árvore que é gerada por |tax|, +pois a classificação de uma UC pode ser feita a qualquer nível (isto é, caminho +descendente da raiz |"CCS"| até um subnível ou folha). +\footnote{Para um exemplo de classificação de UC concreto, pf.\ ver a secção \textbf{Classificação ACM} na página +pública de \CP.} + +Precisamos pois da composição de |tax| com uma função de pós-processamento |post|, +% +\begin{spec} +tudo :: [String] -> [[String]] +tudo = post . tax +\end{spec} +para obter o efeito que se mostra na tabela \ref{table:acmccs}. + +\begin{table}[ht!] +\centering\small +\begin{center} +\begin{tabular}{||l||l||l||l||} +\hline +CCS & & & +\\\hline +CCS & General and reference & & +\\\hline +CCS & General and reference & Document types & +\\\hline +CCS & General and reference & Document types & Surveys and overviews +\\\hline +CCS & General and reference & Document types & Reference works +\\\hline +CCS & General and reference & Document types & General conference proceedings +\\\hline +CCS & General and reference & Document types & Biographies +\\\hline +CCS & General and reference & Document types & General literature +\\\hline +CCS & General and reference & Cross-computing tools and techniques & +\\\hline +\end{tabular} +\end{center} +\caption{Taxonomia ACM fechada por prefixos (10 primeiros ítens).} +\label{table:acmccs} +\end{table} + +Defina a função |post :: Exp String String -> [[String]]| da forma mais económica que encontrar. +\end{enumerate} + +\textbf{Sugestão}: Inspecione as bibliotecas fornecidas à procura de funções +auxiliares que possa re-utilizar para a sua solução ficar mais simples. +Não se esqueça que, para o mesmo resultado, +nesta disciplina \emph{``ganha'' quem escrever menos código}! + +\textbf{Sugestão}: Para efeitos de testes intermédios não use a totalidade de |acm_ccs|, +que tem 2114 linhas! Use, por exemplo, |take 10 acm_ccs|, como se mostrou acima. + +\Problema + +O \sierpCarpet{tapete de Sierpinski} é uma figura geométrica \fractal\ em que um quadrado é subdividido recursivamente em sub-quadrados. A construção clássica do tapete de Sierpinski é a seguinte: assumindo um quadrado de lado |l|, este é subdivido em 9 quadrados iguais de lado |l / 3|, removendo-se o quadrado central. Este passo é depois repetido sucessivamente para cada um dos 8 sub-quadrados restantes (Fig.~\ref{fig:sierp1}). + +\begin{figure}[h!] + \centering + \includegraphics[width=0.19\textwidth]{cp2223t_media/tapete1.png} + \includegraphics[width=0.19\textwidth]{cp2223t_media/tapete2.png} + \includegraphics[width=0.19\textwidth]{cp2223t_media/tapete3.png} + \includegraphics[width=0.19\textwidth]{cp2223t_media/tapete4.png} + \includegraphics[width=0.19\textwidth]{cp2223t_media/tapete5.png} + \caption{Construção do tapete de Sierpinski com profundidade 5.} + \label{fig:sierp1} +\end{figure} + +\noindent +|NB|: No exemplo da fig.~\ref{fig:sierp1}, assumindo a construção clássica já referida, os quadrados estão a branco e o fundo a verde. + +A complexidade deste algoritmo, em função do número de quadrados a desenhar, para uma profundidade $n$, é de $8^n$ (exponencial). No entanto, se assumirmos que os quadrados a desenhar são os que estão a verde, a complexidade é reduzida para $\sum_{i=0}^{n-1}8^i$, obtendo um ganho de $\sum_{i=1}^{n} \frac{100}{8^i} \%$. Por exemplo, para $n=5$, o ganho é de $14.28 \%$. O objetivo deste problema é a implementação do algoritmo mediante a referida otimização. +\begin{figure}[h!] + \centering + \includegraphics[width=0.35\textwidth]{cp2223t_media/tapete_ex} + \caption{Tapete de Sierpinski com profundidade 2 e com os quadrados enumerados.} + \label{fig:sierp2} +\end{figure} + +Assim, seja cada quadrado descrito geometricamente pelas coordenadas do seu vértice inferior esquerdo e o comprimento do seu lado: +\begin{code} +type Square = (Point, Side) +type Side = Double +type Point = (Double, Double) +\end{code} +A estrutura recursiva de suporte à construção de tapetes de Sierpinski será uma \Rose, na qual cada nível da árvore irá guardar os quadrados de tamanho igual. Por exemplo, a construção da fig.~\ref{fig:sierp2} poderá\footnote{A ordem dos filhos não é relevante.} corresponder à árvore da figura \ref{fig:roseTreeSierp}. +\begin{figure}[ht!] +\centering +\begin{tikzpicture} +[level distance = 2cm, +level 1/.style = {sibling distance = 1.5cm}, +level 2/.style = {sibling distance = 0.9cm}, +]\node [draw, circle]{1} +child {node [draw, circle]{2} +child {node [draw, circle]{10}} +child {node [draw, circle]{11}} +child {node [draw, circle]{12}} +child {node [draw, circle]{13}} +child {node [draw, circle]{14}} +child {node [draw, circle]{15}} +child {node [draw, circle]{16}} +child {node [draw, circle]{17}}} +child {node [draw, circle]{3}} +child {node [draw, circle]{4}} +child {node [draw, circle]{5}} +child {node [draw, circle]{6}} +child {node [draw, circle]{7}} +child {node [draw, circle]{8}} +child {node [draw, circle]{9}}; +\end{tikzpicture} +\caption{Possível árvore de suporte para a construção da fig.~\ref{fig:sierp2}.} +\label{fig:roseTreeSierp} +\end{figure} + +Uma vez que o tapete é também um quadrado, o objetivo será, a partir das informações do tapete (coordenadas do vértice inferior esquerdo e comprimento do lado), desenhar o quadrado central, subdividir o tapete nos 8 sub-tapetes restantes, e voltar a desenhar, recursivamente, o quadrado nesses 8 sub-tapetes. Desta forma, cada tapete determina o seu quadrado e os seus 8 sub-tapetes. No exemplo em cima, o tapete que contém o quadrado 1 determina esse próprio quadrado e determina os sub-tapetes que contêm os quadrados 2 a 9. + +Portanto, numa primeira fase, dadas as informações do tapete, é construida a árvore de suporte com todos os quadrados a desenhar, para uma determinada profundidade. +\begin{code} +squares :: (Square, Int) -> Rose Square +\end{code} +|NB|: No programa, a profundidade começa em $0$ e não em $1$. + +Uma vez gerada a árvore com todos os quadrados a desenhar, é necessário extrair os quadrados para uma lista, a qual é processada pela função |drawSq|, disponibilizada no anexo \ref{sec:codigo}. +\begin{code} +rose2List :: Rose a -> [a] +\end{code} +Assim, a construção de tapetes de Sierpinski é dada por um hilomorfismo de \textit{Rose Trees}: +\begin{code} +sierpinski :: (Square, Int) -> [Square] +sierpinski = hyloRose gr2l gsq +\end{code} +\textbf{Trabalho a fazer:} +\begin{enumerate} + \item Definir os genes do hilomorfismo |sierpinski|. + \item Correr +\begin{code} +sierp4 = drawSq (sierpinski (((0,0),32),3)) + +constructSierp5 = do drawSq (sierpinski (((0,0),32),0)) + await + drawSq (sierpinski (((0,0),32),1)) + await + drawSq (sierpinski (((0,0),32),2)) + await + drawSq (sierpinski (((0,0),32),3)) + await + drawSq (sierpinski (((0,0),32),4)) + await +\end{code} + \item Definir a função que apresenta a construção do tapete de Sierpinski como é apresentada em |construcaoSierp5|, mas para uma profundidade $n \in \mathbb{N}$ recebida como parâmetro. +\begin{code} +constructSierp :: Int -> IO [()] +constructSierp = present . carpets +\end{code} +\textbf{Dica}: a função |constructSierp| será um hilomorfismo de listas, cujo anamorfismo |carpets :: Int -> [[Square]]| constrói, recebendo como parâmetro a profundidade $n$, a lista com todos os tapetes de profundidade $1..n$, e o catamorfismo |present :: [[Square]] -> IO [()]| percorre a lista desenhando os tapetes e esperando 1 segundo de intervalo. +\end{enumerate} + +\Problema + +Este ano ocorrerá a vigésima segunda edição do Campeonato do Mundo de Futebol, organizado pela Federação Internacional de Futebol (FIFA), a decorrer no Qatar e com o jogo inaugural a 20 de Novembro. + +Uma casa de apostas pretende calcular, com base numa aproximação dos \textit{rankings}\footnote{Os \textit{rankings} obtidos \href{https://www.fifa.com/fifa-world-ranking/men?dateId=id13687}{aqui} foram escalados e arredondados.} das seleções, a probabilidade de cada seleção vencer a competição. + +Para isso, o diretor da casa de apostas contratou o Departamento de Informática da Universidade do Minho, que atribuiu o projeto à equipa formada pelos alunos e pelos docentes de Cálculo de Programas. + +\begin{alert} +Para resolver este problema de forma simples, ele será abordado por duas fases: +\begin{enumerate} +\item versão académica sem probabilidades, em que se sabe à partida, num jogo, quem o vai vencer; +\item versão realista com probabilidades usando o mónade \textit{Dist} (distribuições probabilísticas) que vem descrito no anexo \ref{sec:probabilities}. +\end{enumerate} +A primeira versão, mais simples, deverá ajudar a construir a segunda. +\end{alert} + +\subsection*{Descrição do problema} + +Uma vez garantida a qualificação (já ocorrida), o campeonato consta de duas fases consecutivas no tempo: +\begin{enumerate} +\item fase de grupos; +\item fase eliminatória (ou ``mata-mata'', como é habitual dizer-se no Brasil). +\end{enumerate} + +Para a fase de grupos, é feito um sorteio das 32 seleções (o qual já ocorreu para esta competição) +que as coloca em 8 grupos, 4 seleções em cada grupo. +Assim, cada grupo é uma lista de seleções. + +Os grupos para o campeonato deste ano são: +\begin{code} +type Team = String +type Group = [Team] + +groups :: [Group] +groups = [["Qatar", "Ecuador", "Senegal", "Netherlands"], + ["England", "Iran", "USA", "Wales"], + ["Argentina", "Saudi Arabia", "Mexico", "Poland"], + ["France", "Denmark", "Tunisia", "Australia"], + ["Spain", "Germany", "Japan", "Costa Rica"], + ["Belgium", "Canada", "Morocco", "Croatia"], + ["Brazil", "Serbia", "Switzerland", "Cameroon"], + ["Portugal", "Ghana", "Uruguay", "Korea Republic"]] +\end{code} +Deste modo, \textit{groups !! 0} corresponde ao grupo A, \textit{groups !! 1} ao grupo B, e assim sucessivamente. +Nesta fase, cada seleção de cada grupo vai defrontar (uma vez) as outras do seu grupo. + +Passam para o ``mata-mata'' as duas seleções que mais pontuarem em cada grupo, obtendo pontos, por cada jogo da fase grupos, da seguinte forma: +\begin{itemize} +\item vitória --- 3 pontos; +\item empate --- 1 ponto; +\item derrota --- 0 pontos. +\end{itemize} +Como se disse, a posição final no grupo irá determinar se uma seleção avança para o ``mata-mata'' e, se avançar, que possíveis jogos terá pela frente, uma vez que a disposição das seleções está desde o início definida para esta última fase, conforme se pode ver na figura \ref{fig:wcup22}. +\begin{figure}[ht] + \centering + \includegraphics[scale=0.125]{cp2223t_media/wcup2022.png} + \caption{O ``mata-mata''} + \label{fig:wcup22} +\end{figure} + +Assim, é necessário calcular os vencedores dos grupos sob uma distribuição probabilística. +Uma vez calculadas as distribuições dos vencedores, é necessário colocá-las nas folhas de uma |LTree| de forma a fazer um \textit{match} com a figura \ref{fig:wcup22}, entrando assim na fase final da competição, o tão esperado ``mata-mata''. +Para avançar nesta fase final da competição (i.e.\ subir na árvore), é preciso ganhar, quem perder é automaticamente eliminado (``mata-mata''). Quando uma seleção vence um jogo, sobe na árvore, quando perde, fica pelo caminho. Isto significa que a seleção vencedora é aquela que vence todos os jogos do ``mata-mata''. + +\subsection*{Arquitetura proposta} + +A visão composicional da equipa permitiu-lhe perceber desde logo que o problema podia ser dividido, independentemente da versão, probabilística ou não, em duas partes independentes --- a da fase de grupos e a do ``mata-mata''. Assim, duas sub-equipas poderiam trabalhar em paralelo, desde que se garantisse a composicionalidade das partes. +Decidiu-se que os alunos desenvolveriam a parte da fase de grupos e os docentes a do ``mata-mata''. + +\subsubsection*{Versão não probabilística} +O resultado final (não probabilístico) é dado pela seguinte função: +\begin{code} +winner :: Team +winner = wcup groups + +wcup = knockoutStage . groupStage +\end{code} +A sub-equipa dos docentes já entregou a sua parte: +\begin{code} +knockoutStage = cataLTree (either id koCriteria) +\end{code} + +Considere-se agora a proposta do \textit{team leader} da sub-equipa dos alunos para o desenvolvimento da fase de grupos: + +\begin{bquote} +{\slshape + +Vamos dividir o processo em 3 partes: +\begin{itemize} +\item gerar os jogos, +\item simular os jogos, +\item preparar o ``mata-mata'' gerando a árvore de jogos dessa fase (fig. \ref{fig:wcup22}). +\end{itemize} +Assim: +\begin{code} +groupStage :: [Group] -> LTree Team +groupStage = initKnockoutStage . simulateGroupStage . genGroupStageMatches +\end{code} + +Comecemos então por definir a função |genGroupStageMatches| que gera os jogos da fase de grupos: +\begin{code} +genGroupStageMatches :: [Group] -> [[Match]] +genGroupStageMatches = map generateMatches +\end{code} +onde +\begin{code} +type Match = (Team, Team) +\end{code} +Ora, sabemos que nos foi dada a função +\begin{code} +gsCriteria :: Match -> Maybe Team +\end{code} +que, mediante um certo critério, calcula o resultado de um jogo, retornando |Nothing| em caso de empate, ou a equipa vencedora (sob o construtor |Just|). Assim, precisamos de definir a função +\begin{code} +simulateGroupStage :: [[Match]] -> [[Team]] +simulateGroupStage = map (groupWinners gsCriteria) +\end{code} +que simula a fase de grupos e dá como resultado a lista dos vencedores, +recorrendo à função |groupWinners|: +\begin{code} +groupWinners criteria = best 2 . consolidate . (>>= matchResult criteria) +\end{code} +Aqui está apenas em falta a definição da função |matchResult|. + +Por fim, teremos a função |initKnockoutStage| que produzirá a |LTree| que a sub-equipa do ``mata-mata'' precisa, com as devidas posições. Esta será a composição de duas funções: +\begin{code} +initKnockoutStage = anaLTree glt . arrangement +\end{code} +} +\end{bquote} +Trabalho a fazer: +\begin{enumerate} +\item Definir uma alternativa à função genérica |consolidate| que seja um +catamorfismo de listas: +\begin{code} +consolidate' :: (Eq a, Num b) => [(a, b)] -> [(a, b)] +consolidate' = cataList cgene +\end{code} +\item Definir a função |matchResult :: (Match -> Maybe Team) -> Match -> + [(Team, Int)]| que apura os pontos das equipas de um dado jogo. +\item Definir a função genérica |pairup :: Eq b => [b] -> [(b, b)]| em que + |generateMatches| se baseia. +\item Definir o gene |glt|. +\end{enumerate} + +\subsubsection*{Versão probabilística} + +Nesta versão, mais realista, |gsCriteria :: Match -> (Maybe Team)| dá lugar a +\begin{code} +pgsCriteria :: Match -> Dist (Maybe Team) +\end{code} +que dá, para cada jogo, a probabilidade de cada equipa vencer ou haver um empate. +Por exemplo, há |50%| de probabilidades de Portugal empatar com a Inglaterra, +\begin{quote} +\begin{verbatim} +pgsCriteria("Portugal","England") + Nothing 50.0% + Just "England" 26.7% +Just "Portugal" 23.3% +\end{verbatim} +\end{quote} +etc. + +O que é |Dist|? É o mónade que trata de distribuições probabilísticas e que é descrito no +anexo \ref{sec:probabilities}, página \pageref{sec:probabilities} e seguintes. O que há a fazer? Eis o que diz o vosso \emph{team leader}: + +\begin{bquote} +\slshape +O que há a fazer nesta versão é, antes de mais, avaliar qual é o impacto +de |gsCriteria| virar monádica (em |Dist|) na arquitetura geral da versão +anterior. Há que reduzir esse impacto ao mínimo, escrevendo-se tão pouco código +quanto possível! +\end{bquote} + +Todos relembraram algo que tinham aprendido nas aulas teóricas a respeito +da ``monadificação'' do código: há que reutilizar o código da versão anterior, +monadificando-o. + +Para distinguir as duas versões decidiu-se afixar o prefixo `p' para identificar +uma função que passou a ser monádica. + +A sub-equipa dos docentes fez entretanto a monadificação da sua parte: +\begin{spec} +pwinner :: Dist Team +pwinner = pwcup groups + +pwcup = pknockoutStage .! pgroupStage +\end{spec} +E entregou ainda a versão probabilística do ``mata-mata'': +\begin{code} +pknockoutStage = mcataLTree' (either return pkoCriteria) + +mcataLTree' g = k where + k (Leaf a) = g1 a + k (Fork(x,y)) = mmbin g2 (k x, k y) + g1 = g . i1 + g2 = g . i2 +\end{code} +A sub-equipa dos alunos também já adiantou trabalho, +\begin{code} +pgroupStage = pinitKnockoutStage .! psimulateGroupStage . genGroupStageMatches +\end{code} +mas faltam ainda |pinitKnockoutStage| e |pgroupWinners|, esta usada em |psimulateGroupStage|, +que é dada em anexo. + +Trabalho a fazer: +\begin{itemize} +\item Definir as funções que ainda não estão implementadas nesta versão. +\item \textbf{Valorização}: experimentar com outros critérios de ``ranking'' das equipas. +\end{itemize} + +\begin{alert} +\textbf{Importante}: (a) código adicional terá que ser colocado no anexo +\ref{sec:resolucao}, obrigatoriamente; (b) todo o código que é dado não pode +ser alterado. +\end{alert} + +\part*{Anexos} + +\appendix + +\section{Documentação para realizar o trabalho} +\label{sec:documentacao} +Para cumprir de forma integrada os objectivos do trabalho vamos recorrer +a uma técnica de programa\-ção dita +``\litp{literária}'' \cite{Kn92}, cujo princípio base é o seguinte: +% +\begin{quote}\em Um programa e a sua documentação devem coincidir. +\end{quote} +% +Por outras palavras, o código fonte e a documentação de um +programa deverão estar no mesmo ficheiro. + +O ficheiro \texttt{cp2223t.pdf} que está a ler é já um exemplo de +\litp{programação literária}: foi gerado a partir do texto fonte +\texttt{cp2223t.lhs}\footnote{O sufixo `lhs' quer dizer +\emph{\lhaskell{literate Haskell}}.} que encontrará no +\MaterialPedagogico\ desta disciplina descompactando o ficheiro +\texttt{cp2223t.zip} e executando: +\begin{Verbatim}[fontsize=\small] + $ lhs2TeX cp2223t.lhs > cp2223t.tex + $ pdflatex cp2223t +\end{Verbatim} +em que \href{https://hackage.haskell.org/package/lhs2tex}{\texttt\LhsToTeX} é +um pré-processador que faz ``pretty printing'' +de código Haskell em \Latex\ e que deve desde já instalar utilizando o +utiliário \href{https://www.haskell.org/cabal/}{cabal} disponível em \href{https://www.haskell.org}{haskell.org}. + +Por outro lado, o mesmo ficheiro \texttt{cp2223t.lhs} é executável e contém +o ``kit'' básico, escrito em \Haskell, para realizar o trabalho. Basta executar +\begin{Verbatim}[fontsize=\small] + $ ghci cp2223t.lhs +\end{Verbatim} + +\noindent Abra o ficheiro \texttt{cp2223t.lhs} no seu editor de texto preferido +e verifique que assim é: todo o texto que se encontra dentro do ambiente +\begin{quote}\small\tt +\verb!\begin{code}! +\\ ... \\ +\verb!\end{code}! +\end{quote} +é seleccionado pelo \GHCi\ para ser executado. + +\subsection{Como realizar o trabalho} +Este trabalho teórico-prático deve ser realizado por grupos de 3 (ou 4) alunos. +Os detalhes da avaliação (datas para submissão do relatório e sua defesa +oral) são os que forem publicados na \cp{página da disciplina} na \emph{internet}. + +Recomenda-se uma abordagem participativa dos membros do grupo +em todos os exercícios do trabalho, para assim +poderem responder a qualquer questão colocada na +\emph{defesa oral} do relatório. + +Em que consiste, então, o \emph{relatório} a que se refere o parágrafo anterior? +É a edição do texto que está a ser lido, preenchendo o anexo \ref{sec:resolucao} +com as respostas. O relatório deverá conter ainda a identificação dos membros +do grupo de trabalho, no local respectivo da folha de rosto. + +Para gerar o PDF integral do relatório deve-se ainda correr os comando seguintes, +que actualizam a bibliografia (com \Bibtex) e o índice remissivo (com \Makeindex), +\begin{Verbatim}[fontsize=\small] + $ bibtex cp2223t.aux + $ makeindex cp2223t.idx +\end{Verbatim} +e recompilar o texto como acima se indicou. + +No anexo \ref{sec:codigo}, disponibiliza-se algum +código \Haskell\ relativo aos problemas apresentados. Esse anexo deverá +ser consultado e analisado à medida que isso for necessário. + +\subsection{Como exprimir cálculos e diagramas em LaTeX/lhs2tex} +Como primeiro exemplo, estudar o texto fonte deste trabalho para obter o +efeito:\footnote{Exemplos tirados de \cite{Ol18}.} +\begin{eqnarray*} +\start + |id = split f g| +% +\just\equiv{ universal property } +% + |lcbr( + p1 . id = f + )( + p2 . id = g + )| +% +\just\equiv{ identity } +% + |lcbr( + p1 = f + )( + p2 = g + )| +\qed +\end{eqnarray*} + +Os diagramas podem ser produzidos recorrendo à \emph{package} \LaTeX\ +\href{https://ctan.org/pkg/xymatrix}{xymatrix}, por exemplo: +\begin{eqnarray*} +\xymatrix@@C=2cm{ + |Nat0| + \ar[d]_-{|cataNat g|} +& + |1 + Nat0| + \ar[d]^{|id + (cataNat g)|} + \ar[l]_-{|inNat|} +\\ + |B| +& + |1 + B| + \ar[l]^-{|g|} +} +\end{eqnarray*} + +\section{Regra prática para a recursividade mútua em |Nat0|}\label{sec:mr} + +Nesta disciplina estudou-se como fazer \pd{programação dinâmica} por cálculo, +recorrendo à lei de recursividade mútua.\footnote{Lei (\ref{eq:fokkinga}) +em \cite{Ol18}, página \pageref{eq:fokkinga}.} + +Para o caso de funções sobre os números naturais (|Nat0|, com functor +|fF X = 1 + X|) é fácil derivar-se da lei que foi estudada uma + \emph{regra de algibeira} + \label{pg:regra} +que se pode ensinar a programadores que não tenham estudado +\cp{Cálculo de Programas}. Apresenta-se de seguida essa regra, tomando como +exemplo o cálculo do ciclo-\textsf{for} que implementa a função de Fibonacci, +recordar o sistema: +\begin{spec} +fib 0 = 1 +fib(n+1) = f n + +f 0 = 1 +f (n+1) = fib n + f n +\end{spec} +Obter-se-á de imediato +\begin{code} +fib' = p1 . for loop init where + loop(fib,f)=(f,fib+f) + init = (1,1) +\end{code} +usando as regras seguintes: +\begin{itemize} +\item O corpo do ciclo |loop| terá tantos argumentos quanto o número de funções +mutuamente recursivas. +\item Para as variáveis escolhem-se os próprios nomes das funções, pela ordem +que se achar conveniente.\footnote{Podem obviamente usar-se outros símbolos, +mas numa primeira leitura dá jeito usarem-se tais nomes.} +\item Para os resultados vão-se buscar as expressões respectivas, retirando +a variável |n|. +\item Em |init| coleccionam-se os resultados dos casos de base das funções, +pela mesma ordem. +\end{itemize} +Mais um exemplo, envolvendo polinómios do segundo grau $ax^2 + b x + c$ em |Nat0|. +Seguindo o método estudado nas aulas\footnote{Secção 3.17 de \cite{Ol18} e tópico +\href{https://www4.di.uminho.pt/~jno/media/cp/}{Recursividade mútua} +nos vídeos de apoio às aulas teóricas.}, +de $f\ x = a x^2 + b x + c$ derivam-se duas funções mutuamente recursivas: +\begin{spec} +f 0 = c +f (n+1) = f n + k n + +k 0 = a + b +k(n+1) = k n + 2 a +\end{spec} +Seguindo a regra acima, calcula-se de imediato a seguinte implementação, em Haskell: +\begin{code} +f' a b c = p1 . for loop init where + loop(f,k) = (f+k,k+2*a) + init = (c,a+b) +\end{code} + +\section{O mónade das distribuições probabilísticas} \label{sec:probabilities} +%format B = "\mathit B" +%format C = "\mathit C" +Mónades são functores com propriedades adicionais que nos permitem obter +efeitos especiais em progra\-mação. Por exemplo, a biblioteca \Probability\ +oferece um mónade para abordar problemas de probabilidades. Nesta biblioteca, +o conceito de distribuição estatística é captado pelo tipo +\begin{eqnarray} + |newtype Dist a = D {unD :: [(a, ProbRep)]}| + \label{eq:Dist} +\end{eqnarray} +em que |ProbRep| é um real de |0| a |1|, equivalente a uma escala de $0$ a +$100 \%$. + +Cada par |(a,p)| numa distribuição |d::Dist a| indica que a probabilidade +de |a| é |p|, devendo ser garantida a propriedade de que todas as probabilidades +de |d| somam $100\%$. +Por exemplo, a seguinte distribuição de classificações por escalões de $A$ a $E$, +\[ +\begin{array}{ll} +A & \rule{2mm}{3pt}\ 2\%\\ +B & \rule{12mm}{3pt}\ 12\%\\ +C & \rule{29mm}{3pt}\ 29\%\\ +D & \rule{35mm}{3pt}\ 35\%\\ +E & \rule{22mm}{3pt}\ 22\%\\ +\end{array} +\] +será representada pela distribuição +\begin{code} +d1 :: Dist Char +d1 = D [('A',0.02),('B',0.12),('C',0.29),('D',0.35),('E',0.22)] +\end{code} +que o \GHCi\ mostrará assim: +\begin{Verbatim}[fontsize=\small] +'D' 35.0% +'C' 29.0% +'E' 22.0% +'B' 12.0% +'A' 2.0% +\end{Verbatim} +É possível definir geradores de distribuições, por exemplo distribuições \emph{uniformes}, +\begin{code} +d2 = uniform (words "Uma frase de cinco palavras") +\end{code} +isto é +\begin{Verbatim}[fontsize=\small] + "Uma" 20.0% + "cinco" 20.0% + "de" 20.0% + "frase" 20.0% +"palavras" 20.0% +\end{Verbatim} +distribuição \emph{normais}, eg.\ +\begin{code} +d3 = normal [10..20] +\end{code} +etc.\footnote{Para mais detalhes ver o código fonte de \Probability, que é uma adaptação da +biblioteca \PFP\ (``Probabilistic Functional Programming''). Para quem quiser saber mais +recomenda-se a leitura do artigo \cite{EK06}.} +|Dist| forma um \textbf{mónade} cuja unidade é |return a = D [(a,1)]| e cuja composição de Kleisli +é (simplificando a notação) +\begin{spec} + ((kcomp f g)) a = [(y,q*p) | (x,p) <- g a, (y,q) <- f x] +\end{spec} +em que |g: A -> Dist B| e |f: B -> Dist C| são funções \textbf{monádicas} que representam +\emph{computações probabilísticas}. + +Este mónade é adequado à resolução de problemas de \emph{probabilidades e estatística} usando programação funcional, de forma elegante e como caso particular da programação monádica. + +\section{Código fornecido}\label{sec:codigo} + +\subsection*{Problema 1} +Alguns testes para se validar a solução encontrada: +\begin{code} +test a b c = map (fbl a b c) x == map (f a b c) x where x = [1..20] + +test1 = test 1 2 3 +test2 = test (-2) 1 5 +\end{code} + +\subsection*{Problema 2} + +\textbf{Verificação}: a árvore de tipo \Exp\ gerada por +\begin{code} +acm_tree = tax acm_ccs +\end{code} +deverá verificar as propriedades seguintes: +\begin{itemize} +\item |expDepth acm_tree == 7| (profundidade da árvore); +\item |length (expOps acm_tree) == 432| (número de nós da árvore); +\item |length (expLeaves acm_tree) == 1682| (número de folhas da árvore).\footnote{Quer dizer, o número total de nodos e folhas é |2114|, o número de linhas do texto dado.} +\end{itemize} +O resultado final +\begin{code} +acm_xls = post acm_tree +\end{code} +não deverá ter tamanho inferior ao total de nodos e folhas da árvore. + +\subsection*{Problema 3} +Função para visualização em \svg: +\begin{code} +drawSq x = picd'' [ Svg.scale 0.44 (0,0) (x >>= sq2svg) ] +sq2svg (p,l) = (color "#67AB9F" . polyg) [ p, p .+ (0,l), p .+ (l,l), p .+ (l,0) ] +\end{code} +Para efeitos de temporização: +\begin{code} +await = threadDelay 1000000 +\end{code} + +\subsection*{Problema 4} +Rankings: +\begin{code} +rankings = [ + ("Argentina",4.8), + ("Australia",4.0), + ("Belgium",5.0), + ("Brazil",5.0), + ("Cameroon",4.0), + ("Canada",4.0), + ("Costa Rica",4.1), + ("Croatia",4.4), + ("Denmark",4.5), + ("Ecuador",4.0), + ("England",4.7), + ("France",4.8), + ("Germany",4.5), + ("Ghana",3.8), + ("Iran",4.2), + ("Japan",4.2), + ("Korea Republic",4.2), + ("Mexico",4.5), + ("Morocco",4.2), + ("Netherlands",4.6), + ("Poland",4.2), + ("Portugal",4.6), + ("Qatar",3.9), + ("Saudi Arabia",3.9), + ("Senegal",4.3), + ("Serbia",4.2), + ("Spain",4.7), + ("Switzerland",4.4), + ("Tunisia",4.1), + ("USA",4.4), + ("Uruguay",4.5), + ("Wales",4.3)] +\end{code} +Geração dos jogos da fase de grupos: +\begin{code} +generateMatches = pairup +\end{code} +Preparação da árvore do ``mata-mata'': +\begin{code} +arrangement = (>>= swapTeams) . chunksOf 4 where + swapTeams [[a1,a2],[b1,b2],[c1,c2],[d1,d2]] = [a1,b2,c1,d2,b1,a2,d1,c2] +\end{code} +Função proposta para se obter o \emph{ranking} de cada equipa: +\begin{code} +rank x = 4 ** (pap rankings x - 3.8) +\end{code} +Critério para a simulação não probabilística dos jogos da fase de grupos: +\begin{code} +gsCriteria = s . split (id >< id) (rank >< rank) where + s ((s1, s2), (r1, r2)) = let d = r1 - r2 in + if d > 0.5 then Just s1 + else if d < -0.5 then Just s2 + else Nothing +\end{code} +Critério para a simulação não probabilística dos jogos do mata-mata: +\begin{code} +koCriteria = s . split (id >< id) (rank >< rank) where + s ((s1, s2), (r1, r2)) = let d = r1 - r2 in + if d == 0 then s1 + else if d > 0 then s1 else s2 +\end{code} +Critério para a simulação probabilística dos jogos da fase de grupos: +\begin{code} +pgsCriteria = s . split (id >< id) (rank >< rank) where + s ((s1, s2), (r1, r2)) = + if abs(r1-r2) > 0.5 then fmap Just (pkoCriteria(s1,s2)) else f (s1,s2) + f = D . ((Nothing,0.5):) . map (Just><(/2)) . unD . pkoCriteria +\end{code} +Critério para a simulação probabilística dos jogos do mata-mata: +\begin{code} +pkoCriteria (e1, e2) = D [(e1, 1 - r2 / (r1 + r2)), (e2, 1 - r1 / (r1 + r2))] where + r1 = rank e1 + r2 = rank e2 +\end{code} +Versão probabilística da simulação da fase de grupos:\footnote{Faz-se ``trimming'' das distribuições para reduzir o tempo de simulação.} +\begin{code} +psimulateGroupStage = trim . map (pgroupWinners pgsCriteria) +trim = top 5 . sequence . map (filterP.norm) where + filterP (D x) = D [(a,p) | (a,p) <- x, p > 0.0001 ] + top n = vec2Dist . take n . reverse . presort snd . unD + vec2Dist x = D [ (a,n/t) | (a,n) <- x ] where t = sum(map snd x) +\end{code} +Versão mais eficiente da |pwinner| dada no texto principal, para diminuir o tempo de cada +simulação: +\begin{code} +pwinner :: Dist Team +pwinner = mbin f x >>= pknockoutStage where + f(x,y) = initKnockoutStage(x++y) + x = split (g . take 4) (g . drop 4) groups + g = psimulateGroupStage . genGroupStageMatches +\end{code} +Auxiliares: +\begin{code} +best n = map fst . take n . reverse . presort p2 + +consolidate :: (Num d, Eq d, Eq b) => [(b, d)] -> [(b, d)] +consolidate = map (id> [(a, b)] -> [(a, [b])] +collect x = nub [ k |-> [ d' | (k',d') <- x , k'==k ] | (k,d) <- x ] +\end{code} +Função binária monádica |f|: +\begin{code} +mmbin :: Monad m => ((a, b) -> m c) -> (m a, m b) -> m c +mmbin f (a,b) = do { x <- a ; y <- b ; f(x,y) } +\end{code} +Monadificação de uma função binária |f|: +\begin{code} +mbin :: Monad m => ((a, b) -> c) -> (m a, m b) -> m c +mbin = mmbin . (return.) +\end{code} +Outras funções que podem ser úteis: +\begin{code} +(f `is` v) x = (f x) == v + +rcons(x,a) = x++[a] +\end{code} + +%----------------- Soluções dos alunos -----------------------------------------% + +\section{Soluções dos alunos}\label{sec:resolucao} +Os alunos devem colocar neste anexo as suas soluções para os exercícios +propostos, de acordo com o ``layout'' que se fornece. Não podem ser +alterados os nomes ou tipos das funções dadas, mas pode ser adicionado +texto, diagramas e/ou outras funções auxiliares que sejam necessárias. + +Valoriza-se a escrita de \emph{pouco} código que corresponda a soluções +simples e elegantes. + +\subsection*{Problema 1} +Funções auxiliares pedidas: +\begin{code} +loop = undefined +initial = undefined +wrap = p2 +\end{code} + +\subsection*{Problema 2} +Gene de |tax|: +\begin{code} +gene = undefined +\end{code} +Função de pós-processamento: +\begin{code} +post = undefined +\end{code} + +\subsection*{Problema 3} +\begin{code} +squares = anaRose gsq + +gsq = undefined + +rose2List = cataRose gr2l + +gr2l = undefined + +carpets = undefined + +present = undefined +\end{code} + +\subsection*{Problema 4} +\subsubsection*{Versão não probabilística} +Gene de |consolidate'|: +\begin{code} +cgene = undefined +\end{code} +Geração dos jogos da fase de grupos: +\begin{code} +pairup = undefined + +matchResult = undefined + +glt = undefined +\end{code} +\subsubsection*{Versão probabilística} +\begin{code} +pinitKnockoutStage = undefined + +pgroupWinners :: (Match -> Dist (Maybe Team)) -> [Match] -> Dist [Team] +pgroupWinners = undefined + +pmatchResult = undefined +\end{code} + +%----------------- Índice remissivo (exige makeindex) -------------------------% + +\printindex + +%----------------- Bibliografia (exige bibtex) --------------------------------% + +\bibliographystyle{plain} +\bibliography{cp2223t} + +%----------------- Fim do documento -------------------------------------------% + +\end{document} diff --git a/cp2223t/cp2223t.pdf b/cp2223t/cp2223t.pdf new file mode 100644 index 0000000..76001af Binary files /dev/null and b/cp2223t/cp2223t.pdf differ diff --git a/cp2223t/cp2223t.sty b/cp2223t/cp2223t.sty new file mode 100644 index 0000000..f66db59 --- /dev/null +++ b/cp2223t/cp2223t.sty @@ -0,0 +1,242 @@ +%================= Standard packages ==========================================% +\usepackage{fleqn} +\usepackage[portuguese]{babel} +\usepackage[utf8]{inputenc} +\usepackage{mathptmx} % math font +\usepackage{tabularx} +%----------------- testing ----------------------------------------------------% +\newtheorem{teste}{\underline{Teste unitário}}% +\newtheorem{propriedade}{\relax{Propriedade [\href{https://hackage.haskell.org/package/QuickCheck}{QuickCheck}]}}% +%----------------- verbatim ---------------------------------------------------% +\usepackage{fancyvrb} +%----------------- Using xy ---------------------------------------------------% +\usepackage[all]{xy} +\def\larrow#1#2#3{\xymatrix{ #3 & #1 \ar[l]_-{#2} }} +\def\rarrow#1#2#3{\xymatrix{ #1 \ar[r]^-{#2} & #3 }} +\def\u{u} % unidade de um mónade +\def\fun#1{{\sf #1}\index{Functor}} +%----------------- Colors -----------------------------------------------------% +\usepackage{color} +\usepackage[dvipsnames]{xcolor} +\definecolor{url}{HTML}{0F80FF} +\hypersetup{ + linkcolor=url, + citecolor=url, + urlcolor=url +} + +\definecolor{codegreen}{rgb}{0,0.6,0} +\definecolor{codegray}{rgb}{0.5,0.5,0.5} +\definecolor{codepurple}{rgb}{0.58,0,0.82} +\definecolor{backcolour}{HTML}{fcf4e8} + +%----------------- Listings ---------------------------------------------------% +\usepackage{listings} +\lstset{ + backgroundcolor=\color{backcolour}, + commentstyle=\color{codegreen}, + keywordstyle=\color{magenta}, + numberstyle=\tiny\color{codegray}, + stringstyle=\color{codepurple}, + basicstyle=\ttfamily\footnotesize, + breakatwhitespace=false, + breaklines=true, + captionpos=b, + keepspaces=true, + numbers=left, + numbersep=5pt, + showspaces=false, + showstringspaces=false, + showtabs=false, + tabsize=2 +} +%----------------- tikz -------------------------------------------------------% +\usepackage{tikz} +\usepackage{tikz-qtree} +\usetikzlibrary{trees} +%----------------- anamorphism's brackets -------------------------------------% +\newcommand{\lanabracket}{\mathopen{[\!\!\!\:(}} +\newcommand{\ranabracket}{\mathopen{)\!\!\!\:]}} + +%---------------- boxes -------------------------------------------------------% +\usepackage[many]{tcolorbox} +\tcbset{ + sharp corners, + colback = white, + before skip = 0.5cm, + after skip = 0.5cm, + breakable +} +\newtcolorbox{alert}{ + colback = Dandelion!7.5, + enhanced, + colframe = Dandelion!7.5, + borderline west = {4pt}{0pt}{Dandelion!50}, + breakable +} +\newtcolorbox{bquote}{ + colback = url!5, + enhanced, + colframe = url!5, + borderline west = {4pt}{0pt}{RoyalBlue!50}, + breakable +} +\tcbset{ + sharp corners, + colback = white, + before skip = 0.5cm, + after skip = 0.5cm, + boxsep=0mm, + breakable +} +\newtcolorbox{normalbox}{ + colback = white, + enhanced, + colframe = black, + boxrule = 0.5pt, + breakable +} + +%----------------- Using makeidx ----------------------------------------------% +\usepackage{makeidx} +\def\tree#1{\href{https://en.wikipedia.org/wiki/Tree_(data_structure)}{#1}\index{Árvore (Estrutura de Dados)}} +\def\dijkstra#1{\href{https://en.wikipedia.org/wiki/Edsger_W._Dijkstra}{#1}\index{Edsger W. Dijkstra}} +\def\shuntingYard#1{\href{https://en.wikipedia.org/wiki/Shunting_yard_algorithm}{#1}\index{Shunting Yard}} +\def\sierpCarpet#1{\href{https://en.wikipedia.org/wiki/Sierpinski_carpet}{#1}\index{Fractal!Tapete de Sierpinski}} +\def\sierpTriangle#1{\href{http://en.wikipedia.org/wiki/Sierpinski_triangle}{#1}\index{Fractal!Tri\^angulo de Sierpinski}} +\def\fractal{\href{http://pt.wikipedia.org/wiki/Fractal}{fractal}\index{Fractal}} +\def\svg{\href{https://svgwg.org/svg2-draft/}{SVG}\index{SVG (Scalable Vector Graphics)}} +\def\xml{\href{https://en.wikipedia.org/wiki/XML}{XML}\index{XML (Extensible Markup Language)}} +\def\DSL{\href{https://www.researchgate.net/publication/254462947_Experience_report_A_do-it-yourself_high-assurance_compiler}{DSL}\index{DSL (linguaguem específica para domínio)}} +\def\DL{\href{https://roberttlange.github.io/posts/2019/08/blog-post-6/}{Deep Learning}\index{Deep Learning)}} +\def\Fsharp{\href{https://fsharp.org}{F\#}\index{F\#}} +\def\catalan#1{\href{https://en.wikipedia.org/wiki/Catalan_number}{#1}\index{Números de Catalan}} +\def\bezier#1{\href{https://en.wikipedia.org/wiki/B\%C3\%A9zier_curve}{#1}\index{Curvas de Bézier}} +\def\Nat{\href{https://haslab.github.io/CP/Material/Nat.hs}{Nat}\index{Cálculo de Programas!Material Pedagógico!Nat.hs}} +\def\Cp{\href{https://haslab.github.io/CP/Material/Cp.hs}{Cp}\index{Cálculo de Programas!Material Pedagógico!Cp.hs}} +%------- +\def\random#1{\href{https://hackage.haskell.org/package/random-1.1/docs/System-Random.html}{#1}\index{Haskell!Monad!Random}} +\def\truchet#1{\href{https://en.wikipedia.org/wiki/Truchet_tiles}{#1}\index{Mosaico de Truchet}} +\def\BTree{\href{https://haslab.github.io/CP/Material/BTree.hs}{BTree}\index{Cálculo de Programas!Material Pedagógico!BTree.hs}} +\def\Bibtex{\href{http://www.bibtex.org/}{Bib\TeX}\index{\LaTeX!\texttt{bibtex}}} +\def\Exp{\href{https://haslab.github.io/CP/Material/Exp.hs}{Exp}\index{Cálculo de Programas!Material Pedagógico!Exp.hs}} +\def\Rose{\href{https://haslab.github.io/CP/2223/Material/Rose.hs}{Rose Tree}\index{Cálculo de Programas!Material Pedagógico!Rose.hs}} +\def\GHCi{\ghci{GHCi}} +\def\IO{IO\index{Mónade!{IO}}} +\def\Dist{Dist\index{Mónade!{Dist}}} +\def\listM#1{#1\index{Mónade!Listas}} +\def\Html{\textsc{Html}\index{HTML}} +\def\LTree{\href{https://haslab.github.io/CP/Material/LTree.hs}{\textit{LTree}}\index{Cálculo de Programas!Material Pedagógico!LTree.hs}} +\def\FTree{\href{https://haslab.github.io/CP/Material/FTree.hs}{\textit{FTree}}\index{Cálculo de Programas!Material Pedagógico!FTree.hs}} +\def\mTree#1{\href{https://en.wikipedia.org/wiki/Merkle_tree}{#1}\index{Merkle tree}} +\def\MerkleTree{\mTree{Merkle tree}} +\def\Latex{\href{http://www.tug.org/index.html}{\LaTeX}\index{\LaTeX}} +\def\LhsToTeX{\lhstotex{lhs2tex}} +\def\List{\href{http://wiki.di.uminho.pt/twiki/pub/Education/CP/MaterialPedagogico/List.hs}{List}\index{Cálculo de Programas!Material Pedagógico!List.hs}} +\def\Makeindex{\href{https://www.ctan.org/pkg/makeindex}{\texttt{makeindex}}\index{\LaTeX!\texttt{makeindex}}} +\def\MaterialPedagogico{\material{material pedagógico}} +\def\blockchain{\href{https://pt.wikipedia.org/wiki/Blockchain}{blockchain}\index{Blockchain}} +\def\PFP{\href{http://web.engr.oregonstate.edu/~erwig/pfp}{PHP}\index{Haskell!Biblioteca!PFP}} +\def\Probability{\href{http://wiki.di.uminho.pt/twiki/bin/view/Education/CP/MaterialPedagogico}{Probability}\index{Haskell!Biblioteca!Probability}} +\def\QuickCheck{\href{https://wiki.haskell.org/Introduction_to_QuickCheck1}{QuickCheck}\index{Haskell!QuickCheck}} +\def\Unix{\href{https://en.wikipedia.org/wiki/Unix}{Unix}\index{Unix}} +\def\R{I\!\!R\index{Números reais ($I\!\!R$)}} +\def\TUG{TUG\index{TeX!TeX Users Group (TUG)}} +\def\alt#1#2{\mathopen{[}#1 , #2\mathclose{]}\index{Combinador ``pointfree''!\emph{either}}} % "either" is reserved... +\def\ap#1#2{#1\,#2} +\def\bang{{!}\index{Função!\emph{bang}}} +\def\btree#1{\href{https://en.wikipedia.org/wiki/B-tree}{#1}\index{B-tree}} +\def\B{\mathbb{B}\index{Booleans}} +\def\CP{\href{https://haslab.github.io/CP/}{Cálculo de Programas}\index{Cálculo de Programas}} +\def\N{\mathbb{N}\index{Números naturais ($I\!\!N$)}} +\def\Q{\mathbb{Q}\index{Racionais}} +\def\cata#1{\mathopen{\llparenthesis}#1\mathclose{\rrparenthesis}\index{Combinador ``pointfree''!\emph{cata}}} +\def\cataList#1{\mathopen{\llparenthesis}#1\mathclose{\rrparenthesis}\index{Combinador ``pointfree''!\emph{cata}!Listas}} +\def\anaList#1{\lanabracket#1\ranabracket\index{Combinador ``pointfree''!\emph{ana}!Listas}} +\def\cataNat#1{\mathopen{\llparenthesis}#1\mathclose{\rrparenthesis}\index{Combinador ``pointfree''!\emph{cata}!Naturais}} +\def\cp#1{\href{https://haslab.github.io/CP/}{#1}\index{Cálculo de Programas}} +\def\dium{\htmladdnormallink{Departamento de Informática}{http://www.di.uminho.pt/}\index{U.Minho!Departamento de Informática}} +\def\gloss#1{\href{https://hackage.haskell.org/package/gloss-1.13.1.1/docs/Graphics-Gloss.html}{#1}\index{Haskell!Gloss}} +\def\graphviz#1{\href{https://www.graphviz.org/}{#1}\index{Graphviz}} +\def\pd#1{\href{https://en.wikipedia.org/wiki/Dynamic_programming}{#1}\index{Programação!dinâmica}} +\def\stack#1{\href{https://docs.haskellstack.org/en/stable/README/}{#1}\index{Haskell!Stack}} +\def\xfig#1{\href{https://sourceforge.net/projects/mcj/}{#1}\index{X-fig}} +\def\file#1{\texttt{#1}\index{Ficheiro!\texttt{#1}}} +\def\ghci#1{\href{https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html}{#1}\index{Haskell!interpretador!GHCi}} +\def\graphviz#1{\href{http://graphviz.org/}{#1}\index{Graphviz}} +\def\webgraphviz#1{\href{http://www.webgraphviz.com/}{#1}\index{Graphviz!WebGraphviz}} +\def\gcc#1{\href{https://www.gnu.org/software/gcc/}{#1}\index{GCC}} +\def\pda#1{\href{https://en.wikipedia.org/wiki/Stack_machine\#Simple_compilers}{#1}\index{Stack machine}} +\def\haskell#1{\href{http://www.haskell.org}{#1}\index{Haskell}} +\def\haskellf#1{\texttt{#1}\index{Função!\texttt{#1}}} +\def\hcata{cata\index{Combinador ``pointfree''!\emph{cata}}} +\def\iso{\mathbin{\cong}\index{Relação de isomorfismo}} +\def\kons#1{\underline{#1}\index{Combinador ``pointfree''!função constante}} +\def\length{\mathit{length}\index{Função!\emph{length}}} +\def\lhaskell#1{#1\index{Haskell!Literate Haskell}} +\def\lhstotex#1{\href{https://hackage.haskell.org/package/lhs2tex}{#1}\index{\LaTeX!\texttt{lhs2TeX}}} +\def\litp#1{\href{http://www.literateprogramming.com}{#1}\index{Programação!literária}} +\def\lsystem#1{\href{https://en.wikipedia.org/wiki/L-system}{#1}\index{L-system}} +\def\map#1{\mathsf{map}\ #1\index{Função!\emph{map}}} +\def\for#1#2{\mathsf{for}\ #1 #2\index{Função!\emph{for}}} +\def\material#1{\href{https://haslab.github.io/CP/Material/}{#1}\index{Cálculo de Programas!Material Pedagógico}} +\def\p#1{\pi_{#1}\index{Função!$\pi_#1$}} +\def\ana#1{\lanabracket#1\ranabracket\index{Combinador ``pointfree''!\emph{ana}}} +\def\split#1#2{\mathopen{\langle}#1 , #2\mathclose{\rangle}\index{Combinador ``pointfree''!\emph{split}}} % +\def\succ#1{\mathsf{succ}\ #1\index{Função!\emph{succ}}} +\def\taylor#1{\href{https://en.wikipedia.org/wiki/Taylor_series}{#1}\index{Taylor series!Maclaurin series}} +\def\texcmd#1{\texttt{#1}\index{\LaTeX!macro!\texttt{#1}}} +\def\trans#1{\overline{#1\rule{0pt}{.6em}}\index{Combinador ``pointfree''!transposição}} +\def\uncurry #1{\widehat{#1}\index{Função!\emph{uncurry}}} +\def\wc#1{\href{http://pubs.opengroup.org/onlinepubs/9699919799/utilities/wc.html}{#1}\index{Unix shell!wc}} +\def\xypic#1{\textsc{#1}\index{\LaTeX!pacote!XY-pic}} +%----------------- Extracted from jnobasics.sty -------------------------------% +\long\def\pdfout#1{\relax} +\def\mcond#1#2#3{#1 \rightarrow #2 , #3} +\newenvironment{lcbr}{\left\{\begin{array}{l}}{\end{array}\right.} +\newenvironment{calculation}{\begin{eqnarray*}&&}{\end{eqnarray*}} +\def\eg{\emph{eg.}} +\def\esimo#1{#1${.\kern-.1em}^{\super{o}}$} +\def\esima#1{#1${.\kern-.1em}^{\super{a}}$} +\def\super#1{\mbox{{\scriptsize #1}}} +\def\comp{\mathbin{\cdot}} +\def\implied{\mathbin\Leftarrow} +\def\deff{\stackrel{\rm def}{=}} % Function definition symbol +\def\kcomp{\mathbin{\bullet}} +\def\conj#1#2{\mathopen{\langle} #1, #2 \mathclose{\rangle}} +\def\start{&&} +\def\more{\\&&} +\def\qed{\\&\Box&} +\def\just#1#2{\\ & \rule{2em}{0pt} \{ \mbox{\rule[-.7em]{0pt}{1.8em} \small #2 \/} \} \nonumber\\ && } +%----------------- Cross references -------------------------------------------% +\newlabel{eq:fokkinga}{{3.95}{112}{The mutual-recursion law}{section.3.17}{}} +%----------------- Importing/modifying isolatin1 ------------------------------% +%\usepackage{isolatin1} +%\catcode181=13 \def^^b5{\mu} % 181, '265, "b5 +%\@ifundefined{lguill}{\def^^ab{``}}{\def^^ab{\lguill}} +%\@ifundefined{rguill}{\def^^bb{''}}{\def^^bb{\rguill}} +%\catcode186=13 \def^^ba{${\kern-.1em}^{\mbox{\scriptsize o}}$} % 186, '272, "ba +%\catcode183=13 \def^^b7{\comp} % 183, '267, "b7 +%----------------- WWW interfacing desabled -----------------------------------% +\let\pisca=\relax +\def\quoteId#1#2{\textsl{#1}} +\def\quoteUrl#1#2{\texttt{#2}} +\let\htmladdnormallink=\quoteId % HTML links disabled by default +%----------------- Shortcuts --------------------------------------------------% +\def\Haskell{\haskell{Haskell}} +\def\Graphviz{\graphviz{Graphviz}} +\def\WebGraphviz{\webgraphviz{WebGraphviz}} +\def\LSystems{\lsystem{L-Systems}} +\def\LSystem{\lsystem{L-System}} +%----------------- Date -------------------------------------------------------% +\def\mydate{ +\ifcase\month\or + Janeiro\or Fevereiro\or Março\or Abril\or Maio\or Junho\or Julho\or Agosto\or Setembro\or Outubro\or Novembro\or Dezembro\fi \ de \number\year +} +%----------------- Problemas ----------------------------------------------------% +\newcount\pn \pn=1 % Problem number +%\def\Problema{\section*{Problema \number\pn}\global\advance\pn by 1} +\def\Problema{\section*{Problema \number\pn}\global\advance\pn by 1} + +%----------------- fim ----------------------------------------------------------% + diff --git a/cp2223t/cp2223t_media/.DS_Store b/cp2223t/cp2223t_media/.DS_Store new file mode 100644 index 0000000..36d2910 Binary files /dev/null and b/cp2223t/cp2223t_media/.DS_Store differ diff --git a/cp2223t/cp2223t_media/acmccs.png b/cp2223t/cp2223t_media/acmccs.png new file mode 100644 index 0000000..f0584a1 Binary files /dev/null and b/cp2223t/cp2223t_media/acmccs.png differ diff --git a/cp2223t/cp2223t_media/acmccsX.jpg b/cp2223t/cp2223t_media/acmccsX.jpg new file mode 100644 index 0000000..99d8767 Binary files /dev/null and b/cp2223t/cp2223t_media/acmccsX.jpg differ diff --git a/cp2223t/cp2223t_media/tapete1.png b/cp2223t/cp2223t_media/tapete1.png new file mode 100644 index 0000000..d61afbe Binary files /dev/null and b/cp2223t/cp2223t_media/tapete1.png differ diff --git a/cp2223t/cp2223t_media/tapete2.png b/cp2223t/cp2223t_media/tapete2.png new file mode 100644 index 0000000..ffed617 Binary files /dev/null and b/cp2223t/cp2223t_media/tapete2.png differ diff --git a/cp2223t/cp2223t_media/tapete3.png b/cp2223t/cp2223t_media/tapete3.png new file mode 100644 index 0000000..72deda6 Binary files /dev/null and b/cp2223t/cp2223t_media/tapete3.png differ diff --git a/cp2223t/cp2223t_media/tapete4.png b/cp2223t/cp2223t_media/tapete4.png new file mode 100644 index 0000000..1cac01d Binary files /dev/null and b/cp2223t/cp2223t_media/tapete4.png differ diff --git a/cp2223t/cp2223t_media/tapete5.png b/cp2223t/cp2223t_media/tapete5.png new file mode 100644 index 0000000..04f420b Binary files /dev/null and b/cp2223t/cp2223t_media/tapete5.png differ diff --git a/cp2223t/cp2223t_media/tapete_ex.png b/cp2223t/cp2223t_media/tapete_ex.png new file mode 100644 index 0000000..81e16ea Binary files /dev/null and b/cp2223t/cp2223t_media/tapete_ex.png differ diff --git a/cp2223t/cp2223t_media/wcup2022.png b/cp2223t/cp2223t_media/wcup2022.png new file mode 100644 index 0000000..a6db361 Binary files /dev/null and b/cp2223t/cp2223t_media/wcup2022.png differ