I'm a software engineer, get me out of here

From Rosetta Code
I'm a software engineer, get me out of here is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Your latest contract has hit a snag. You came to update the army payroll system, but awoke this morning to the sound of mortars landing not far away and panicked generals banging on you door. The President has loaded his gold on trucks and needs to find the shortest route to safety. You are given the following map. The top left hand corner is (0,0). You and The President are located at HQ in the centre of the country (11,11). Cells marked 0 indicate safety. Numbers other than 0 indicate the number of cells that his party will travel in a day in any direction up, down, left, right, or diagonally.

         00000         
      00003130000      
    000321322221000    
   00231222432132200   
  0041433223233211100  
  0232231612142618530  
 003152122326114121200 
 031252235216111132210 
 022211246332311115210 
00113232262121317213200
03152118212313211411110
03231234121132221411410
03513213411311414112320
00427534125412213211400
 013322444412122123210 
 015132331312411123120 
 003333612214233913300 
  0219126511415312570  
  0021321524341325100  
   00211415413523200   
    000122111322000    
      00001120000      
         00000         

Part 1 Use Dijkstra's algorithm to find a list of the shortest routes from HQ to safety.
Part 2
Six days later and you are called to another briefing. The good news is The President and his gold are safe, so your invoice may be paid if you can get out of here. To do this a number of troop repositions will be required. It is concluded that you need to know the shortest route from each cell to every other cell. You decide to use Floyd's algorithm. Print the shortest route from (21,11) to (1,11) and from (1,11) to (21,11), and the longest shortest route between any two points.
Extra Credit

  1. Is there any cell in the country that can not be reached from HQ?
  2. Which cells will it take longest to send reinforcements to from HQ?


Related tasks:

  1. Dijkstra's algorithm
  2. Floyd-Warshall algorithm

F#[edit]

This task uses Dijkstra's algorithm (F#)

This task uses readCSV (F#)

Part 1[edit]

 
let safety=readCSV '\t' "gmooh.dat"|>Seq.choose(fun n->if n.value="0" then Some (n.row,n.col) else None)
let board=readCSV '\t' "gmooh.dat"|>Seq.choose(fun n->match n.value with |"0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9" as g->Some((n.row,n.col),int g)|_->None)|>Map.ofSeq
let adjacent((n,g),v)=List.choose(fun y->if y=(n,g) then None else match Map.tryFind y board with |None->None|_->Some ((y),1)) [(n+v,g);(n-v,g);(n,g+v);(n,g-v);(n+v,g+v);(n+v,g-v);(n-v,g+v);(n-v,g-v);]
let adjacencyList=new System.Collections.Generic.Dictionary<(int*int),list<(int*int)*int>>()
let rec mkAdj start=
let n=((start),Map.find start board)
let g=adjacent n
adjacencyList.Add((fst n),g)
List.iter(fun ((n),_)->if (not (adjacencyList.ContainsKey n )) then mkAdj n) g
mkAdj (11,11)
let nodes=adjacencyList.Keys |> List.ofSeq
let G=nodes |>List.collect(fun n->List.map(fun (n',g)->(((n),(n')),g))(adjacencyList.Item n))|>Map.ofList
let paths=Dijkstra nodes G (11,11)
let _,res=safety|>Seq.choose(fun n->paths n) |> Seq.groupBy(fun n->List.length n)|>Seq.minBy fst
res |> Seq.iter (printfn "%A")
 
Output:
[(11, 11); (10, 11); (7, 11); (6, 12); (0, 12)]
[(11, 11); (10, 11); (7, 11); (7, 12); (1, 6)]
[(11, 11); (10, 10); (8, 8); (4, 8); (1, 8)]
[(11, 11); (11, 12); (8, 9); (2, 9); (1, 9)]
[(11, 11); (10, 10); (8, 10); (5, 13); (1, 13)]
[(11, 11); (10, 11); (7, 8); (4, 11); (1, 14)]
[(11, 11); (11, 12); (8, 9); (2, 15); (1, 15)]
[(11, 11); (11, 12); (8, 9); (2, 15); (1, 16)]
[(11, 11); (10, 10); (8, 10); (5, 7); (2, 4)]
[(11, 11); (10, 11); (7, 8); (7, 5); (2, 5)]
[(11, 11); (11, 12); (8, 15); (9, 16); (2, 16)]
[(11, 11); (12, 10); (11, 9); (9, 9); (3, 3)]
[(11, 11); (10, 11); (7, 8); (4, 5); (3, 4)]
[(11, 11); (12, 11); (12, 14); (8, 18); (3, 18)]
[(11, 11); (12, 11); (9, 14); (6, 17); (4, 19)]
[(11, 11); (11, 12); (8, 9); (8, 3); (6, 1)]
[(11, 11); (12, 11); (12, 8); (8, 4); (6, 2)]
[(11, 11); (11, 12); (11, 15); (11, 17); (7, 21)]
[(11, 11); (11, 12); (8, 9); (8, 3); (8, 1)]
[(11, 11); (12, 11); (12, 8); (12, 4); (9, 1)]
[(11, 11); (11, 12); (8, 9); (14, 3); (11, 0)]
[(11, 11); (10, 11); (7, 8); (7, 5); (12, 0)]
[(11, 11); (12, 10); (13, 10); (13, 5); (13, 0)]
[(11, 11); (12, 11); (12, 8); (16, 4); (13, 1)]
[(11, 11); (12, 11); (12, 14); (16, 18); (13, 21)]
[(11, 11); (12, 11); (12, 8); (12, 4); (15, 1)]
[(11, 11); (11, 12); (11, 15); (11, 17); (15, 21)]
[(11, 11); (12, 11); (12, 8); (16, 4); (16, 1)]
[(11, 11); (10, 11); (10, 14); (12, 16); (16, 20)]
[(11, 11); (12, 11); (12, 14); (16, 18); (16, 21)]
[(11, 11); (12, 11); (15, 8); (15, 5); (18, 2)]
[(11, 11); (10, 11); (13, 8); (14, 7); (18, 3)]
[(11, 11); (12, 11); (15, 8); (18, 5); (19, 4)]
[(11, 11); (11, 12); (14, 15); (16, 15); (19, 18)]
[(11, 11); (12, 11); (15, 11); (16, 12); (20, 16)]
[(11, 11); (10, 11); (13, 11); (17, 15); (20, 18)]
[(11, 11); (12, 10); (13, 10); (18, 15); (21, 15)]
[(11, 11); (11, 12); (14, 9); (18, 13); (22, 9)]
[(11, 11); (12, 11); (15, 8); (18, 11); (22, 11)]
[(11, 11); (11, 12); (14, 9); (18, 13); (22, 13)]

Part 2[edit]

This task uses Floyd-Warshall algorithm#F.23

 
let board=readCSV '\t' "gmooh.dat"|>Seq.choose(fun n->match n.value with |"0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9" as g->Some((n.row,n.col),int g)|_->None)|>Map.ofSeq
let nodes=board|>Seq.map(fun n->n.Key)|>Set.ofSeq
let adjacent (n,g) v=List.choose(fun y->if y=(n,g) then None else match Set.contains y nodes with |true->Some ((y),1)|_->None) [(n+v,g);(n-v,g);(n,g+v);(n,g-v);(n+v,g+v);(n+v,g-v);(n-v,g+v);(n-v,g-v);]
let adjacencyList=board |>Seq.collect (fun n->Seq.map(fun ((n'),g')->((n.Key,n'),g'))(adjacent n.Key n.Value))|> Map.ofSeq
let _,paths=Floyd (nodes|>Set.toArray) adjacencyList
paths (21,11) (1,11) |>Seq.iteri(fun n g->if n>0 then printf "->"; printf "%A" g else printf "%A" g) ; printfn ""
paths (1,11) (21,11) |>Seq.iteri(fun n g->if n>0 then printf "->"; printf "%A" g else printf "%A" g) ; printfn ""
 
Output:
(20, 10)->(19, 9)->(18, 9)->(13, 4)->(6, 11)->(4, 11)->(1, 11)
(2, 10)->(5, 13)->(9, 9)->(15, 3)->(20, 8)->(20, 10)->(21, 11)

Phix[edit]

Using a simple breadth-first search. Parts 1 and 2 and extra credit.

constant gmooh = split("""
.........00000.........
......00003130000......
....000321322221000....
...00231222432132200...
..0041433223233211100..
..0232231612142618530..
.003152122326114121200.
.031252235216111132210.
.022211246332311115210.
00113232262121317213200
03152118212313211411110
03231234121132221411410
03513213411311414112320
00427534125412213211400
.013322444412122123210.
.015132331312411123120.
.003333612214233913300.
..0219126511415312570..
..0021321524341325100..
...00211415413523200...
....000122111322000....
......00001120000......
.........00000.........""",'\n')
 
constant width = length(gmooh[1]),
height = length(gmooh),
d = {{-1,-1},{0,-1},{+1,-1},
{-1, 0}, {+1, 0},
{-1,+1},{0,+1},{+1,+1}}
 
sequence routes -- {cost,fromy,fromx} for each gmooh[][].
 
procedure search(integer y, x)
-- simple breadth-first search, populates routes
-- (this isn't strictly dijkstra, because graph edges are not weighted)
integer cost = 0
sequence route = {{y,x}},
next = {}
routes = repeat(repeat(0,width),height)
routes[y,x] = {0,y,x} -- zero-cost the starting point
while 1 do
integer n = gmooh[y,x]-'0'
for di=1 to length(d) do
integer {dx,dy} = d[di]
integer {rx,ry} = {x+n*dx,y+n*dy}
if rx>=1 and rx<=width
and ry>=1 and ry<=height
and gmooh[ry,rx]>='0' then
object ryx = routes[ry,rx]
if ryx=0
or ryx[1]>cost+1 then
routes[ry,rx] = {cost+1,y,x}
if gmooh[ry,rx]>'0' then
next = append(next,{cost+1,ry,rx})
-- (if the graph was weighted, at this point
-- that would get shuffled up into place.)
end if
end if
end if
end for
if length(next)=0 then exit end if
{cost,y,x} = next[1]
next = next[2..$]
end while
end procedure
 
function get_route(sequence yx)
integer {y,x} = yx, cost
sequence res = {{y,x}}
while 1 do
{cost,y,x} = routes[y,x]
if cost=0 then exit end if
res = prepend(res,{y,x})
end while
return res
end function
 
procedure show_shortest_routes_to_safety()
integer shortest = 9999
sequence res = {}
for x=1 to width do
for y=1 to height do
if gmooh[y,x]='0' then
object ryx = routes[y,x]
if ryx!=0 then
integer cost = ryx[1]
if cost<=shortest then
if cost<shortest then
res = {}
shortest = cost
end if
res = append(res,{y,x})
end if
end if
end if
end for
end for
string {areis,s} = iff(length(res)>1?{"are","s"}:{"is",""})
printf(1,"There %s %d shortest route%s of %d days to safety:\n",{areis,length(res),s,shortest})
for i=1 to length(res) do
 ?get_route(res[i])
end for
end procedure
 
procedure show_unreachable()
sequence res = {}
for x=1 to width do
for y=1 to height do
if gmooh[y,x]>='0'
and routes[y,x]=0 then
res = append(res,{y,x})
end if
end for
end for
puts(1,"The following cells are unreachable:\n")
 ?res
end procedure
 
procedure show_longest()
integer longest = 0
sequence res = {}
for x=1 to width do
for y=1 to height do
if gmooh[y,x]>='0' then
object ryx = routes[y,x]
if ryx!=0 then
integer rl = ryx[1]
if rl>=longest then
if rl>longest then
res = {}
longest = rl
end if
res = append(res,{y,x})
end if
end if
end if
end for
end for
printf(1,"There are %d cells that take %d days to send reinforcements to\n",{length(res),longest})
for i=1 to length(res) do
 ?get_route(res[i])
end for
end procedure
 
procedure main()
search(12,12)
show_shortest_routes_to_safety()
 
-- see also below
search(22,12)
puts(1,"The shortest route from 22,12 to 2,12:\n")
 ?get_route({2,12})
 
search(2,12)
puts(1,"The shortest route from 2,12 to 22,12:\n")
 ?get_route({22,12})
 
search(12,12)
-- </see also below>
 
show_unreachable()
show_longest()
 
end procedure
main()
Output:

Note: Phix indexes are 1-based and therefore so too are these results.

There are 40 shortest routes of 4 days to safety:
{{12,12},{12,13},{9,10},{15,4},{12,1}}
{{12,12},{11,12},{8,9},{8,6},{13,1}}
{{12,12},{13,11},{14,11},{14,6},{14,1}}
{{12,12},{12,13},{9,10},{9,4},{7,2}}
{{12,12},{12,13},{9,10},{9,4},{9,2}}
{{12,12},{11,11},{9,9},{13,5},{10,2}}
{{12,12},{11,11},{13,9},{17,5},{14,2}}
{{12,12},{11,11},{9,9},{13,5},{16,2}}
{{12,12},{11,11},{13,9},{17,5},{17,2}}
{{12,12},{11,11},{9,9},{9,5},{7,3}}
{{12,12},{13,12},{16,9},{16,6},{19,3}}
{{12,12},{12,11},{11,10},{10,10},{4,4}}
{{12,12},{11,12},{14,9},{15,8},{19,4}}
{{12,12},{11,11},{9,11},{6,8},{3,5}}
{{12,12},{11,12},{8,9},{5,6},{4,5}}
{{12,12},{11,11},{13,9},{17,5},{20,5}}
{{12,12},{11,12},{8,9},{8,6},{3,6}}
{{12,12},{11,12},{8,12},{8,13},{2,7}}
{{12,12},{11,11},{9,9},{5,9},{2,9}}
{{12,12},{11,11},{9,11},{6,14},{2,10}}
{{12,12},{12,13},{15,10},{19,14},{23,10}}
{{12,12},{13,12},{16,9},{19,12},{23,12}}
{{12,12},{11,11},{9,13},{7,13},{1,13}}
{{12,12},{11,11},{9,11},{6,14},{2,14}}
{{12,12},{12,13},{15,10},{19,14},{23,14}}
{{12,12},{11,12},{8,9},{5,12},{2,15}}
{{12,12},{12,13},{9,10},{3,16},{2,16}}
{{12,12},{13,11},{14,11},{19,16},{22,16}}
{{12,12},{12,13},{9,10},{3,16},{2,17}}
{{12,12},{12,13},{9,10},{3,16},{3,17}}
{{12,12},{11,11},{13,9},{17,13},{21,17}}
{{12,12},{13,12},{13,15},{9,19},{4,19}}
{{12,12},{12,13},{15,16},{17,16},{20,19}}
{{12,12},{11,12},{14,12},{18,16},{21,19}}
{{12,12},{13,12},{10,15},{7,18},{5,20}}
{{12,12},{11,12},{11,15},{13,17},{17,21}}
{{12,12},{12,13},{12,16},{12,18},{8,22}}
{{12,12},{13,12},{13,15},{17,19},{14,22}}
{{12,12},{12,13},{12,16},{12,18},{16,22}}
{{12,12},{13,12},{13,15},{17,19},{17,22}}
The shortest route from 22,12 to 2,12:
{{22,12},{21,11},{20,10},{19,10},{14,5},{7,12},{5,12},{2,12}}
The shortest route from 2,12 to 22,12:
{{2,12},{3,11},{6,14},{10,10},{16,4},{21,9},{21,11},{22,12}}
The following cells are unreachable:
{{5,4},{3,19},{19,21}}
There are 5 cells that take 6 days to send reinforcements to
{{12,12},{11,11},{13,9},{17,13},{21,13},{22,12},{23,13}}
{{12,12},{12,13},{15,16},{17,18},{18,17},{19,17},{21,15}}
{{12,12},{13,12},{10,15},{7,18},{5,18},{4,18},{4,20}}
{{12,12},{11,12},{8,12},{8,13},{8,19},{8,21},{7,21}}
{{12,12},{11,12},{11,15},{13,17},{13,21},{16,21},{18,21}}

Alternative using Floyd-Warshall for Part 2, and finding the longest shortest path between any two points.

--(same constants as above: gmooh, width, height, d)
constant inf = 1e300*1e300
 
sequence dist, next, pmap = {}
 
function fw_path(integer u, v)
sequence res = {}
if next[u,v]!=null then
sequence path = {sprintf("{%d,%d}",pmap[u])}
while u!=v do
u = next[u,v]
path = append(path,sprintf("{%d,%d}",pmap[u]))
end while
res = join(path,"->")
end if
return res
end function
 
procedure show_fw_path(integer u, v)
printf(1,"{%d,%d}->{%d,%d}  %2d  %s\n",pmap[u]&pmap[v]&{dist[u,v],fw_path(u,v)})
end procedure
 
procedure FloydWarshall()
integer point = 0
sequence weights = {},
points = repeat(repeat(0,width),height)
-- First number the points...
for x=1 to width do
for y=1 to height do
if gmooh[y,x]>='0' then
point += 1
points[y,x] = point
pmap = append(pmap,{y,x})
end if
end for
end for
-- ...and then a set of edges (all of which have a "weight" of 1 day)
for x=1 to width do
for y=1 to height do
if gmooh[y,x]>'0' then
integer n = gmooh[y,x]-'0'
for di=1 to length(d) do
integer {dx,dy} = d[di]
integer {rx,ry} = {x+n*dx,y+n*dy}
if rx>=1 and rx<=width
and ry>=1 and ry<=height
and gmooh[ry,rx]>='0' then
-- weights = append(weights,{points[y,x],points[ry,rx],1})
weights = append(weights,{points[y,x],points[ry,rx]})
end if
end for
end if
end for
end for
-- Before applying Floyd-Warshall
integer V = length(pmap)
dist = repeat(repeat(inf,V),V)
next = repeat(repeat(null,V),V)
for k=1 to length(weights) do
-- integer {u,v,w} = weights[k]
integer {u,v} = weights[k]
-- dist[u,v] := w -- the weight of the edge (u,v)
dist[u,v] := 1 -- the weight of the edge (u,v)
next[u,v] := v
end for
-- standard Floyd-Warshall implementation,
-- with the optimisation of avoiding processing of self/infs,
-- which surprisingly makes quite a noticeable difference.
for k=1 to V do
for i=1 to V do
if i!=k and dist[i,k]!=inf then
for j=1 to V do
if j!=i and j!=k and dist[k,j]!=inf then
atom d = dist[i,k] + dist[k,j]
if d<dist[i,j] then
dist[i,j] := d
next[i,j] := next[i,k]
end if
end if
end for
end if
end for
end for
show_fw_path(points[22,12],points[2,12])
show_fw_path(points[2,12],points[22,12])
 
integer maxd = 0, mi, mj
for i=1 to V do
for j=1 to V do
if j!=i then
atom d = dist[i,j]
if d!=inf and d>maxd then
{maxd,mi,mj} = {d,i,j}
end if
end if
end for
end for
printf(1,"Maximum shortest distance:\n")
show_fw_path(mi,mj)
 
end procedure
 
FloydWarshall()
Output:
{22,12}->{2,12}    7   {22,12}->{21,11}->{20,11}->{15,11}->{11,11}->{9,9}->{5,9}->{2,12}
{2,12}->{22,12}    7   {2,12}->{3,11}->{6,14}->{10,10}->{16,4}->{21,9}->{21,11}->{22,12}
Maximum shortest distance:
{8,4}->{21,15}   9   {8,4}->{9,5}->{11,7}->{12,8}->{16,12}->{17,12}->{18,13}->{18,17}->{19,17}->{21,15}