tracks/fsharp/exercises/two-bucket/Example.fs in trackler-2.2.1.104 vs tracks/fsharp/exercises/two-bucket/Example.fs in trackler-2.2.1.105

- old
+ new

@@ -1,60 +1,52 @@ module TwoBucket type Bucket = One | Two +type Result = { Moves: int; GoalBucket: Bucket; OtherBucket: int } -let contents = fst -let size = snd +let measure bucketOneCapacity bucketTwoCapacity goal startBucket = + + let emptyFirst (_, bucketTwo) = (0, bucketTwo) + let fillFirst (_, bucketTwo) = (bucketOneCapacity, bucketTwo) + let pourFirst (bucketOne, bucketTwo) = + if bucketOne + bucketTwo <= bucketTwoCapacity then + (0, bucketOne + bucketTwo) + else + (bucketOne + bucketTwo - bucketTwoCapacity, bucketTwoCapacity) -let empty (_, size) = 0, size -let fill (_, size) = size, size + let emptySecond (bucketOne, _) = (bucketOne, 0) + let fillSecond (bucketOne, _) = (bucketOne, bucketTwoCapacity) + let pourSecond (bucketOne, bucketTwo) = + if bucketOne + bucketTwo <= bucketOneCapacity then + (bucketOne + bucketTwo, 0) + else + (bucketOneCapacity, bucketOne + bucketTwo - bucketOneCapacity) -let emptyFirstBucket (first, second) = empty first, second -let emptySecondBucket (first, second) = first, empty second + let applyMoves states = + [emptyFirst; fillFirst; pourFirst; emptySecond; fillSecond; pourSecond] + |> Seq.collect (fun applyMove -> Seq.map (fun state -> applyMove state) states) + |> set -let fillFirstBucket (first, second) = fill first, second -let fillSecondBucket (first, second) = first, fill second + let solved moves (currentBucketOne, currentBucketTwo) = + if currentBucketOne = goal then + Some { Moves = moves; GoalBucket = One; OtherBucket = currentBucketTwo } + elif currentBucketTwo = goal then + Some { Moves = moves; GoalBucket = Two; OtherBucket = currentBucketOne } + else + None -let pourFromFirstToSecond (first, second) = - let amount = min (size second - contents second) (contents first) - (contents first - amount, size first), (contents second + amount, size second) + let rec solve moves visited states = + match Seq.tryPick (solved moves) states with + | Some result -> result + | None -> + let newStates = Set.difference (applyMoves states) visited + let newVisited = Set.union visited newStates + solve (moves + 1) newVisited newStates -let pourFromSecondToFirst (first, second) = - let amount = min (size first - contents first) (contents second) - (contents first + amount, size first), (contents second - amount, size second) + let startMoves = 1 + let startVisited = set [(bucketOneCapacity, 0); (0, bucketTwoCapacity)] + let startState = + match startBucket with + | One -> set [(bucketOneCapacity, 0)] + | Two -> set [(0, bucketTwoCapacity)] -let isEmpty (contents, _) = contents = 0 -let isFull (contents, size) = contents = size - -let firstBucketEmpty (first, _) = isEmpty first -let firstBucketFull (first, _) = isFull first - -let secondBucketEmpty (_, second) = isEmpty second -let secondBucketFull (_, second) = isFull second - -let canPourToFirstBucket (first, second) = contents first + contents second <> size first - -let canPourToSecondBucket buckets = - (firstBucketFull buckets && not (secondBucketFull buckets)) || - (not (firstBucketFull buckets) && secondBucketEmpty buckets) - -let startFromFirstBucket buckets = - if firstBucketEmpty buckets then fillFirstBucket buckets - elif secondBucketFull buckets then emptySecondBucket buckets - elif canPourToSecondBucket buckets then pourFromFirstToSecond buckets - else failwith "Cannot transition from state" - -let startFromSecondBucket buckets = - if firstBucketFull buckets then emptyFirstBucket buckets - elif secondBucketEmpty buckets then fillSecondBucket buckets - elif canPourToFirstBucket buckets then pourFromSecondToFirst buckets - else failwith "Cannot transition from state" - -let rec solve target strategy moves (first, second) = - if contents first = target then Some (moves, One, contents second) - elif contents second = target then Some (moves, Two, contents first) - else solve target strategy (moves + 1) (strategy (first, second)) - -let moves firstSize secondSize target = - function - | One -> solve target startFromFirstBucket 1 ((firstSize, firstSize), (0, secondSize)) - | Two -> solve target startFromSecondBucket 1 ((0, firstSize), (secondSize, secondSize)) + solve startMoves startVisited startState \ No newline at end of file