all tasks

Task/Topological-sort/Haskell/topological-sort-1.hs

@@ -0,0 +1,39 @@
+import Data.List
+import Data.Maybe
+import Control.Arrow
+import System.Random
+import Control.Monad
+
+combs 0 _ = [[]]
+combs _ [] = []
+combs k (x:xs) = map (x:) (combs (k-1) xs) ++ combs k xs
+
+depLibs :: [(String, String)]
+depLibs = [("des_system_lib","std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee"),
+          ("dw01","ieee dw01 dware gtech"),
+          ("dw02","ieee dw02 dware"),
+          ("dw03","std synopsys dware dw03 dw02 dw01 ieee gtech"),
+          ("dw04","dw04 ieee dw01 dware gtech"),
+          ("dw05","dw05 ieee dware"),
+          ("dw06","dw06 ieee dware"),
+          ("dw07","ieee dware"),
+          ("dware","ieee dware"),
+          ("gtech","ieee gtech"),
+          ("ramlib","std ieee"),
+          ("std_cell_lib","ieee std_cell_lib"),
+          ("synopsys",[])]
+
+
+toposort xs
+      | (not.null) cycleDetect = error $ "Dependency cycle detected for libs " ++ show cycleDetect
+      | otherwise              = foldl makePrecede [] dB
+
+   where dB = map ((\(x,y) -> (x,y \\ x)). (return *** words)) xs
+
+         makePrecede ts ([x],xs)  = nub $ case elemIndex x ts of
+                                          Just i  -> uncurry(++) $ first(++xs) $ splitAt i ts
+                                          _       -> ts ++ xs ++ [x]
+
+         cycleDetect = filter ((>1).length)
+                       $ map (\[(a,as), (b,bs)] -> (a `intersect` bs) ++ (b `intersect`as))
+                       $ combs 2 dB

Task/Topological-sort/Haskell/topological-sort-2.hs

@@ -0,0 +1,5 @@
+*Main> toposort depLibs
+["std","synopsys","ieee","std_cell_lib","dware","dw02","gtech","dw01","ramlib","des_system_lib","dw03","dw04","dw05","dw06","dw07"]
+
+*Main> toposort $ (\(xs,(k,ks):ys) -> xs++ (k,ks++" dw04"):ys) $ splitAt 1  depLibs
+*** Exception: Dependency cycle detected for libs [["dw01","dw04"]]

Task/Topological-sort/Haskell/topological-sort-3.hs

@@ -0,0 +1,115 @@
+record graph(nodes,arcs)
+global ex_name, in_name
+
+procedure main()
+   show(tsort(getgraph()))
+end
+
+procedure tsort(g)
+   t := ""
+   while (n := g.nodes -- pnodes(g)) ~== "" do {
+      t ||:= "("||n||")"
+      g := delete(g,n)
+      }
+   if g.nodes == '' then return t
+   write("graph contains the cycle:")
+   write("\t",genpath(fn := !g.nodes,fn,g))
+end
+
+## pnodes(g) -- return the predecessor nodes of g
+#     (those that have an arc from them)
+procedure pnodes(g)
+   static labels, fromnodes
+   initial {
+           labels := &ucase
+           fromnodes := 'ACEGIKMOQSUWY'
+           }
+   return cset(select(g.arcs,labels, fromnodes))
+end
+
+## select(s,image,object) - efficient node selection
+procedure select(s,image,object)
+   slen := *s
+   ilen := *image
+   return if slen <= ilen then map(object[1+:slen/2],image[1+:slen],s)
+          else map(object,image,s[1+:ilen]) || select(s[1+ilen:0],image,object)
+end
+
+## delete(g,x) -- deletes all nodes in x from graph g
+#     note that arcs must be deleted as well
+procedure delete(g,x)
+   t := ""
+   g.arcs ? while arc := move(2) do if not upto(x,arc) then t ||:= arc
+   return graph(g.nodes--x,t)
+end
+
+
+## getgraph() -- read and construct a graph
+#      graph is described via sets of arcs, as in:
+#
+#           from to1 to2 to3
+#
+# external names are converted to single character names for efficiency
+# self-referential arcs are ignored
+procedure getgraph()
+   static labels
+   initial labels := &cset
+   ex_name := table()
+   in_name := table()
+   count := 0
+   arcstr := ""
+   nodes := ''
+   every line := !&input do {
+       nextWord := create genWords(line)
+       if nfrom := @nextWord then {
+           /in_name[nfrom] := &cset[count +:= 1]
+           /ex_name[in_name[nfrom]] := nfrom
+           nodes ++:= in_name[nfrom]
+           while nto := @nextWord do {
+               if nfrom ~== nto then {
+                   /in_name[nto] := &cset[count +:= 1]
+                   /ex_name[in_name[nto]] := nto
+                   nodes ++:= in_name[nto]
+                   arcstr ||:= in_name[nfrom] || in_name[nto]
+                   }
+               }
+           }
+       }
+   return graph(nodes,arcstr)
+end
+
+# generate all 'words' in string
+procedure genWords(s)
+    static wchars
+    initial wchars := &cset -- ' \t'
+    s ?  while tab(upto(wchars))\1 do suspend tab(many(wchars))\1
+end
+
+## show(t) - return the external names (in order) for the nodes in t
+#  Each output line contains names that are independent of each other
+procedure show(t)
+   line := ""
+   every n := !t do
+      case n of {
+         "(" : line ||:= "\n\t("
+         ")" : line[-1] := ")"
+         default : line ||:= ex_name[n] || " "
+      }
+   write(line)
+end
+
+## genpath(f,t,g) -- generate paths from f to t in g
+procedure genpath(f,t,g, seen)
+   /seen := ''
+   seen ++:= f
+   sn := nnodes(f,g)
+   if t ** sn == t then return ex_name[f] || " -> " || ex_name[t]
+   suspend ex_name[f] || " -> " || genpath(!(sn --seen),t,g,seen)
+end
+
+## nnodes(f,g) -- compute all nodes that could follow f in g
+procedure nnodes(f,g)
+   t := ''
+   g.arcs ? while arc := move(2) do if arc[1] == f then t ++:= arc[2]
+   return t
+end

Task/Topological-sort/Haskell/topological-sort-4.hs

@@ -0,0 +1,87 @@
+record graph(nodes,arcs)
+
+procedure main()
+   show(tsort(getgraph()))
+end
+
+procedure tsort(g)
+   t := []
+   while *(n := g.nodes -- pnodes(g)) > 0 do {
+      every put(p := [], !n)
+      put(t, p)
+      g := delete(g,n)
+      }
+   if *g.nodes = 0 then return t
+   write("graph contains the cycle:")
+   write("\t",genpath(fn := !g.nodes,fn,g))
+end
+
+procedure pnodes(g)
+   cp := create !g.arcs
+   every insert(p := set(), |1(@cp,@cp))
+   return p
+end
+
+procedure delete(g,x)
+   arcs := []
+   cp := create !g.arcs
+   while (f := @cp, t := @cp) do {
+        if !x == (f|t) then next
+        every put(arcs,f|t)
+        }
+   return graph(g.nodes--x, arcs)
+end
+
+procedure getgraph()
+   arcs := []
+   nodes := set()
+   every line := !&input do {
+       nextWord := create genWords(line)
+       if nfrom := @nextWord then {
+           insert(nodes, nfrom)
+           while nto := @nextWord do {
+               if nfrom ~== nto then {
+                   insert(nodes, nto)
+                   every put(arcs, nfrom | nto)
+                   }
+               }
+           }
+       }
+   return graph(nodes,arcs)
+end
+
+procedure genWords(s)
+    static wchars
+    initial wchars := &cset -- ' \t'
+    s ?  while tab(upto(wchars))\1 do suspend tab(many(wchars))\1
+end
+
+procedure show(t)
+   line := ""
+   every n := !t do
+      case type(n) of {
+         "list" : line ||:= "\n\t("||toString(n)||")"
+         default : line ||:= " "||n
+         }
+   write(line)
+end
+
+procedure toString(n)
+   every (s := "") ||:= !n || " "
+   return s[1:-1] | s
+end
+
+procedure genpath(f,t,g, seen)
+   /seen := set()
+   insert(seen, f)
+   sn := nnodes(f,g)
+   if member(sn, t) then return f || " -> " || t
+   suspend f || " -> " || genpath(!(sn--seen),t,g,seen)
+end
+
+procedure nnodes(f,g)
+   t := set()
+   cp := create !g.arcs
+   while (af := @cp, at := @cp) do if af == f then insert(t, at)
+   return t
+end