18

This talk was made for CocoaHeads Kyiv #13 which took place Dec 16 2017. December 16, 2017

## Transcript

2. @kievfprog

3. struct Team {}
struct Tournament {}
func runTournament(_ tournament: Tournament) -> Team {
let teams = tournament.joinTeams();
let groups = tournament.emitGroups(teams);
let groupResults = groups.map(tournament.runGroup);
let brackets = tournament.buildBracket(groupResults);
NSLog("%@", brackets);
let winner = tournament.eliminate(brackets);
return winner;
}

→ laziness (non-strict eval, call-by-need)
→ pure, referentially-transparent functions
→ enables equational reasoning

5. Laziness is Awesome

6. Why FP Matters, John Hughes 1990:
Modularity
within eps (a:b:rest)
| abs(a-b) <= eps = b
| otherwise = within eps (b:rest)
easydiff f x h
= (f(x+h) − f x)/h
differentiate h0 f x
= map (easydiff f x) (repeat (/2) h0)
within eps (differentiate h0 f x)

7. Graphs
data Node
= A | B | C | D | E | F | G | H | I | J | K | L | M | N
deriving (Show, Enum, Bounded, Eq)
edge from to
= case (from, to) of
(A, B) -> Just 4
(A, E) -> Just 6
(A, D) -> Just 7
-- ...

8. reachable :: Node -> [Node]
reachable from
= catMaybes [fmap (const to) (edge from to) | to <- enum]

9. type Trace = [Node]
data Path = Path Int Trace deriving (Show, Eq)
instance Ord Path where (Path a _) <= (Path b _) = a <= b

10. Build the tree of all possible paths!
bruteforce :: Int -> Trace -> Node -> Node -> Tree Path
bruteforce cost trace to from
= Tree (Path cost trace') (map build (reachable from))
where
trace' = from:trace
build = bruteforce (cost + fromJust (edge from n)) trace' to

11. Shortest path is easy, right?
path == minimum (last (Tree.levels (bruteforce N A)))

12. Branch and Bound
data Bound a
= Bound a
| Unknown
deriving (Show, Eq)
-- | Unlike Maybe's Ord this one steers away from Unknown
instance (Eq a, Ord a) => Ord (Bound a) where
-- ...

13. btw: cost must grow monotonically as you
go down

14. minbranch :: Ord a => Tree a -> Bound a
minbranch = minbranch' Unknown
minbranch' :: Ord a => Bound a -> Tree a -> Bound a
minbranch' bound (Tree.Node root subs) =
case subs of
[] -> Bound root
_ -> foldr f bound subs
where
f [email protected](Tree.Node r _) b
| Bound r <= b = branch' b sub
| otherwise = b -- **prune !!!**

15. Ok, back to Dota2!

16. struct Team {}
struct Tournament {}
func runTournament(_ tournament: Tournament) -> Team {
let teams = tournament.joinTeams();
let groups = tournament.emitGroups(teams);
let groupResults = groups.map(tournament.runGroup);
let brackets = tournament.buildBracket(groupResults);
NSLog("%@", brackets);
let winner = tournament.eliminate(brackets);
return winner;
}

17. a slight syntax conversion
data Team
data Tournament
runTournament (tournament :: Tournament) =
let teams = joinTeams tournament
groups = emitGroups tournament teams
groupResults = map (runGroup tournament) teams
brackets = buildBracket tournament groupResults
_ = nsLog brackets
winner = eliminate tournament brackets
in (winner :: Team)

18. nsLog will never be executed!
data Team
data Tournament
runTournament (tournament :: Tournament) =
let teams = joinTeams tournament
groups = emitGroups tournament teams
groupResults = map (runGroup tournament) teams
brackets = buildBracket tournament groupResults
_ = nsLog brackets
winner = eliminate tournament brackets
in (winner :: Team)

19. let's bring back data dependencies
data Team
data Tournament
runTournament (τ :: Tournament) =
joinTeams τ
!
(\teams ->
emitGroups τ teams
!
(\groups ->
map (runGroup τ) teams
!
(\groupResults ->
buildBracket τ groupResults (\brackets ->
nsLog brackets
!
(\_ ->
eliminate τ brackets (\winner ->
winner))))))

20. what type should have?
perhaps
!
:: a -> (a -> b) -> b

21. what type should have?
sanity check:
nsLog :: Show a => a -> Int
nsLog x = callCFunction "NSLog" "%@" x
test =
let action = nsLog "hello"
in x
!
(\_ -> x)
* not referentially transparent!

22. let's come up with a type for effects
data Effects a = {- constructor for a computation
that returns a value of type `a' -}
!
:: Effects a -> (a -> Effects b) -> Effects b
!
a f = {- perform computation `a',
then feed its result to `f'
which will give a computation `b' -}
unit :: a -> Effects a
unit a = {- make `a' pretend to be a computation -}

23. data Team
data Tournament
runTournament :: Tournament -> Effects Team
runTournament τ =
joinTeams τ
!
(\teams ->
emitGroups τ teams
!
(\groups ->
map (runGroup τ) groups (\groupResults ->
buildBracket τ groupResults (\brackets ->
nsLog brackets
!
(\_ ->
eliminate τ brackets (\winner ->
unit winner))))))

24. Sugar: do
runTournament τ = do
teams <- joinTeams τ
groups <- emitGroups τ
groupResults <- mapM (runGroup τ) groups
brackets <- buildBracket τ groupResults
nsLog brackets
winner <- eliminate τ brackets
unit winner

25. a monad, where = >>=
class Functor f where
fmap :: (a -> b) -> f a -> f b
class Functor m => Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
also, m has kind * -> *: HKT!

mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f [] = return []
mapM f (x:xs)
= f x >>= \x' ->
mapM f xs >>= \xs' ->
return (x':xs')

27. what about the rest of the functions?
runTournament τ = do
teams <- joinTeams τ
groups <- emitGroups τ
groupResults <- mapM (runGroup τ) groups
brackets <- buildBracket τ groupResults
nsLog brackets
winner <- eliminate τ brackets
unit winner

28. meh
joinTeams = Ѕ༼ ϑ ༽ꙷ
emitGroups = Ѕ༼ ϑ ༽ꙷ
runGroup = Ѕ༼ ϑ ༽ꙷ
buildBracket = Ѕ༼ ϑ ༽ꙷ
eliminate = Ѕ༼ ϑ ༽ꙷ

29. types ﬁrst
data Group
data GResult
data Team
data Bracket
data ElimResult

30. types ﬁrst
data TournamentOps next
= JoinTeams ([Team] -> next)
| EmitGroups [Team] ([Group] -> next)
| RunGroup Group (GResult -> next)
| BuildBracket [GResult] (Bracket -> next)
| Eliminate Bracket (ElimResult -> next)

∀ f:Functor you have a simplest way to
data Free f a
= Return a
| Free (f (Free f a))

32. a free functor
instance Functor f => Functor (Free f) where
fmap f x = case x of
Return a -> Return (f a)
Free as -> Free (fmap (fmap f) as)

33. and a free monad for every free functor
instance Functor f => Monad (Free f) where
return = Return
(>>=) :: Free f a -> (a -> Free f b) -> Free f b
x >>= f = case x of
Return a -> f a
Free as -> Free (fmap (>>= f) as)

34. lifting to Free
liftF :: Functor f => f a -> Free f a
liftF = Free . fmap return
act x = liftF . flip x () -- `act' for action
fun0 x = liftF (x id)
fun1 x = liftF . flip x id

joinTeams = fun0 JoinTeams
emitGroups = fun1 EmitGroups
runGroup = fun1 RunGroup
buildBracket = fun1 BuildBracket
eliminate = fun1 Eliminate

36. we have a program tree
now!

37. let's interpret it
evalDemo :: Free Tournament ElimResult -> ElimResult
evalDemo program = case program of
Return x ->
x
Free (JoinTeams f) ->
evalDemo (f mkTeam)
Free (EmitGroups a f) ->
evalDemo (f mkSomeGroup)
Free (RunGroup (Group (w:r:_)) f) ->
evalDemo (f (GResult w r))
Free (BuildBracket a f) ->
evalDemo (f bracket3Demo)
Free (Eliminate a f) ->
evalDemo (f (Winner (Team 1)))

38. https://gist.github.com/proger/2961ca8e84c2b9637f576b449d008caf
{-# LANGUAGE NoMonomorphismRestriction,
NoImplicitPrelude,
ScopedTypeVariables,
StandaloneDeriving,
RebindableSyntax #-}

39. chatbots
data Query
data Input
data Dialog next = Ask Query (Input -> next)
bot answers program = case program of
Return x -> x
(x:xs) -> bot xs (f x)
[] -> error "lol"

40. a blast from the past
DSLs in objc era
regularExpressionWithPattern:
predicateWithFormat:
constraintsWithVisualFormat:
make.left.equalTo(superview.mas_left)

41. why do this in a strict language?
→ OCaml's LWT: https://mirage.io/wiki/tutorial-lwt
let start c =
Lwt.join [
(Time.sleep_ns (Duration.of_sec 1) >>=
fun () -> C.log c "Heads");
(Time.sleep_ns (Duration.of_sec 2) >>=
fun () -> C.log c "Tails")
] >>= fun () ->
C.log c "Finished"

42. how about a GPU DSL?

43. canny :: Float
-> Float
-> Acc (Image RGBA32)
-> (Acc (Image Float), Acc (Vector Int))
canny (constant -> low) (constant -> high)
= stage1
. nonMaximumSuppression low high
. gaussianY
. gaussianX
. toGreyscale
where
stage1 x = (x, selectStrong x)
→ accelerate

44. free monads over common types
144da39e1084d61b10ba603e5951de81

45. equational reasoning: isomophisms and
univalence

46. data Nat
= Z | Succ Nat

47. data Maybe a = Nothing
| Just a
data List a = Nil
| Cons a (List a)

48. data Fix f = Fix (f (Fix f))
data L a b = Nil | Cons a b
type List a = Fix (L a)
Nat ∼ Fix Maybe

49. data Free f a
= Return a
| Free (f (Free f a))
data Const c a = Const c
data Free (Const c) a
= Pure a
| Free (Const c)
data Either c a
= Right a
| Left c

50. Decision Trees Are Free Monads Over the
Clay Thomas

51. is all of this going to be in Swift?
→ probably not
→ but wait

52. Neural Networks
TensorFlow
PyTorch
DLVM: Modern Compiler Infrastructure for Deep
Learning Systems, dlvm.org

53. Automatic Differentiation

54. // Staged function representing f(x, w, b) = dot(x, w) + b
let f: Rep<(Float2D, Float2D, Float1D) -> Float2D> =
lambda { x, w, b in x • w + b }
// Staged function ’g’, type-inferred from ’f’
let g = lambda { x, w, b in
let linear = f[x, w, b] // staged function application
return tanh(linear)
}
// Gradient of ’g’ with respect to arguments ’w’ and ’b’
let dg = gradient(of: g, withRespectTo: (1, 2), keeping: 0)
// ’dg’ has type:
// Rep<(Float2D, Float2D, Float1D) -> (Float2D, Float2D, Float2D)>
// Call staged function on input data ’x’, ’w’ and ’b’
let (dg_dw, dg_db, result) = dg[x, w, b]