Sorry for a partial message just now - I was editing and pressed send
by mistake!

Raul's obviously done a lot on this - I'd been drafting something, so I'll
send what I was working on.

I think the recon verb needs a check on whether there are any improvements.
Anyway,  here are my tries.

fwalg is the unadorned minimum distance algorithm,  fwtree the same with the
additional bits to provide the tree,  and fwpath and fwpatht use the tree to
return required paths.

NB. input y = graph as matrix of weighted arcs
NB. output matrix d of shortest distances between row i, col j
fwalg =: 3 : 0
d   =. y
for_k. i.#d do.
   d =. d <. k ({"1 +/ {) d
end.
d
)

NB. input weighted graph as matrix
NB. using _1 as null
fwtree =: 3 : 0
dist =. y
n    =. {. shape =. $ dist
next =. <: (dist -.@e. 0 _) * >: n|i.2#n
for_k. i.#dist do.
 try   =. k ({"1 +/ {) dist
 if. +/ok    =. ,dist > try do.
   'i j' =. |:ij =. shape #: I. ok
   ik    =. <"1 i,. k
   ij    =. <"1 ij
   dist  =. (ij { try)  ij } dist
   next  =. (ik { next) ij } next
 end.
end.
next
)

NB. x = result of fwtree g
NB. y = u v
fwpath  =: 3 : 0
:
next    =. x, _1
uv      =. < 'u v'   =.  y
path    =. u
while. _1 < u =. uv { next do.
      u    =. uv { next
      uv   =. <u, v
      path =. path, u
end.
)

NB. tacit version
fwpatht =: 3 : 0
:
{."1 }:({:,~(x,_1){~<)^:a: y
)

NB. tacit version
fwpatht =: 3 : 0
:
{."1 }:({:,~(x,_1){~<)^:a: y
)

Results on Danil's mx matrix:










On 05/03/2018 09:15, Danil Osipchuk wrote:
actually it seems that it is my code which works correctly, and the
rosetta's one has a mistake in the initialization of the next-hop table. Or
am I missing something?
the same toy example, for unidirectional graph there is no way back from
nodes 1 and 2 back to  0:

[mx=: 3 3 $ 0 1 4 _ 0 2 _ _ 0

0 1 4

_ 0 2

_ _ 0


The initialization in rosetta version says there is a way back:

y=:mx

((|i.@,~)#y)*1>.y->./(,y)-._

0 1 2

0 1 2

0 _ 2


NB. modify to return both next-hops and metrics:

floydrecon=: verb define

n=. ((|i.@,~)#y)*1>.y->./(,y)-._

for_j. i.#y do.

d=. y <. j ({"1 +/ {) y

b=. y~:d

y=. d

n=. (n*-.b)+b * j{"1 n

end.

n;y

)




Basically, _ should appear in the same places:

floydrecon mx

┌─────┬─────┐

│0 1 1│0 1 3│

│0 1 2│_ 0 2│

│0 _ 2│_ _ 0│

└─────┴─────┘





2018-03-05 11:33 GMT+03:00 Danil Osipchuk<[email protected]>:

Raul, thank you
the rosseta version works faster than every thing I tried, not to say
giving correct results
Danil

2018-03-05 0:12 GMT+03:00 Raul Miller<[email protected]>:

You might get some ideas from
https://rosettacode.org/wiki/Floyd-Warshall_algorithm#J

Good luck,

--
Raul


On Sun, Mar 4, 2018 at 4:09 PM, Danil Osipchuk<[email protected]>
wrote:
Hi, all

I'm toying with the Floyd–Warshall algo
http://code.jsoftware.com/wiki/Essays/Floyd  trying to extend it along
the
lines ofhttps://en.wikipedia.org/wiki/Floyd%E2%80%93Warshall_algorithm
to
get a next-hop table

I'm doing something wrong since what I came with is ugly in the
beginning,
in the middle and in the end and I barely think it works for a simplest
cases.
I'm sure there is a better way from which I could learn something.
regards,
   Danil


merge =: 1 : 0  NB. m is a bit mask, merge x with values of y where m
is 1,
preserve shape
:
($m)$(,m)}(x ,:&:, y)
)

floyd=: 3 : 0
  nh =. (($y)$#y) (y < _) merge (i."0 #~#y) NB. initialize next-hop
table,
#y means unreachable
  for_k. i.#y do.
    m =. y > [dk =. k ({"1 +/ {) y          NB. dk is distance through
k, m
is a mask were it is an improvement
    y =. y m merge dk                       NB. update the distance table
    nh=. nh m merge (|: ($y)$ k{"1 nh)      NB. set next-hop through k
where
there is an improvement
  end.
  nh;y
)
--- transcript ---

[mx=: 3 3 $ 0 1 4 _ 0 2 _ _ 0
0 1 4
_ 0 2
_ _ 0

    floyd mx
┌─────┬─────┐
│0 1 1│0 1 3│
│3 1 2│_ 0 2│
│3 3 2│_ _ 0│
└─────┴─────┘
----------------------------------------------------------------------
For information about J forums seehttp://www.jsoftware.com/forums.htm
----------------------------------------------------------------------
For information about J forums seehttp://www.jsoftware.com/forums.htm
----------------------------------------------------------------------
For information about J forums seehttp://www.jsoftware.com/forums.htm



---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm

Reply via email to