F# Question. FSharpx Choice foldM.

open System
open System.Collections
open FSharpx
open FSharpx.Choice

let foo = ["A";"B";"C"]

let inputs1 = ["A";"D";"b"]
let inputs2 = ["A";"A";"C"]

let listMonoid  = new Monoid.ListMonoid<_>()
let inline tryFind x list name = fromOption [sprintf " %A not found in %A " x name] (List.tryFind ((=) x) list)
let tryFindFoo x = tryFind x foo "foo"

let inline testFoldM input = 
    foldM 
        (fun acc s -> 
            Validation.apm 
                        listMonoid 
                        (returnM acc) 
                        (tryFindFoo s |> map List.cons)) 
        [] 
        input
    |> choice List.rev id

let inline testFold input = 
    List.foldBack 
        (fun s acc  -> 
            Validation.apm 
                        listMonoid 
                        acc
                        (tryFindFoo s |> map List.cons)) 
        input
        (returnM [] )
    |> choice id id

printfn "test foldM : %A" (List.map testFoldM [inputs1; inputs2]) 
printfn "test fold : %A" (List.map testFold [inputs1; inputs2]) 
// Why foldM stops after the first appearance on the Choice2Of2 case ?

// I would expect that testFoldM behaves exactly like testFold.

test foldM : [[" "D" not found in "foo" "]; ["A"; "A"; "C"]]
test fold : [[" "D" not found in "foo" "; " "b" not found in "foo" "]; ["A"; "A"; "C"]]

UPDATE: The solution from Mauricio Scheffer

"If you take a look at its definition, you'll see that Choice.foldM is defined in terms of monadic return and bind. OTOH Validation, even though it uses the same underlying type Choice1Of2 | Choice2Of2, doesn't have a proper monadic instance, it's instead just an applicative functor. The Either monad (called Choice in FSharpx) does "short-circuit" evaluation on bind, just like the Maybe monad. But for validation, you usually want to accumulate errors instead, so you want the opposite of this short-circuit evaluation, so you don't want anything that uses Choice.bind, therefore you don't want Choice.foldM. What you can use in this case is Validation.mapM, which is built on top of Validation.sequence, which in turn is built on the applicative functor. (Now that I think about it, mapM isn't such a good name, since it's not really monadic! I wonder how a mapM-like function is defined in Haskell over sequenceA). This function is equivalent to your testFold function:

let testMapM = Validation.mapM tryFindFoo |> choice id id

Well, at least it gives the same output in this test BTW I'd only open FSharpx.Choice if you're going to use the operators... otherwise I'd prefer to just open FSharpx and then explicitly call Choice.foldM, etc. Yes, Choice.choice looks a bit ridiculous, not sure how to name it "

let solution input = Validation.mapM tryFindFoo input |> choice id id
printfn "Solution: %A" (List.map solution [inputs1; inputs2])

F# Boids (Swarm). Schwarm Simulation.

Update Part 2.

Boids stellen eine Simulation von Schwarmverhalten dar.
Als Grundlage diente mir der folgende Pseudocode. Einige Implementierungsdetails habe ich von hier übernommen.
Die Regeln sind schnell implementiert.

let inline sq x = x * x

type BoidVel = { velX:float; velY :float }

type BoidNeighbour = {relX:float; relY : float; Vel : BoidVel }

//three vector operators.
let inline (<+>) (a,b) (a',b') = a+a',b+b'

let inline (<->) (a,b) (a',b') = a-a',b-b'

let inline (</>) (a,b) c= a/c, b/c

//boids neighbours. 
let inline within neighbours distance = 
    List.filter (fun n -> (sq n.relX) + (sq n.relY) < (sq distance) ) neighbours

//Boids try to match velocity with near boids.
let inline meanVelocityAcc curVel neighbours =
    match neighbours with
    |[]->curVel.velX,curVel.velY
    |_->
        (List.average (List.map (fun n -> n.Vel.velX) neighbours)) - curVel.velX,
        (List.average (List.map (fun n -> n.Vel.velY) neighbours)) - curVel.velY

//An acceleration to stop us hitting nearby boids.
let inline repulsionAcc sight neighbours =
    within neighbours sight 
    |>List.map (fun n->negate n.relX, negate n.relY)
    |>List.fold (<+>) (0.0, 0.0) 

//An acceleration to keep us quite close to nearby boids. 
let inline keepCloseAcc neighbours = 
    match neighbours with
    |[]->0.0,0.0
    |_->
        List.average (List.map (fun n->n.relX) neighbours),
        List.average (List.map (fun n->n.relY) neighbours)

//Limit maximum speed.
let inline limit boidVel speedLimit =
    match boidVel with
    |vel when sq vel.velX + sq vel.velY > sq speedLimit ->
        let slowdown = (sq speedLimit) / (sq vel.velX + sq vel.velY)
        {velX = slowdown * vel.velX; velY = slowdown * vel.velY}
    |_ -> boidVel

//Bounding the position
let inline boundPosition (boundMin,boundMax) boid =
    let bound coor =
        match coor > boundMax, coor<boundMin with
        |true, _ -> -1.0
        |_, true -> 1.0
        |_ -> 0.0
    bound boid.relX, bound boid.relY

//apply rules for current boid.
let inline boidRules sight (cur,input)= 
    let neighbours = within input 2.0 * sight
    (meanVelocityAcc cur.Vel neighbours) </> 8.0
    <+> (repulsionAcc sight neighbours </> 4.0)
    <+> (keepCloseAcc neighbours </> 30.0)

Die Schwarm-Daten hält man üblicherweise (z.B wegen Effizienz) in einem Array, ich wollte aber in Rahmen der reinen funktionalen Programmierung bleiben und entscheide mich die Daten in einer Liste zu halten. Daraus ergab sich eine interessante Funktion zur Berechnung der neuen Position einzelner Schwarm-Elemente.

type Environment = 
    {sight: float;
     space float;
     speedLimit: float; 
     bound: float * float;
     target: BoidNeighbour -> float * float; //goal seeking function
     avoidObstacle: BoidNeighbour -> float * float //obstacle avoidance function
    }

let inline moveAll env input =
    input|> List.fold 
        (fun (pred,succ) _ -> 
            match succ with
            |x::xs->
                withEnv env (x, near env.space x (pred@xs))::pred, xs
            |[]->
                pred,[]) ([], input)
    |> fst

Wir gehen unsere Liste von Boids durch und erstellen eine neue Liste.

input|>List.fold ...

Als Akkumulator wird ein Tupel von Listen verwendet.

input|>List.fold (fun (pred,succ) _ -> ...) ([], input)

Wie man sieht, wird input noch mal als Anfangszustand an der Fold-Funktion übergeben. In der Funktion wird den neuen Wert des Elements berechnet. Dabei wird mit den relativen Positionen gearbeitet, für deren Berechnung eine Liste alle Boids außer aktuellen - pred@xs - gebraucht wird.

...near env.space x (pred@xs)
...
let inline near distance cur boids =
    let absDiff a b = abs (a - b)
    List.fold 
        (fun acc other -> 
            if (absDiff cur.relX other.relX <= distance) && (absDiff cur.relY other.relY <= distance) then
                {Vel=other.Vel;
                 relX = other.relX- cur.relX;
                 relY = other.relY- cur.relY}::acc
            else
                acc ) [] boids

In der pred-Teilliste stehen neu berechnete Werte aller Vorgänger eines aktuellen Elementes,

withEnv env (x, near env.space x (pred@xs))::pred

so dass diese am Ende des Folding-Prozesses alle neuen Werte enthält.

Zwei weitere Regeln können interaktiv vom Benutzer hinzugefügt werden: das Ausweichen von Hindernissen und eine Zielsuche.

//awoid obstacle.
let inline avoid sight radius obstacle boid =
    let diffAngle vel distance =
        let rec inner a f r=
            match (f a) with
            | true-> inner (r a) f r
            | false -> a
        let t = inner (vel - distance) (fun x-> x > Math.PI) (fun x-> x - 2.0*Math.PI)
        inner t (fun x-> x<(-Math.PI)) (fun x->x+ 2.0*Math.PI)
    let (dx,dy) = obstacle <-> (boid.relX, boid.relY)
    let distance = sqrt (sq dx+sq dy)
    match distance with 
    | d when d <= sight -> 
        (-dx*rnd.NextDouble(),-dy*rnd.NextDouble())
    | d when d < (2.0 *sight + radius) ->
        let velAngle=atan2 boid.Vel.velY boid.Vel.velX
        let distanceAngle = atan2 dy dx
        let diff = diffAngle velAngle distanceAngle
        let newVel sinOrCos m = ((distance - radius)*(sinOrCos (distanceAngle - m * Math.PI)) +
                                (radius + sight - distance * rnd.NextDouble()) * 
                                (sinOrCos (distanceAngle - Math.PI)))/sight
        match (abs diff) < Math.PI/2.0 with
        | true ->
            if diff>0.0 then
                (newVel cos 1.5, newVel sin 1.5)
            else
                (newVel cos 0.5, newVel sin 0.5)
        | false -> (0.0, 0.0)
    | d->
        (0.0, 0.0)

let inline tendToPlace bound place boid =
    (place <-> (boid.relX, boid.relY)) </> (bound * 1.5)

Alle Regeln zusammen.

let inline withEnv env (cur,input) =
    let (idealAccX, idealAccY) = 
        (boidRules env.sight (cur, input))
        <+> (env.target cur)  3.0
        <+> (env.avoidObstacle cur)
        <+> (boundPosition env.bound cur) 
    let newvel = limit {velX = cur.Vel.velX + (idealAccX/6.0);
                        velY = cur.Vel.velY + (idealAccY/6.0)} env.speedLimit
    {Vel = newvel; relX = cur.relX + newvel.velX; relY = cur.relY + newvel.velY}

Dank First Class Events in F# kann die Benutzerinteraktion ganz einfach, schnell und in funktionaler Manier realisiert werden.
Linke Maustaste - Hindernis auf das Formular platzieren.
Rechte Maustaste - Ziel für den Schwarm setzen.

type AnimationForm() as x =
    inherit Form()
    let img = createImage Brushes.Red

    do 
        x.SetStyle(ControlStyles.AllPaintingInWmPaint ||| ControlStyles.OptimizedDoubleBuffer, true)
        x.FormBorderStyle <- FormBorderStyle.FixedToolWindow
        x.StartPosition <- FormStartPosition.CenterScreen
        
        let tmr = new Timers.Timer(Interval = 20.0)
        tmr.Elapsed.Add(fun _ -> x.Invalidate() )
        tmr.Start()

    member x.guiRefresh (e:Graphics) envDrawing swarm =
        e.FillRectangle(Brushes.White, Rectangle(Point(0,0), x.ClientSize))
        let envCompose = compose envDrawing.drawingObstacle envDrawing.drawingTarget
        let drawing = swarm|>List.fold (fun acc n->compose acc (drawBoid img n) ) emptyDrawing
        envCompose.Draw(e)
        drawing.Draw(e)

let test =
    let boundMin,boundMax=0.0,650.0
    let radius =10.0
    //Start Enviroment.
    let envStart = {sight = 18.0; space = 250.0;
                    speedLimi t= 1.2;
                    bound = (boundMin,boundMax);
                    targe t= (fun _-> 0.0, 0.0);
                    avoidObstacle = (fun _-> 0.0, 0.0)}
    let envDrawingStart = {drawingTarget = emptyDrawing; drawingObstacle = emptyDrawing}
    let af = new AnimationForm(ClientSize = Size(int boundMax, int boundMax), Visible = true)
    let swarmInit = List.map (fun i ->makeboid i rnd) [0..150]
    //Start swarm after 500 steps.
    let swarmStart = List.fold (fun acc _->moveAll envStart acc) swarmInit [0..500]
    let evtMouseClick =
        af.MouseClick 
        |>Event.scan (fun (accEnv,accEnvDrawing) arg->
                 match (arg.Button) with
                 | MouseButtons.Left->
                     let f = avoid accEnv.sight radius (float arg.X,float arg.Y)
                     {accEnv with avoidObstacle = f}, {accEnvDrawing with drawingObstacle = 
                                                           circle Brushes.Black (float32 radius) (float32 arg.X, float32 arg.Y)}
                 | MouseButtons.Right->
                     let f = tendToPlace boundMax (float arg.X,float arg.Y)
                     {accEnv with target = f}, {accEnvDrawing with drawingTarget = 
                                                    circle Brushes.Red (float32 radius) (float32 arg.X,float32 arg.Y)}
                 | _-> 
                     accEnv, accEnvDrawing) 
            (envStart, envDrawingStart)

    let rec waiting (env:Environment) (envDrawing:EnvDrawing) swarm= async {
        let! evnt = Async.AwaitObservable (af.Paint, evtMouseClick)
        match evnt with
        | Choice1Of2(evntArg1)->
            let newSwarm = moveAll env swarm
            af.guiRefresh evntArg1.Graphics envDrawing newSwarm
            do! waiting env envDrawing newSwarm 
        | Choice2Of2(evntArg2) ->
            let newEnv,newEnvDrawing = evntArg2
            do! waiting newEnv newEnvDrawing swarm }
    waiting envStart envDrawingStart swarmStart|> Async.StartImmediate
#if COMPILED
  af

System.Windows.Forms.Application.Run(test)
#else
let main() =
    test |> ignore
[<STAThread>]
    do main()
#endif

Die Exe-Datei zum Ausprobieren und der komplette F#-Code.