Related
In C# I can enable monadic composition in Linq query for a custom type by implementing extension methods for Select and SelectMany, for example:
public static Either<L, R2> Select<L, R, R2>(this Either<L, R> #this, Func<R, R2> fn) => #this.Map(fn);
public static Either<L, R2> SelectMany<L, R, R2>(this Either<L, R> #this, Func<R, Either<L, R2>> fn) => #this.FlatMap(fn);
public static Either<L, R2> SelectMany<L, R, R1, R2>(this Either<L, R> #this, Func<R, Either<L, R1>> fn, Func<R, R1, R2> select) => #this.FlatMap(a => fn(a).FlatMap(b => select(a, b).ToEither<L, R2>()));
The third extension method is what enables monadic composition in Linq query on a similar basis to the liftM functions in Haskell, for example:
Either<L, C> LiftM2(Either<L, A> m1, Either<L, B> m2, Func<A, B, C> f) {
return from a in m1
from b in m2
select Right(f(a, b));
}
My problem is however related to do achieving the outcome in F# by implementing extension methods for a custom Either type to enable monadic composition in Linq query.
Here is my definition of the Either type:
type Either<'l, 'r> =
| Left of 'l
| Right of 'r
First I added a functions for map and flatmap including custom operators for map as <!> and flatmap as >>= and =<<:
[<AutoOpen>]
module Either =
let lmap f e =
match e with
| Left(l) -> Left(f(l))
| Right(r) -> Right(r)
let rmap f e =
match e with
| Left(l) -> Left(l)
| Right(r) -> Right(f(r))
let map f e = rmap f e
let inline (<!>) e f = map f e
let inline (<!) a e = map >> constant
let lflatmap f e =
match e with
| Left(l) -> f(l)
| Right(r) -> Right(r)
let rflatmap f e =
match e with
| Left(l) -> Left(l)
| Right(r) -> f(r)
let flatmap f e = rflatmap f e
let inline (>>=) f e = flatmap f e
let inline (=<<) e f = flatmap f e
let _return r = Right(r);
let fail (l : string) = Left(l);
Then I added extension methods implementations; as I've garnered from other examples:
[<Extension>]
type EitherExtensions() =
[<Extension>]
static member inline Select(e: Either<'l, 'r>, f: 'r -> 's) = map f e
static member inline SelectMany(e: Either<'l, 'r>, f: 'r -> Either<'l, 's>) = flatmap f e
static member inline SelectMany(e: Either<'l, 'r>, f: 'r -> Either<'l, 's>, select: 'r -> 's -> 't) = (f >>= e) =<< (fun s -> Either.Right(select(e, s)))
Problem is when I try to use this to implement liftM, liftM2, ... functions it doesn't appear to pick up these extension methods; instead it uses the extension methods for System.Linq.IQueryable and not my custom extension methods for Linq e.g. SelectMany
let liftM f m1 = query {
for a in m1 do
select Right(f(a))
}
The type of liftM resolve to:
liftM:
f: a -> b,
m1: System.Linq.IQueryable<'a>
-> System.Linq.IQueryable<Either<'c, 'a>>
Instead of:
liftM:
f: a -> b,
m1: Either<'c, 'a>
-> Either<'c, 'b>
I can of course implement liftM using either pattern matching, for example:
let liftM2 f m1 m2 =
match m1, m2 with
| Right(a), Right(b) -> Right(f(a, b));
| Left(a), _ -> Left(a)
| _, Left(b) -> Left(b)
...
...or inline monadic composition, for example:
let liftM2 f m1 m2 = m1 =<< (fun a -> m2 =<< (fun b -> Right(f(a, b))))
However for both expediency and a bit knowledge I'd like to know how to achieve the same outcome as C# in F#
Is this possible?
The C# query syntax is based on a syntactic transformation as your example shows, in F# each monad instance is represented by an associated builder class which implements the required operations e.g. seq, async, query. You need to create an either builder which implements the required operations. For your example you only need a minimal implementation:
type EitherBuilder() =
member x.Bind(e, f) = flatmap f e
member x.Return(value) = _return value
member x.ReturnFrom(e) = e
let either = new EitherBuilder()
then you can use it to implement liftM:
let liftM f m1 = either {
let! a = m1
return (f a)
}
there is a file content as below("1.txt")
1.txt :
a,b
b,c
c,d
c,e
a,i
a,f
f,g
f,h
the tree structure like:
a
b i f
c g h
d e
expected:
a->b->c->d
a->b->c->e
a->i
a->f->g
a->f->h
This should work. I have skipped the part where the tree is built from reading the text file since it is simple enough.
case class Node(node: String, children: Seq[Node] = Seq()) {
override def equals(that: Any): Boolean =
that match {
case that: Node if this.node == that.node => true
case _ => false
}
override def toString = node
}
val d= Node("d")
val e = Node("e")
val g = Node("g")
val h = Node("h")
val i = Node("i")
val c = Node("c", Seq(d,e))
val f = Node("f", Seq(g, h))
val b = Node("b", Seq(c))
val a = Node("a", Seq(b,f,i))
val tree = a :: b :: c :: d :: e :: f :: g :: h :: i :: Nil
def traverse(tree: Seq[Node]): Seq[Seq[Node]] = {
import scala.annotation.tailrec
val leafNodes = tree.filter(x => x.children.isEmpty)
#tailrec
def walk(node: Node, descendants: Seq[Node] = Seq()): Seq[Node] = {
tree.find(x => x.children.contains(node)) match {
case Some(x) => walk(x, (descendants :+ node))
case None => descendants :+ node
}
}
leafNodes.map(walk(_, Seq()).reverse)
}
output:
scala> traverse(tree)
res26: Seq[Seq[Node]] = List(List(a, b, c, d), List(a, b, c, e), List(a, f, g), List(a, f, h), List(a, i))
I wrote these lines of code so as to sort the input of 5 numbers.
But when i compile and run it, then there is an error like - "int_of_string"
I do not know why this is not running. I am new to Ocaml.
let sort2 (a, b) = if a<b
then (a, b)
else (b, a)
let sort3 (a, b, c) =
let (a, b) = sort2(a, b) in
let (b, c) = sort2(b, c) in
let (a, b) = sort2(a, b) in
(a, b, c)
let sort5 (a, b, c, d, e) =
let (a, b, c) = sort3 (a, b, c) in
let (c, d, e) = sort3(c, d, e) in
let (a, b, c) = sort3 (a, b, c) in
(a, b, c, d, e)
let _ =
let a = read_int () in
let b = read_int () in
let c = read_int () in
let d = read_int () in
let e = read_int () in
let (a, b, c, d, e) = sort5 (a, b, c, d, e) in
print_int a; print_newline ();
print_int b; print_newline ();
print_int c; print_newline ();
print_int d; print_newline ();
print_int e; print_newline ()
Exception: Failure "int_of_string".
The exception happens when you type a line of input that cannot be parsed as an integer, such as an empty line. This must be what happened during your tests.
Error handling
If you want a little bit of robustness, you have to take into account that the input can be malformed. You can catch the runtime error to handle unexpected inputs:
# let maybe_read_int () = try Some (read_int ()) with Failure _ -> None;;
val maybe_read_int : unit -> int option = <fun>
The value returned from the above function is an int option.
Failure
# maybe_read_int ();;
foo
- : int option = None
Success
# maybe_read_int ();;
42
- : int option = Some 42
Reading multiple integers
You can't just use the above function like in your example because some of your variables would be bound to None (in that case, this is no better that letting the exception bubble up). Instead, you may want to read as many lines as necessary until you get 5 integers:
let rec read_n_ints n =
if (n > 0) then
match (maybe_read_int ()) with
| None -> read_n_ints n
| Some v -> v :: (read_n_ints (n - 1))
else [];;
# read_n_ints 3;;
0
foo
bar
1
2
- : int list = [0; 1; 2]
Now that you have a list of integers, you can bind them to variables using pattern matching. Note that we have to be exhaustive and consider cases that should not happen:
# match (read_n_ints 5) with
| [ a; b; c; d; e] -> (a + b + c + d + e)
| _ -> raise (Failure "Failed to read 5 integers");;
3
foo
2
10
30
ii
r
90
3
- : int = 136
I am trying to convert challenge 3 ( https://ocharles.org.uk/blog/posts/2013-08-01-getting-started-with-netwire-and-sdl.html ) from netwire 4.0 to netwire 5.0 using OpenGL. Unfortunately, the box cannot bounce. The entire code is following. It seems to me that the function velocity does not work. When the box collides with a wall, it does not bounce but stops. How do I correct my program? Thanks in advance.
{-# LANGUAGE Arrows #-}
import Graphics.Rendering.OpenGL
import Graphics.UI.GLFW
import Data.IORef
import Prelude hiding ((.))
import Control.Monad.Fix (MonadFix)
import Control.Wire
import FRP.Netwire
isKeyDown :: (Enum k, Monoid e) => k -> Wire s e IO a e
isKeyDown k = mkGen_ $ \_ -> do
s <- getKey k
return $ case s of
Press -> Right mempty
Release -> Left mempty
acceleration :: (Monoid e) => Wire s e IO a Double
acceleration = pure ( 0) . isKeyDown (CharKey 'A') . isKeyDown (CharKey 'D')
<|> pure (-0.5) . isKeyDown (CharKey 'A')
<|> pure ( 0.5) . isKeyDown (CharKey 'D')
<|> pure ( 0)
velocity :: (Monad m, HasTime t s, Monoid e) => Wire s e m (Double, Bool) Double
velocity = integralWith bounce 0
where bounce c v
| c = (-v)
| otherwise = v
collided :: (Ord a, Fractional a) => (a, a) -> a -> (a, Bool)
collided (a, b) x
| x < a = (a, True)
| x > b = (b, True)
| otherwise = (x, False)
position' :: (Monad m, HasTime t s) => Wire s e m Double (Double, Bool)
position' = integral 0 >>> (arr $ collided (-0.8, 0.8))
challenge3 :: (HasTime t s) => Wire s () IO a Double
challenge3 = proc _ -> do
rec a <- acceleration -< ()
v <- velocity -< (a, c)
(p, c) <- position' -< v
returnA -< p
s :: Double
s = 0.05
y :: Double
y = 0.0
renderPoint :: (Double, Double) -> IO ()
renderPoint (x, y) = vertex $ Vertex2 (realToFrac x :: GLfloat) (realToFrac y :: GLfloat)
generatePoints :: Double -> Double -> Double -> [(Double, Double)]
generatePoints x y s =
[ (x - s, y - s)
, (x + s, y - s)
, (x + s, y + s)
, (x - s, y + s) ]
runNetwork :: (HasTime t s) => IORef Bool -> Session IO s -> Wire s e IO a Double -> IO ()
runNetwork closedRef session wire = do
pollEvents
closed <- readIORef closedRef
if closed
then return ()
else do
(st , session') <- stepSession session
(wt', wire' ) <- stepWire wire st $ Right undefined
case wt' of
Left _ -> return ()
Right x -> do
clear [ColorBuffer]
renderPrimitive Quads $
mapM_ renderPoint $ generatePoints x y s
swapBuffers
runNetwork closedRef session' wire'
main :: IO ()
main = do
initialize
openWindow (Size 1024 512) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
closedRef <- newIORef False
windowCloseCallback $= do
writeIORef closedRef True
return True
runNetwork closedRef clockSession_ challenge3
closeWindow
By experience, I think the trick here is the fact that you technically have to bounce a few pixels before the actual collision, because if you detect it when it happens, then the inertia put your square a little bit "in" the wall, and so velocity is constantly reversed, causing your square to be blocked.
Ocharles actually nods to it in the blog post :
If this position falls outside the world bounds, we adjust the square (with a small epsilon to stop it getting stuck in the wall) and return the collision information.
Good luck with Netwire 5, I'm playing with it too, and I just begin to like it. ;)
So, while answering some other question I stumbled upon the necessity of computing the median of 5. Now, there's a similar question in another language, but I want a Scala algorithm for it, and I'm not sure I'm happy with mine.
Here's an immutable Scala version that has the minimum number of compares (6) and doesn't look too ugly:
def med5(five: (Int,Int,Int,Int,Int)) = {
// Return a sorted tuple (one compare)
def order(a: Int, b: Int) = if (a<b) (a,b) else (b,a)
// Given two self-sorted pairs, pick the 2nd of 4 (two compares)
def pairs(p: (Int,Int), q: (Int,Int)) = {
(if (p._1 < q._1) order(p._2,q._1) else order(q._2,p._1))._1
}
// Strategy is to throw away smallest or second smallest, leaving two self-sorted pairs
val ltwo = order(five._1,five._2)
val rtwo = order(five._4,five._5)
if (ltwo._1 < rtwo._1) pairs(rtwo,order(ltwo._2,five._3))
else pairs(ltwo,order(rtwo._2,five._3))
}
Edit: As requested by Daniel, here's a modification to work with all sizes, and in arrays so it should be efficient. I can't make it pretty, so efficiency is the next best thing. (>200M medians/sec with a pre-allocated array of 5, which is slightly more than 100x faster than Daniel's version, and 8x faster than my immutable version above (for lengths of 5)).
def med5b(five: Array[Int]): Int = {
def order2(a: Array[Int], i: Int, j: Int) = {
if (a(i)>a(j)) { val t = a(i); a(i) = a(j); a(j) = t }
}
def pairs(a: Array[Int], i: Int, j: Int, k: Int, l: Int) = {
if (a(i)<a(k)) { order2(a,j,k); a(j) }
else { order2(a,i,l); a(i) }
}
if (five.length < 2) return five(0)
order2(five,0,1)
if (five.length < 4) return (
if (five.length==2 || five(2) < five(0)) five(0)
else if (five(2) > five(1)) five(1)
else five(2)
)
order2(five,2,3)
if (five.length < 5) pairs(five,0,1,2,3)
else if (five(0) < five(2)) { order2(five,1,4); pairs(five,1,4,2,3) }
else { order2(five,3,4); pairs(five,0,1,3,4) }
}
Jeez, way to over-think it, guys.
def med5(a : Int, b: Int, c : Int, d : Int, e : Int) =
List(a, b, c, d, e).sort(_ > _)(2)
As suggested, here's my own algorithm:
def medianUpTo5(arr: Array[Double]): Double = {
def oneAndOrderedPair(a: Double, smaller: Double, bigger: Double): Double =
if (bigger < a) bigger
else if (a < smaller) smaller else a
def partialOrder(a: Double, b: Double, c: Double, d: Double) = {
val (s1, b1) = if (a < b) (a, b) else (b, a)
val (s2, b2) = if (c < d) (c, d) else (d, c)
(s1, b1, s2, b2)
}
def medianOf4(a: Double, b: Double, c: Double, d: Double): Double = {
val (s1, b1, s2, b2) = partialOrder(a, b, c, d)
if (b1 < b2) oneAndOrderedPair(s2, s1, b1)
else oneAndOrderedPair(s1, s2, b2)
}
arr match {
case Array(a) => a
case Array(a, b) => a min b
case Array(a, b, c) =>
if (a < b) oneAndOrderedPair(c, a, b)
else oneAndOrderedPair(c, b, a)
case Array(a, b, c, d) => medianOf4(a, b, c, d)
case Array(a, b, c, d, e) =>
val (s1, b1, s2, b2) = partialOrder(a, b, c, d)
if (s1 < s2) medianOf4(e, b1, s2, b2)
else medianOf4(e, b2, s1, b1)
}
}