Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #45629 > unrolled thread
| Started by | "WJ" <w_a_x_man@yahoo.com> |
|---|---|
| First post | 2016-02-19 21:11 +0000 |
| Last post | 2016-02-23 10:56 -0800 |
| Articles | 11 — 4 participants |
Back to article view | Back to comp.lang.forth
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
| From | "WJ" <w_a_x_man@yahoo.com> |
|---|---|
| Date | 2016-02-19 21:11 +0000 |
| Subject | Topological 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]
| From | lehs <skydda.barnen@gmail.com> |
|---|---|
| Date | 2016-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]
| From | lehs <skydda.barnen@gmail.com> |
|---|---|
| Date | 2016-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]
| From | anton@mips.complang.tuwien.ac.at (Anton Ertl) |
|---|---|
| Date | 2016-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]
| From | lehs <skydda.barnen@gmail.com> |
|---|---|
| Date | 2016-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]
| From | anton@mips.complang.tuwien.ac.at (Anton Ertl) |
|---|---|
| Date | 2016-02-22 07:54 +0000 |
| Subject | Rosettacode 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]
| From | Albert van der Horst <albert@spenarnc.xs4all.nl> |
|---|---|
| Date | 2016-02-22 10:04 +0000 |
| Subject | Re: 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]
| From | anton@mips.complang.tuwien.ac.at (Anton Ertl) |
|---|---|
| Date | 2016-02-22 12:26 +0000 |
| Subject | Re: 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]
| From | Albert van der Horst <albert@spenarnc.xs4all.nl> |
|---|---|
| Date | 2016-02-22 13:28 +0000 |
| Subject | Re: 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]
| From | lehs <skydda.barnen@gmail.com> |
|---|---|
| Date | 2016-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]
| From | lehs <skydda.barnen@gmail.com> |
|---|---|
| Date | 2016-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