Set: Difference between revisions
Content added Content deleted
(Added solution for Action!) |
|||
Line 78: | Line 78: | ||
Set([1, 2, 3, 4, 99]) |
Set([1, 2, 3, 4, 99]) |
||
Set([1, 2, 3, 4]) |
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> |
</pre> |
||