Data commit

Task/Set/Action-/set.action

@@ -0,0 +1,282 @@
+CARD EndProg ;required for ALLOCATE.ACT
+
+INCLUDE "D2:ALLOCATE.ACT" ;from the Action! Tool Kit. You must type 'SET EndProg=*' from the monitor after compiling, but before running this program!
+
+DEFINE PTR="CARD"
+DEFINE NODE_SIZE="6"
+TYPE SetNode=[PTR data,prv,nxt]
+TYPE SetInfo=[PTR name,begin,end]
+
+PROC PrintSet(SetInfo POINTER s)
+  SetNode POINTER n
+  CHAR ARRAY a
+
+  n=s.begin
+  PrintF("%S=(",s.name)
+  WHILE n
+  DO
+    Print(n.data)
+    a=n.data
+    IF n.nxt THEN
+      Print(", ")
+    FI
+    n=n.nxt
+  OD
+  PrintE(")")
+RETURN
+
+PROC CreateSet(SetInfo POINTER s CHAR ARRAY n)
+  s.name=n
+  s.begin=0
+  s.end=0
+RETURN
+
+PTR FUNC Find(SetInfo POINTER s CHAR ARRAY v)
+  SetNode POINTER n
+
+  n=s.begin
+  WHILE n
+  DO
+    IF SCompare(v,n.data)=0 THEN
+      RETURN (n)
+    FI
+    n=n.nxt
+  OD
+RETURN (0)
+
+BYTE FUNC Contains(SetInfo POINTER s CHAR ARRAY v)
+  SetNode POINTER n
+
+  n=Find(s,v)
+  IF n=0 THEN
+    RETURN (0)
+  FI
+RETURN (1)
+
+PROC Append(SetInfo POINTER s CHAR ARRAY v)
+  SetNode POINTER n,tmp
+
+  IF Contains(s,v) THEN RETURN FI
+
+  n=Alloc(NODE_SIZE)
+  n.data=v
+  n.prv=s.end
+  n.nxt=0
+  IF s.end THEN
+    tmp=s.end tmp.nxt=n
+  ELSE
+    s.begin=n
+  FI
+  s.end=n
+RETURN
+
+PROC Remove(SetInfo POINTER s CHAR ARRAY v)
+  SetNode POINTER n,prev,next
+
+  n=Find(s,v)
+  IF n=0 THEN RETURN FI
+
+  prev=n.prv
+  next=n.nxt
+
+  Free(n,NODE_SIZE)
+
+  IF prev THEN
+    prev.nxt=next
+  ELSE
+    s.begin=next
+  FI
+  IF next THEN
+    next.prv=prev
+  ELSE
+    s.end=prev
+  FI
+RETURN
+
+PROC AppendSet(SetInfo POINTER s,other)
+  SetNode POINTER n
+
+  n=other.begin
+  WHILE n
+  DO
+    Append(s,n.data)
+    n=n.nxt
+  OD
+RETURN
+
+PROC RemoveSet(SetInfo POINTER s,other)
+  SetNode POINTER n
+
+  n=other.begin
+  WHILE n
+  DO
+    Remove(s,n.data)
+    n=n.nxt
+  OD
+RETURN
+
+PROC Clear(SetInfo POINTER s)
+  SetNode POINTER n
+
+  DO
+    n=s.begin
+    IF n=0 THEN RETURN FI
+    Remove(s,n.data)
+  OD
+RETURN
+
+PROC Union(SetInfo POINTER a,b,res)
+  Clear(res)
+  AppendSet(res,a)
+  AppendSet(res,b)
+RETURN
+
+PROC Intersection(SetInfo POINTER a,b,res)
+  SetNode POINTER n
+
+  Clear(res)
+  n=a.begin
+  WHILE n
+  DO
+    IF Contains(b,n.data) THEN
+      Append(res,n.data)
+    FI
+    n=n.nxt
+  OD
+RETURN
+
+PROC Difference(SetInfo POINTER a,b,res)
+  Clear(res)
+  AppendSet(res,a)
+  RemoveSet(res,b)
+RETURN
+
+BYTE FUNC IsSubset(SetInfo POINTER s,sub)
+  SetNode POINTER n
+
+  n=sub.begin
+  WHILE n
+  DO
+    IF Contains(s,n.data)=0 THEN
+      RETURN (0)
+    FI
+    n=n.nxt
+  OD
+RETURN (1)
+
+BYTE FUNC AreEqual(SetInfo POINTER a,b)
+  IF IsSubset(a,b)=0 OR IsSubset(b,a)=0 THEN
+    RETURN (0)
+  FI
+RETURN (1)
+
+BYTE FUNC IsProperSubset(SetInfo POINTER s,sub)
+  IF IsSubset(s,sub)=1 AND IsSubset(sub,s)=0 THEN
+    RETURN (1)
+  FI
+RETURN (0)
+
+PROC TestContains(SetInfo POINTER s CHAR ARRAY v)
+  IF Contains(s,v) THEN
+    PrintF("%S contains %S%E",s.name,v)
+  ELSE
+    PrintF("%S does not contain %S%E",s.name,v)
+  FI
+RETURN
+
+PROC TestUnion(SetInfo POINTER a,b,res)
+  Union(a,b,res)
+  PrintF("Union %S and %S: ",a.name,b.name)
+  PrintSet(res)
+RETURN
+
+PROC TestIntersection(SetInfo POINTER a,b,res)
+  Intersection(a,b,res)
+  PrintF("Intersection %S and %S: ",a.name,b.name)
+  PrintSet(res)
+RETURN
+
+PROC TestDifference(SetInfo POINTER a,b,res)
+  Difference(a,b,res)
+  PrintF("Difference %S-%S: ",a.name,b.name)
+  PrintSet(res)
+RETURN
+
+PROC TestSubset(SetInfo POINTER s,sub)
+  IF IsSubset(s,sub) THEN
+    PrintF("%S is a subset of %S%E",sub.name,s.name)
+  ELSE
+    PrintF("%S is not a subset of %S%E",sub.name,s.name)
+  FI
+RETURN
+
+PROC TestEqual(SetInfo POINTER a,b)
+  IF AreEqual(a,b) THEN
+    PrintF("%S and %S are equal%E",a.name,b.name)
+  ELSE
+    PrintF("%S and %S are not equal%E",a.name,b.name)
+  FI
+RETURN
+
+PROC TestProperSubset(SetInfo POINTER s,sub)
+  IF IsSubset(s,sub) THEN
+    PrintF("%S is a proper subset of %S%E",sub.name,s.name)
+  ELSE
+    PrintF("%S is not a proper subset of %S%E",sub.name,s.name)
+  FI
+RETURN
+
+PROC TestAppend(SetInfo POINTER s CHAR ARRAY v)
+  Append(s,v)
+  PrintF("%S+%S: ",s.name,v)
+  PrintSet(s)
+RETURN
+
+PROC TestRemove(SetInfo POINTER s CHAR ARRAY v)
+  Remove(s,v)
+  PrintF("%S-%S: ",s.name,v)
+  PrintSet(s)
+RETURN
+
+PROC Main()
+  SetInfo s1,s2,s3,s4
+
+  Put(125) PutE() ;clear screen
+
+  AllocInit(0)
+  CreateSet(s1,"A")
+  CreateSet(s2,"B")
+  CreateSet(s3,"C")
+  CreateSet(s4,"D")
+
+  Append(s1,"Action!") Append(s1,"Basic")
+  Append(s1,"Ada") Append(s1,"Fortran")
+  Append(s2,"Pascal") Append(s2,"Action!")
+  Append(s2,"C++") Append(s2,"C#")
+  Append(s3,"Basic") Append(s3,"Fortran")
+  Append(s3,"Action!") Append(s3,"Ada")
+
+  PrintSet(s1) PrintSet(s2) PrintSet(s3)
+  PutE()
+
+  TestContains(s1,"Action!")
+  TestContains(s2,"Fortran")
+  TestUnion(s1,s2,s4)
+  TestIntersection(s1,s2,s4)
+  TestDifference(s2,s1,s4)
+  TestSubset(s1,s4)
+  TestSubset(s2,s4)
+  TestEqual(s1,s3)
+  TestEqual(s2,s3)
+  TestProperSubset(s1,s4)
+  TestProperSubset(s1,s3)
+  TestRemove(s3,"Fortran")
+  TestRemove(s3,"C#")
+  TestAppend(s3,"Java")
+  TestAppend(s3,"Java")
+
+  Clear(s1)
+  Clear(s2)
+  Clear(s3)
+  Clear(s4)
+RETURN