Set: Difference between revisions

5,882 bytes added ,  2 years ago
Added solution for Action!
(Added solution for Action!)
Line 78:
Set([1, 2, 3, 4, 99])
Set([1, 2, 3, 4])
</pre>
 
=={{header|Action!}}==
The user must type in the monitor the following command after compilation and before running the program!<pre>SET EndProg=*</pre>
{{libheader|Action! Tool Kit}}
<lang 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</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Set.png Screenshot from Atari 8-bit computer]
<pre>
A=(Action!, Basic, Ada, Fortran)
B=(Pascal, Action!, C++, C#)
C=(Basic, Fortran, Action!, Ada)
 
A contains Action!
B does not contain Fortran
Union A and B: D=(Action!, Basic, Ada, Fortran, Pascal, C++, C#)
Intersection A and B: D=(Action!)
Difference B-A: D=(Pascal, C++, C#)
D is not a subset of A
D is a subset of B
A and C are equal
B and C are not equal
D is not a proper subset of A
C is a proper subset of A
C-Fortran: C=(Basic, Action!, Ada)
C-C#: C=(Basic, Action!, Ada)
C+Java: C=(Basic, Action!, Ada, Java)
C+Java: C=(Basic, Action!, Ada, Java)
</pre>
 
Anonymous user