Subset sum problem: Difference between revisions

Added solution for Action!
(Added solution for Action!)
Line 145:
departure 952
deploy 44
</pre>
 
=={{header|Action!}}==
<lang Action!>DEFINE PTR="CARD"
DEFINE PAIR_SIZE="4"
 
TYPE Pair=[PTR word INT weight]
 
BYTE ARRAY pairs(200)
BYTE count=[0]
 
PTR FUNC GetPairAddr(INT index)
RETURN (pairs+index*PAIR_SIZE)
 
PROC PrintWords(BYTE ARRAY indices BYTE len)
Pair POINTER p
BYTE i
 
FOR i=0 TO len-1
DO
IF i>0 THEN Put(' ) FI
p=GetPairAddr(indices(i))
Print(p.word)
OD
PutE()
RETURN
 
PROC Append(CHAR ARRAY wrd INT wght)
Pair POINTER dst
 
dst=GetPairAddr(count)
dst.word=wrd
dst.weight=wght
count==+1
RETURN
 
PROC Init()
Append("alliance",-624) Append("archbishop",-915)
Append("balm",397) Append("bonnet",452)
Append("brute",870) Append("centipede",-658)
Append("cobol",362) Append("covariate",590)
Append("departure",952) Append("deploy",44)
Append("diophantine",645) Append("efferent",54)
Append("elysee",-326) Append("eradicate",376)
Append("escritoire",856) Append("exorcism",-983)
Append("fiat",170) Append("filmy",-874)
Append("flatworm",503) Append("gestapo",915)
Append("infra",-847) Append("isis",-982)
Append("lindholm",999) Append("markham",475)
Append("mincemeat",-880) Append("moresby",756)
Append("mycenae",183) Append("plugging",-266)
Append("smokescreen",423) Append("speakeasy",-745)
Append("vein",813)
RETURN
 
INT FUNC Sum(BYTE ARRAY indices BYTE len)
Pair POINTER p
INT sum
BYTE i
 
sum=0
FOR i=0 TO len-1
DO
p=GetPairAddr(indices(i))
sum==+p.weight
OD
RETURN (sum)
 
BYTE FUNC NextSubset(BYTE ARRAY indices BYTE len)
INT i,j
 
i=len-1
WHILE i>=0
DO
IF indices(i)#i+count-len THEN
indices(i)==+1
FOR j=i+1 TO len-1
DO
indices(j)=indices(j-1)+1
OD
RETURN (1)
FI
i==-1
OD
RETURN (0)
 
PROC Test(INT len)
BYTE ARRAY indices(100)
BYTE i
 
PrintF("%I: ",len)
FOR i=0 TO len-1
DO
indices(i)=i
OD
DO
IF Sum(indices,len)=0 THEN
PrintWords(indices,len) PutE()
RETURN
FI
IF NextSubset(indices,len)=0 THEN
PrintE("no subset") PutE()
RETURN
FI
OD
RETURN
 
PROC Main()
Init()
Test(2)
Test(3)
Test(4)
Test(5)
Test(10)
Test(27)
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Subset_sum_problem.png Screenshot from Atari 8-bit computer]
<pre>
2: archbishop gestapo
 
3: centipede markham mycenae
 
4: alliance balm deploy mycenae
 
5: alliance brute covariate deploy mincemeat
 
10: alliance archbishop balm bonnet brute centipede cobol departure deploy mincemeat
 
27: alliance archbishop balm bonnet brute centipede covariate departure deploy efferent elysee eradicate escritoire exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging smokescreen speakeasy
</pre>
 
Anonymous user