Show all possible paths in a directional graph with each vertex can be visited once.
type TravelMode =
| Walk
| Bus
| MRT
| BTS
| Motorbike
| Taxi
[<Measure>] type baht
[<Measure>] type minute
type Price = decimal<baht>
type Time = int<minute>
type Location =
| Home
| MRTLatPhao
| MRTSilom
| Silom19
type TravelCost = TravelMode * Price * Time
type TravelRoute =
{ from: Location
to_: Location
cost: TravelCost }
module TravelRoute =
let from r = r.from
let to_ r = r.to_
let routes =
[ { from=Home ; to_=MRTLatPhao; cost=Motorbike, 30m<baht>, 10<minute> }
{ from=Home ; to_=MRTLatPhao; cost=Bus, 13m<baht>, 17<minute> }
{ from=MRTLatPhao; to_=MRTSilom ; cost=MRT, 38m<baht>, 40<minute> }
{ from=MRTSilom ; to_=Silom19 ; cost=Motorbike, 50m<baht>, 10<minute> }
]
module Routers =
type VisitedTrack = Set<Location>
type Routes = TravelRoute list
type TravelContext = VisitedTrack * Routes
type ISolutionResponder = Routes -> unit
module TravelContext =
let ``to`` (_, path) = path |> List.head |> TravelRoute.to_
// Routes -> Location -> TravelRoute seq
let possibleRoutes routes loc = routes |> Seq.filter (TravelRoute.from >> (=) loc)
// Routes -> VisitedTrack * Location -> TravelRoute seq
let generateNextContext routes (visited: VisitedTrack, loc) =
possibleRoutes routes loc
|> Seq.filter (fun r -> not (visited |> Set.contains r.to_))
// Routes -> Location -> TravelContext -> TravelContext seq
let private expandPath routes loc (visited, path) :TravelContext seq =
let possibleNexts = generateNextContext routes (visited, loc)
possibleNexts |> Seq.map (fun ctx -> (visited |> Set.add (TravelRoute.to_ ctx), ctx::path))
open System.Collections.Generic
// Routes -> (Location, Location) -> Routes seq
let findAllPath routes (from, ``to``) =
let firstSolutions = expandPath routes from (Set.ofList [from], [])
seq {
let allUnreached = List<TravelContext>(128)
allUnreached.AddRange firstSolutions
while allUnreached.Count > 0 do
let solutions = allUnreached |> Seq.toList
allUnreached.Clear()
for sol in solutions do
let expanded = expandPath routes (TravelContext.``to`` sol) sol |> Seq.toList
let reached, unreached = expanded |> List.partition (TravelContext.``to`` >> (=) ``to``)
yield! reached |> Seq.map snd
allUnreached.AddRange unreached
}
Routers.findAllPath routes (Home, Silom19)
|> Seq.iter (printfn "sol. %A")
printfn "done."