Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.forth > #45629 > unrolled thread

Topological sort

Started by"WJ" <w_a_x_man@yahoo.com>
First post2016-02-19 21:11 +0000
Last post2016-02-23 10:56 -0800
Articles 11 — 4 participants

Back to article view | Back to comp.lang.forth


Contents

  Topological sort "WJ" <w_a_x_man@yahoo.com> - 2016-02-19 21:11 +0000
    Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-19 23:41 -0800
      Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-20 01:00 -0800
      Re: Topological sort anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-20 11:13 +0000
        Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-20 10:39 -0800
        Rosettacode topological sort (was: Topological sort) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-22 07:54 +0000
          Re: Rosettacode topological sort (was: Topological sort) Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-22 10:04 +0000
            Re: Rosettacode topological sort (was: Topological sort) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-22 12:26 +0000
              Re: Rosettacode topological sort (was: Topological sort) Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-22 13:28 +0000
      Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-23 01:12 -0800
      Re: Topological sort lehs <skydda.barnen@gmail.com> - 2016-02-23 10:56 -0800

#45629 — Topological sort

From"WJ" <w_a_x_man@yahoo.com>
Date2016-02-19 21:11 +0000
SubjectTopological sort
Message-ID<na80e0$ov$1@dont-email.me>
A Ruby version which seems to be correct; the ANS Forth versions
will have to be provided by others.

def tsort edges
  leaders = edges.map(&:first).uniq
  followers = edges.flat_map{|x| x.drop(1)}.uniq
  visited = []
  ordering = []
  packs =
    leaders.map{|leader|
      [leader] +
        edges.flat_map{|edge| leader==edge[0] ? edge.drop(1) : []}}
  dfs = lambda{|v|
    visited.unshift(v)
    pack = packs.assoc(v)
    if pack
      pack.drop(1).each{|n| dfs[n] unless visited.include?(n)}
    end
    ordering.unshift(v)}
  (leaders - followers).each{|x| dfs[x]}
  ordering
end

tsort [[:the,:issue],[:not,:trying],[:confuse,:the],[:am,:trying],[:trying,:to],
 [:am,:not],[:trying,:the],[:to,:confuse],[:i,:am]]

 ===>
[:i, :am, :not, :trying, :to, :confuse, :the, :issue]


tsort [[:shirt,:tie,:belt],[:tie,:jacket],[:belt,:jacket],[:watch],
  [:pants,:shoes,:belt],[:undershorts,:pants,:shoes],[:socks,:shoes]]

 ===>
[:socks, :undershorts, :pants, :shoes, :watch, :shirt, :belt, :tie, :jacket]


-- 
Man is a social animal just like ants or bees or wolves.  All have their living
space, which they defend to the very end.
http://www.kolumbus.fi/aquilon/aquilon_quot1.htm

[toc] | [next] | [standalone]


#45638

Fromlehs <skydda.barnen@gmail.com>
Date2016-02-19 23:41 -0800
Message-ID<62b38622-4fbc-4d99-a93d-6c0933e54de5@googlegroups.com>
In reply to#45629
Den fredag 19 februari 2016 kl. 22:14:28 UTC+1 skrev WJ:
> A Ruby version which seems to be correct; the ANS Forth versions
> will have to be provided by others.
> 
> def tsort edges
>   leaders = edges.map(&:first).uniq
>   followers = edges.flat_map{|x| x.drop(1)}.uniq
>   visited = []
>   ordering = []
>   packs =
>     leaders.map{|leader|
>       [leader] +
>         edges.flat_map{|edge| leader==edge[0] ? edge.drop(1) : []}}
>   dfs = lambda{|v|
>     visited.unshift(v)
>     pack = packs.assoc(v)
>     if pack
>       pack.drop(1).each{|n| dfs[n] unless visited.include?(n)}
>     end
>     ordering.unshift(v)}
>   (leaders - followers).each{|x| dfs[x]}
>   ordering
> end
> 
> tsort [[:the,:issue],[:not,:trying],[:confuse,:the],[:am,:trying],[:trying,:to],
>  [:am,:not],[:trying,:the],[:to,:confuse],[:i,:am]]
> 
>  ===>
> [:i, :am, :not, :trying, :to, :confuse, :the, :issue]
> 
> 
> tsort [[:shirt,:tie,:belt],[:tie,:jacket],[:belt,:jacket],[:watch],
>   [:pants,:shoes,:belt],[:undershorts,:pants,:shoes],[:socks,:shoes]]
> 
>  ===>
> [:socks, :undershorts, :pants, :shoes, :watch, :shirt, :belt, :tie, :jacket]
> 
> 
> -- 
> Man is a social animal just like ants or bees or wolves.  All have their living
> space, which they defend to the very end.
> http://www.kolumbus.fi/aquilon/aquilon_quot1.htm

Since Forth is a kind of macro assembler you'll have to define some kind of lists and sets and then use e.g. Kahn's algorithm.

In Zet directed graphs are subsets of the Cartesian product ExE of the edge set and this will be a nice task to solve.

https://github.com/Lehs/ZET
--
Mankind has developed to a level where it is possible to be liberated from the slavery of the genes. We don't have to compete and conquer, we can choose to be friendly and to do what is right. The human body is a master among servants but shouldn't serve us by being our masters.

[toc] | [prev] | [next] | [standalone]


#45639

Fromlehs <skydda.barnen@gmail.com>
Date2016-02-20 01:00 -0800
Message-ID<efaed96e-37b8-466a-88fa-06f0cc87d6d0@googlegroups.com>
In reply to#45638
Den lördag 20 februari 2016 kl. 08:41:54 UTC+1 skrev lehs:
> Den fredag 19 februari 2016 kl. 22:14:28 UTC+1 skrev WJ:
> > A Ruby version which seems to be correct; the ANS Forth versions
> > will have to be provided by others.
> > 
> > def tsort edges
> >   leaders = edges.map(&:first).uniq
> >   followers = edges.flat_map{|x| x.drop(1)}.uniq
> >   visited = []
> >   ordering = []
> >   packs =
> >     leaders.map{|leader|
> >       [leader] +
> >         edges.flat_map{|edge| leader==edge[0] ? edge.drop(1) : []}}
> >   dfs = lambda{|v|
> >     visited.unshift(v)
> >     pack = packs.assoc(v)
> >     if pack
> >       pack.drop(1).each{|n| dfs[n] unless visited.include?(n)}
> >     end
> >     ordering.unshift(v)}
> >   (leaders - followers).each{|x| dfs[x]}
> >   ordering
> > end
> > 
> > tsort [[:the,:issue],[:not,:trying],[:confuse,:the],[:am,:trying],[:trying,:to],
> >  [:am,:not],[:trying,:the],[:to,:confuse],[:i,:am]]
> > 
> >  ===>
> > [:i, :am, :not, :trying, :to, :confuse, :the, :issue]
> > 
> > 
> > tsort [[:shirt,:tie,:belt],[:tie,:jacket],[:belt,:jacket],[:watch],
> >   [:pants,:shoes,:belt],[:undershorts,:pants,:shoes],[:socks,:shoes]]
> > 
> >  ===>
> > [:socks, :undershorts, :pants, :shoes, :watch, :shirt, :belt, :tie, :jacket]
> > 
> > 
> > -- 
> > Man is a social animal just like ants or bees or wolves.  All have their living
> > space, which they defend to the very end.
> > http://www.kolumbus.fi/aquilon/aquilon_quot1.htm
> 
> Since Forth is a kind of macro assembler you'll have to define some kind of lists and sets and then use e.g. Kahn's algorithm.
> 
> In Zet directed graphs are subsets of the Cartesian product ExE of the edge set and this will be a nice task to solve.
> 
> https://github.com/Lehs/ZET
> --
> Mankind has developed to a level where it is possible to be liberated from the slavery of the genes. We don't have to compete and conquer, we can choose to be friendly and to do what is right. The human body is a master among servants but shouldn't serve us by being our masters.

A typo above: a directed graph is a subset of VxV, where V is the vertex set.

[toc] | [prev] | [next] | [standalone]


#45640

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-02-20 11:13 +0000
Message-ID<2016Feb20.121311@mips.complang.tuwien.ac.at>
In reply to#45638
lehs <skydda.barnen@gmail.com> writes:
>Since Forth is a kind of macro assembler you'll have to define some kind of=
> lists and sets and then use e.g. Kahn's algorithm.

For some values of "some kind of".  There are no sets or lists in the
usual sense in the following program:

: node ( "name" -- )
    create
    true ,
    ['] noop ,
  does> ( -- )
     dup @ if
	false over !
	dup cell+ @ execute
	body> >name name>string type space
    else
	drop then ;

: before ( xt "name" -- )
    ' >body cell+ ! ;

\ nodes
node shirt
node tie
node belt
node jacket
node watch
node pants
node shoes
node undershorts
node socks

\ edges
:noname shirt ; before tie
:noname shirt pants ; before belt
:noname tie belt ; before jacket
:noname pants undershorts socks ; before shoes
:noname undershorts ; before pants

\ now sort the nodes:
shirt tie belt jacket watch pants shoes undershorts socks
cr bye

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[toc] | [prev] | [next] | [standalone]


#45641

Fromlehs <skydda.barnen@gmail.com>
Date2016-02-20 10:39 -0800
Message-ID<84b127df-710c-4635-b4f8-89af6c0b42ac@googlegroups.com>
In reply to#45640
Den lördag 20 februari 2016 kl. 13:27:34 UTC+1 skrev Anton Ertl:
> lehs <skydda.barnen@gmail.com> writes:
> >Since Forth is a kind of macro assembler you'll have to define some kind of=
> > lists and sets and then use e.g. Kahn's algorithm.
> 
> For some values of "some kind of".  There are no sets or lists in the
> usual sense in the following program:
> 
> : node ( "name" -- )
>     create
>     true ,
>     ['] noop ,
>   does> ( -- )
>      dup @ if
> 	false over !
> 	dup cell+ @ execute
> 	body> >name name>string type space
>     else
> 	drop then ;
> 
> : before ( xt "name" -- )
>     ' >body cell+ ! ;
> 
> \ nodes
> node shirt
> node tie
> node belt
> node jacket
> node watch
> node pants
> node shoes
> node undershorts
> node socks
> 
> \ edges
> :noname shirt ; before tie
> :noname shirt pants ; before belt
> :noname tie belt ; before jacket
> :noname pants undershorts socks ; before shoes
> :noname undershorts ; before pants
> 
> \ now sort the nodes:
> shirt tie belt jacket watch pants shoes undershorts socks
> cr bye
> 
> - anton
> -- 
> M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
> comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
>      New standard: http://www.forth200x.org/forth200x.html
>    EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

Nice! A had a vision of generality when I wrote "some kind of", a vague vision of references or something...

[toc] | [prev] | [next] | [standalone]


#45668 — Rosettacode topological sort (was: Topological sort)

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-02-22 07:54 +0000
SubjectRosettacode topological sort (was: Topological sort)
Message-ID<2016Feb22.085456@mips.complang.tuwien.ac.at>
In reply to#45640
I found that Rosettacode also has a "topological" sort task
<https://rosettacode.org/wiki/Topological_sort>, which is a bit
different from the task I solved earlier.  I also came up with an idea
of how to get rid of the flag field and the IF in NODE.

The task description is about the compiling order of libraries and contains the following additional requirements:

* Assume library names are single words.
* Items mentioned as only dependants, (sic), have no dependants of
  their own, but their order of compiling must be given.
* Any self dependencies should be ignored.
* Any un-orderable dependencies should be flagged.

So I decided to do some syntactic sugar that accepts input similar
to the example given (line-oriented input with the dependent
(after-node) at the start followed by dependencies (before-nodes)).

Implementation: Each node (with dependencies) goes through three
states: At the start, it contains an xt that calls all before-nodes.
At the start of that, the xt called by the node changes to
PROCESSING; if that is ever called, there is a cycle (or
self-reference), and if it is not a self-reference, the cycle is
printed.  When the processing of the before-nodes is complete, the
present node is printed, and the xt changes to DROP, so any further
processing of the node does nothing.

This implements depth-first search
<https://en.wikipedia.org/wiki/Topological_sorting#Depth-first_search>,
with PROCESSING being the temporary mark, and DROP being the permanent
mark.

The cool thing about this implementation is that we don't need a
single conditional branch for topologically sorting the dependencies
of a single node; there are a few for deciding what to output on a
cycle, but if we are happy with more primitive output, we can get rid
of that; we do have EXECUTE instead, so we don't get rid of branch
mispredictions, but given our representation of the dependencies, we
need the indirect branch anyway.

A special feature is that we can recognize self-references and print
cycles without building an extra data structure, because the chain
of nodes we are looking at is on the data stack (this is not very
idiomatic in Forth).

Another Forth feature is that we use the dictionary as symbol table
for input processing: Each node is turned into a Forth word.  Also,
the list of dependencies is turned into an anonymous colon
definition rather than some list or array.

This code uses a number of Gforth extensions, some just as minor
conveniences, some more substantial (although nothing that could not
be replaced with a few lines of standard code; still, if you replace
all of them, the code becomes considerably bigger.  If you think
that these conveniences are unnecessary, do the conversion as an
exercise.  I am happy to assist in explaining the meaning of the
extensions.

An additional feature that Gforth does not have yet and that would be
beneficial here would be to have several dictionary section to which
code and words can be added alternatingly or at least in a nested way.
If Gforth had that, I would have replaced the linked list of nodes and
ALL-NODES with a colon definition calling all the nodes.

- anton
------------------------------------------------
variable nodes 0 nodes ! \ linked list of nodes

: node. ( body -- )
    body> >name name>string type ;

: nodeps ( body -- )
    \ the word referenced by body has no (more) dependencies to resolve
    ['] drop over ! node. space ;

: processing ( body1 ... bodyn body -- body1 ... bodyn )
    \ the word referenced by body is in the middle of resolving dependencies
    2dup <> if \ unless it is a self-reference (see task description)
	['] drop over !
	." (cycle: " dup node. >r 1 begin \ print the cycle
	    dup pick dup r@ <> while
		space node. 1+ repeat
	." ) " 2drop r>
	then drop ;

: >processing ( body -- body )
    ['] processing over ! ;

: node ( "name" -- )
    \ define node "name" and initialize it to having no dependences
    create
    ['] nodeps , \ on definition, a node has no dependencies
    nodes @ , lastxt nodes ! \ linked list of nodes
  does> ( -- )
    dup @ execute ; \ perform xt associated with node

: define-nodes ( "names" <newline> -- )
    \ define all the names that don't exist yet as nodes
    begin
	parse-name dup while
	    2dup find-name 0= if
		2dup nextname node then
	    2drop repeat
    2drop ;

: deps ( "name" "deps" <newline> -- )
    \ name is after deps.  Implementation: Define missing nodes, then
    \ define a colon definition for 
    >in @ define-nodes >in !
    ' :noname ]] >processing [[ source >in @ /string evaluate ]] nodeps ; [[
    swap >body ! 0 parse 2drop ;

: all-nodes ( -- )
    \ call all nodes, and they then print their dependences and themselves
    nodes begin
	@ dup while
	    dup execute
	    >body cell+ repeat
    drop ;

deps des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
deps dw01           ieee dw01 dware gtech
deps dw02           ieee dw02 dware
deps dw03           std synopsys dware dw03 dw02 dw01 ieee gtech
deps dw04           dw04 ieee dw01 dware gtech
deps dw05           dw05 ieee dware
deps dw06           dw06 ieee dware
deps dw07           ieee dware
deps dware          ieee dware
deps gtech          ieee gtech
deps ramlib         std ieee
deps std_cell_lib   ieee std_cell_lib
deps synopsys
\ to test the cycle recognition (overwrites dependences for dw1 above)
deps dw01           ieee dw01 dware gtech dw04

all-nodes cr

[toc] | [prev] | [next] | [standalone]


#45671 — Re: Rosettacode topological sort (was: Topological sort)

FromAlbert van der Horst <albert@spenarnc.xs4all.nl>
Date2016-02-22 10:04 +0000
SubjectRe: Rosettacode topological sort (was: Topological sort)
Message-ID<56cadd25$0$24128$e4fe514c@news.xs4all.nl>
In reply to#45668
anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:

>An additional feature that Gforth does not have yet and that would be
>beneficial here would be to have several dictionary section to which
>code and words can be added alternatingly or at least in a nested way.

But we have that! That is called wordlists and they are invented
to deal with the situation of libraries that may or may not be included,
and may or may not be used.

>If Gforth had that, I would have replaced the linked list of nodes and
>ALL-NODES with a colon definition calling all the nodes.

<SNIP>
>deps des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee

>deps dw01           ieee dw01 dware gtech
>deps dw02           ieee dw02 dware
>deps dw03           std synopsys dware dw03 dw02 dw01 ieee gtech
>deps dw04           dw04 ieee dw01 dware gtech
>deps dw05           dw05 ieee dware
>deps dw06           dw06 ieee dware
>deps dw07           ieee dware
>deps dware          ieee dware
>deps gtech          ieee gtech
>deps ramlib         std ieee
>deps std_cell_lib   ieee std_cell_lib
>deps synopsys

If we assume dw01 etc, are facilities that can be REQUIRED
this dw01 could contain
REQUIRE ieee
REQUIRE dw01
..

So in Forth the job would be done automatically.
This is superior, as libraries may be sorted differently
for different situations (processors/OS-es). REQUIRE takes
care of that.

(A similar mechanism is present in ciforth called WANT.
It does away with library names, like the filenames of
REQUIRE . WANT only deals in word names. )

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]


#45673 — Re: Rosettacode topological sort (was: Topological sort)

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2016-02-22 12:26 +0000
SubjectRe: Rosettacode topological sort (was: Topological sort)
Message-ID<2016Feb22.132624@mips.complang.tuwien.ac.at>
In reply to#45671
Albert van der Horst <albert@spenarnc.xs4all.nl> writes:
>anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>
>>An additional feature that Gforth does not have yet and that would be
>>beneficial here would be to have several dictionary section to which
>>code and words can be added alternatingly or at least in a nested way.
>
>But we have that! That is called wordlists and they are invented
>to deal with the situation of libraries that may or may not be included,
>and may or may not be used.

Wordlists don't allow you to, e.g., define new words in the middle of
a colon definition.

>If we assume dw01 etc, are facilities that can be REQUIRED
>this dw01 could contain
>REQUIRE ieee
>REQUIRE dw01
>..
>
>So in Forth the job would be done automatically.

At least in Forth as I use it.  But then there are those who say that
we don't need REQUIRE, because load screens work fine and require less
support from the Forth system.  So, if you have a system without
REQUIRE/REQUIRED (such as SwiftForth 3.4.8a), you could use such a
tool to create a file equivalent of a load screen.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[toc] | [prev] | [next] | [standalone]


#45675 — Re: Rosettacode topological sort (was: Topological sort)

FromAlbert van der Horst <albert@spenarnc.xs4all.nl>
Date2016-02-22 13:28 +0000
SubjectRe: Rosettacode topological sort (was: Topological sort)
Message-ID<56cb0d04$0$24056$e4fe514c@news.xs4all.nl>
In reply to#45673
anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:

>Albert van der Horst <albert@spenarnc.xs4all.nl> writes:
<SNIP>
>>So in Forth the job would be done automatically.

>At least in Forth as I use it.  But then there are those who say that
>we don't need REQUIRE, because load screens work fine and require less
>support from the Forth system.  So, if you have a system without
>REQUIRE/REQUIRED (such as SwiftForth 3.4.8a), you could use such a
>tool to create a file equivalent of a load screen.

WANT is an alternative to REQUIRE if you prefer having the low level
libraries in a block file.
(no hooks in the kernel, WANT itself is just one screen)
I can't believe that one would still use load screens, except in
such cases as an MS-DOS floppy system where sequentially inspecting
index lines is cumbersome (but not prohibitively so.) or if one
can't spare the .5 Kbyte for the facility (1.5 on 64 bit systems).

>- anton

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]


#45688

Fromlehs <skydda.barnen@gmail.com>
Date2016-02-23 01:12 -0800
Message-ID<f2a55862-0989-43f6-9757-1aa28ff148e5@googlegroups.com>
In reply to#45638
Den lördag 20 februari 2016 kl. 08:41:54 UTC+1 skrev lehs:
> Den fredag 19 februari 2016 kl. 22:14:28 UTC+1 skrev WJ:
> > A Ruby version which seems to be correct; the ANS Forth versions
> > will have to be provided by others.
> > 
> > def tsort edges
> >   leaders = edges.map(&:first).uniq
> >   followers = edges.flat_map{|x| x.drop(1)}.uniq
> >   visited = []
> >   ordering = []
> >   packs =
> >     leaders.map{|leader|
> >       [leader] +
> >         edges.flat_map{|edge| leader==edge[0] ? edge.drop(1) : []}}
> >   dfs = lambda{|v|
> >     visited.unshift(v)
> >     pack = packs.assoc(v)
> >     if pack
> >       pack.drop(1).each{|n| dfs[n] unless visited.include?(n)}
> >     end
> >     ordering.unshift(v)}
> >   (leaders - followers).each{|x| dfs[x]}
> >   ordering
> > end
> > 
> > tsort [[:the,:issue],[:not,:trying],[:confuse,:the],[:am,:trying],[:trying,:to],
> >  [:am,:not],[:trying,:the],[:to,:confuse],[:i,:am]]
> > 
> >  ===>
> > [:i, :am, :not, :trying, :to, :confuse, :the, :issue]
> > 
> > 
> > tsort [[:shirt,:tie,:belt],[:tie,:jacket],[:belt,:jacket],[:watch],
> >   [:pants,:shoes,:belt],[:undershorts,:pants,:shoes],[:socks,:shoes]]
> > 
> >  ===>
> > [:socks, :undershorts, :pants, :shoes, :watch, :shirt, :belt, :tie, :jacket]
> > 
> > 
> > -- 
> > Man is a social animal just like ants or bees or wolves.  All have their living
> > space, which they defend to the very end.
> > http://www.kolumbus.fi/aquilon/aquilon_quot1.htm
> 
> Since Forth is a kind of macro assembler you'll have to define some kind of lists and sets and then use e.g. Kahn's algorithm.
> 
> In Zet directed graphs are subsets of the Cartesian product ExE of the edge set and this will be a nice task to solve.
> 
> https://github.com/Lehs/ZET
> --
> Mankind has developed to a level where it is possible to be liberated from the slavery of the genes. We don't have to compete and conquer, we can choose to be friendly and to do what is right. The human body is a master among servants but shouldn't serve us by being our masters.

Topological sort in Zet

: toposort \ (V,E) -- s
  0 >xst                           \ empty set in x
  zdup sourceset zst yst setmove   \ source nodes in y
  unfence znip                     \ drop V keep E
  begin yst@                       \ while source nodes left
  while ysplit yst> dup            \ remove node m
     zdup >zst zfence zdup xzmerge \ add m to the set in x
     subimage                      \ set of all n: m→n
     begin zst@                    \ while that set non empty
     while zsplit zst> zswap       \ remove node n, E tos
        2dup ipair zfence diff     \ E:=E\{(m,n)}
        dup zdup >zst zfence       \ build set of all nodes..
        subcoimage zst@ 0=         \ ..pointing at n
        if >yst yfence ymerge      \ add n to y-set if empty
        else drop                  \ else drop n
        then zdrop zswap           \ drop set, swap E back
     repeat zdrop drop             \ drop empty set and node m
  repeat yst> drop zst@ zdrop      \ drop empty set and E
  if xst setdrop 0 >zst            \ if |E|>0 flag with empty set
  else xst zst setmove             \ else move the x-set to zst
     zst> 1- >zst                  \ mark it as ordered list
  then ;

[toc] | [prev] | [next] | [standalone]


#45691

Fromlehs <skydda.barnen@gmail.com>
Date2016-02-23 10:56 -0800
Message-ID<2e82acac-3df8-481e-b50d-c4dd9ed59fc6@googlegroups.com>
In reply to#45638
Den lördag 20 februari 2016 kl. 08:41:54 UTC+1 skrev lehs:
> Den fredag 19 februari 2016 kl. 22:14:28 UTC+1 skrev WJ:
> > A Ruby version which seems to be correct; the ANS Forth versions
> > will have to be provided by others.
> > 
> > def tsort edges
> >   leaders = edges.map(&:first).uniq
> >   followers = edges.flat_map{|x| x.drop(1)}.uniq
> >   visited = []
> >   ordering = []
> >   packs =
> >     leaders.map{|leader|
> >       [leader] +
> >         edges.flat_map{|edge| leader==edge[0] ? edge.drop(1) : []}}
> >   dfs = lambda{|v|
> >     visited.unshift(v)
> >     pack = packs.assoc(v)
> >     if pack
> >       pack.drop(1).each{|n| dfs[n] unless visited.include?(n)}
> >     end
> >     ordering.unshift(v)}
> >   (leaders - followers).each{|x| dfs[x]}
> >   ordering
> > end
> > 
> > tsort [[:the,:issue],[:not,:trying],[:confuse,:the],[:am,:trying],[:trying,:to],
> >  [:am,:not],[:trying,:the],[:to,:confuse],[:i,:am]]
> > 
> >  ===>
> > [:i, :am, :not, :trying, :to, :confuse, :the, :issue]
> > 
> > 
> > tsort [[:shirt,:tie,:belt],[:tie,:jacket],[:belt,:jacket],[:watch],
> >   [:pants,:shoes,:belt],[:undershorts,:pants,:shoes],[:socks,:shoes]]
> > 
> >  ===>
> > [:socks, :undershorts, :pants, :shoes, :watch, :shirt, :belt, :tie, :jacket]
> > 
> > 
> > -- 
> > Man is a social animal just like ants or bees or wolves.  All have their living
> > space, which they defend to the very end.
> > http://www.kolumbus.fi/aquilon/aquilon_quot1.htm
> 
> Since Forth is a kind of macro assembler you'll have to define some kind of lists and sets and then use e.g. Kahn's algorithm.
> 
> In Zet directed graphs are subsets of the Cartesian product ExE of the edge set and this will be a nice task to solve.
> 
> https://github.com/Lehs/ZET
> --
> Mankind has developed to a level where it is possible to be liberated from the slavery of the genes. We don't have to compete and conquer, we can choose to be friendly and to do what is right. The human body is a master among servants but shouldn't serve us by being our masters.

My toposort is now on my blog:

http://forthmath.blogspot.se/2016/02/directed-graphs.html

--
Some people are full of hatred and lies and longing for war to get the opportunity of looting and raping. They are not only loveless but also hate love.

[toc] | [prev] | [standalone]


Back to top | Article view | comp.lang.forth


csiph-web