RosettaCodeData/Task/Set/Action-/set.action

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