fsharp gravity kata

fsharpgravitykata

let floored block =
    snd block = 0

let collision blocks block =
    List.exists(fun b -> b = block) blocks

let otherblocks blocks block = List.filter(fun b -> b <> block) blocks

let rec fall blocks block =
    let fallenBlock = (fst block, snd block - 1)
    if (collision blocks fallenBlock || floored block) then
        blocks    
    else
        let bs = List.append (otherblocks blocks block) [fallenBlock]
        fall bs fallenBlock

let rec fallAll blocks = 
    let needToFall = List.filter (fun b -> ((floored (fst b - 1, snd b)) = false && (collision blocks (fst b - 1, snd b)) = false)) blocks
    if List.length needToFall > 0 then
        fallAll (fall blocks needToFall.Head)
    else
        blocks

let add blocks block =
    let added = List.append blocks [block]
    fall added block        
    
let rec left blocks block =
    let newPosition = (fst block - 1, snd block)
    if collision blocks newPosition then
        let moved = List.append (left (otherblocks blocks block) newPosition) [newPosition]
        fallAll moved
    else
        let moved = List.append (otherblocks blocks block) [newPosition]
        fallAll moved
    
let rec right blocks block =
    let newPosition = (fst block + 1, snd block)
    if collision blocks newPosition then
        let moved = List.append (right (otherblocks blocks block) newPosition) [newPosition]
        fallAll moved
    else
        let moved = List.append (otherblocks blocks block) [newPosition]
        fallAll moved

let rec gravitate blocks action block =
    match action with
    | "add" -> add blocks block
    | "left" -> left blocks block
    | "right" -> right blocks block
    | "remove" -> fallAll (otherblocks blocks block)
    | _ -> blocks


printfn "%b when a block is at 1,1 it should not be on the floor" (floored (1, 1) = false)
printfn "%b when a block is at 1,0 it should be on the floor" (floored (1, 0) = true)
let blocks1 = [(0,5)]
let fallenBlocks1 = fall blocks1 (0,5)    
printfn "%b when a block is at 0,5 and falls it should be on the floor" (fallenBlocks1 = [(0,0)])
let blocks2 = [(1,0)]
let block2 = left blocks2 (1,0)
printfn "%b when a block is at 1,0 and is pushed left, its at 0,0" (block2 = [(0,0)])
let blocks3 = [(1,0)]
let block3 = right blocks3 (1,0)
printfn "%b when a block is at 1,0 and is pushed right, its at 2,0" (block3 = [(2,0)])
let blocks4 = [(0,0); (0,5)]
let fallenBlocks2 = fall blocks4 (0,5)    
printfn "%b when a block is at 0,5 and falls it should fall to 0,1" (fallenBlocks2 = [(0,0); (0,1)])
let blocks55 = []
let gravitated1 = gravitate blocks55 "add" (5,5) 
printfn "%b when we add a block to 5,5 it falls to 5,0" (gravitated1 = [(5,0)])
let blocks6 = [(0,0)]
let gravitated2 = gravitate blocks6 "left" (0,0) 
printfn "%b when we move a block at 0,0 left it ends at -1,0" (gravitated2 = [(-1,0)])
let blocks7 = [(0,0)]
let gravitated3 = gravitate blocks7 "right" (0,0) 
printfn "%b when we move a block at 0,0 right it ends at 1,0" (gravitated3 = [(1,0)])
let blocks5 = [(0,0); (1,0); (3,0); (4,0)]
let fallenBlocks3 = gravitate blocks5 "left" (4,0)    
printfn "%b 4 blocks left" (fallenBlocks3 = [(0,0); (1,0); (2,0); (3,0)])
let blocks8 = [(0,0); (1,0); (3,0); (4,0)]
let gravitated4 = gravitate blocks8 "right" (0,0) 
printfn "%b when we move 4 blocks right" (gravitated4 = [(3,0); (4,0); (2,0); (1,0)])
let blocks9 = [(0,0); (0,1)]
let gravitated5 = gravitate blocks9 "right" (0,0) 
printfn "%b when we move 1 block right" (gravitated5 = [(1,0); (0,0)])
let blocks10 = [(0,0); (0,1); (0,2)]
let gravitated6 = gravitate blocks10 "remove" (0,1) 
printfn "%b when we remove 1 block" (gravitated6 = [(0,0); (0,1)])


System.Console.ReadKey()