Show all possible paths in a directional graph with each vertex can be visited once.

all_path.fsx

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."