Skip to content

Instantly share code, notes, and snippets.

@LukaHorvat
LukaHorvat / Visibility.hs
Created October 29, 2015 21:59
Visibility.hs
module Visibility where
import Data.List (sortBy, minimumBy)
import Data.Ord
import Data.Maybe (mapMaybe)
import Diagrams (Diagram, P2, (#), Located)
import qualified Diagrams as Diag
import Diagrams.Backend.Rasterific (Rasterific)
import qualified Diagrams.Backend.Rasterific as Rast
import Data.Colour (Colour)
data Node = Value Int | List [Node] | Sequence [Node]
steps :: Node -> [[Int]]
steps (Value x) = [[x]]
steps (List ns) = case substeps of
[] -> []
(x : xs) -> x ++ concat (zipWith prepend lastStates xs)
where substeps = map steps ns
lastStates = scanl1 (++) $ map last substeps
prepend pref ss = map (pref ++) ss
box :: Bool -> Angle Double -> Diagram SVG
box on angle = ((square (sqrt 2) `clipTo` rotate angle pattern) <> base) # lwO 1.5
where base = square (sqrt 2) # fc (if on then peachpuff else turquoise)
chromosome :: [Bool] -> Angle Double -> Diagram SVG
chromosome list angle = hcat $ map (pad 1.1 . (`box` angle)) list
first :: Diagram SVG
first = chromosome [True, False, True] (1/8 @@ turn)
||| padX 1.3 (chromosome [True, False] (1/8 @@ turn))
@LukaHorvat
LukaHorvat / Main.hs
Created October 18, 2015 15:20
diag.hs
lns :: Diagram SVG
lns = Diag.fromOffsets [Diag.unitX # Diag.rotateBy (1/8)]
pattern :: Diagram SVG
pattern = Diag.gridCat $ replicate 64 lns
circle :: Diagram SVG
circle = Diag.circle 4 `Diag.clipBy` pattern
where circleClip = Diag.circle 4 # Diag.translate (Diag.r2 (4, 4)) # Diag.showOrigin :: Diagram SVG
@LukaHorvat
LukaHorvat / Main.hs
Created October 18, 2015 12:40
Presentation.hs
sample :: Presentation
sample =
emptyPresentation {
slides = [
Slide [
Header 1 "Genetski algoritmi",
Header 2 "Križanja"
],
Slide [
Header 2 "Sadržaj",
@LukaHorvat
LukaHorvat / MapMonad.hs
Created October 15, 2015 16:51
MapMonad.hs
import Data.Map (Map)
import qualified Data.Map as Map
instance (Ord k, Monoid k) => Applicative (Map k) where
pure = Map.singleton mempty
f <*> x = Map.fromList [(mappend fk xk, f Map.! fk $ x Map.! xk) | fk <- Map.keys f, xk <- Map.keys x]
instance (Ord k, Monoid k) => Monad (Map k) where
return = pure
m >>= f = Map.fromList $ do
{-# LANGUAGE MultiWayIf, MultiParamTypeClasses, FunctionalDependencies #-}
module AStar where
import Control.Monad.State
import Data.Set (Set)
import qualified Data.Set as Set
import PriorityQueue (PriorityQueue)
import qualified PriorityQueue as Prio
class Ord s => AStarState s m | s -> m where
@LukaHorvat
LukaHorvat / PriorityQueue.hs
Created October 13, 2015 08:54
PriorityQueue.hs
module PriorityQueue where
import Data.Map (Map)
import qualified Data.Map as Map
data Unique = U
instance Eq Unique where
U == U = False
module PriorityQueue where
import Data.Map (Map)
import qualified Data.Map as Map
data Unique = U
instance Eq Unique where
U == U = False
module Rec where
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List (nub)
data Logic = Logic :& Logic
| Logic :| Logic
| Not Logic