Subset sum problem: Difference between revisions

Content added Content deleted
m (→‎{{header|REXX}}: optimized the combN subroutine a small bit. -- ~~~~)
m (→‎{{header|REXX}}: made the compN subroutine faster. -- ~~~~)
Line 543: Line 543:
<br>This is a brute force solution.
<br>This is a brute force solution.
<lang rexx>/*REXX pgm finds some non-null subsets of a weighted list whose sum=0. */
<lang rexx>/*REXX pgm finds some non-null subsets of a weighted list whose sum=0. */
arg target stopAt . /*get arguments from command line*/

arg target stop . /*get arguments from command line*/
if target=='' then target=0 /*No TARGET given? Use default.*/
if target=='' then target=0 /*No TARGET given? Use default.*/
if stop=='' then stop=1 /*No max sols given? Use default.*/
if stopAt=='' then stopAt=1 /*No max sols given? Use default.*/


pairs= 'alliance -624 archbishop -915 balm 397' ,
zzz= 'alliance -624 archbishop -915 balm 397' ,
'bonnet 452 brute 870 centipede -658' ,
'bonnet 452 brute 870 centipede -658' ,
'cobol 362 covariate 590 departure 952' ,
'cobol 362 covariate 590 departure 952' ,
'deploy 44 diophantine 645 efferent 54' ,
'deploy 44 diophantine 645 efferent 54' ,
'elysee -326 eradicate 376 escritoire 856' ,
'elysee -326 eradicate 376 escritoire 856' ,
'exorcism -983 fiat 170 filmy -874' ,
'exorcism -983 fiat 170 filmy -874' ,
'flatworm 503 gestapo 915 infra -847' ,
'flatworm 503 gestapo 915 infra -847' ,
'isis -982 lindholm 999 markham 475' ,
'isis -982 lindholm 999 markham 475' ,
'mincemeat -880 moresby 756 mycenae 183' ,
'mincemeat -880 moresby 756 mycenae 183' ,
'plugging -266 smokescreen 423 speakeasy -745' ,
'plugging -266 smokescreen 423 speakeasy -745' ,
'vein 813'
'vein 813'


@.=0; y=0; do size=1 until pairs=''
@.=0; y=0; do N=1 until zzz=''; parse var zzz @.N #.N zzz
parse var pairs @.@.size @.size pairs
call tell right('['N']',30) right(@.N,11) right(#.N,5)
call tello right(@.size,9) @.@.size
end /*N*/
solutions=0
end /*size*/; @.0=target
call tell; call tell 'There are' N "entries in the table."
do chunk=1 for size

call combN size,chunk
do chunk=1 for N
call combN N,chunk
end /*chunk*/
end /*chunk*/


if @.sols==0 then @.sols='no'
if solutions==0 then solutions='no'
call tello 'Found' @.sols "subsets whose summed weights =" target
call tell 'Found' solutions "subsets whose summed weights =" target
exit
exit
/*─────────────────────────────────────telly subroutine─────────────────*/
/*─────────────────────────────────────tell subroutine──────────────────*/
telly: @.sols=@.sols+1; names=
telly: solutions=solutions+1; names=


do i=1 for y; o=!.i
do g=1 for y; o=!.g
names=names @.@.o
names=names @.o
/* names=names @.@.o '{'@.o"}" <─── weights in this REXX statement.*/
/* names=names @.o '{'#.o"}" <─── weights in this REXX statement.*/
end /*i*/
end /*g*/


call tello '['y" names]" space(names)
call tell '['y" names]" space(names)
if @.sols>=stop &,
if solutions>=stopAt &,
stop\==0 then do
stopAt\==0 then do
call tello 'Stopped after finding' @.sols "subsets."
call tell 'Stopped after finding' solutions "subsets."
exit
exit
end
end
return
return


tello: say arg(1);call lineout 'OUTPUT.'y,arg(1) /*write to file*/; return
tell: say arg(1); call lineout 'SUBSET.'y,arg(1) /*write to file*/; return
/*─────────────────────────────────────combN subroutine─────────────────*/
/*─────────────────────────────────────combN subroutine─────────────────*/
combN: procedure expose @.; parse arg x,y /*X items taken Y at a time.*/
combN: procedure expose @. #. solutions stopAt target; parse arg x,y; !.=0
!.=0; base=x+1; bbase=base-y; ym=y-1
base=x+1; bbase=base-y; ym=y-1 /*!.n are the combination digits*/

do i=1 for y; !.i=i; end /*i*/
do n=1 for y; !.n=n; end /*build 1st combination*/


do j=1; L=!.d; do d=2 for ym; L=L !.d; end /*d*/
do j=1; L=!.d; do d=2 for ym; L=L !.d; end /*d*/
_=!.1; s=@._
_=!.1; s=#._
do k=2 for ym; _=!.k; s=s+@._; end /*sum the weights.*/
do k=2 for y-1; _=!.k; s=s+#._; end /*sum the weights.*/
if s==@.0 then call telly /*element @.0 is the target sum.*/
if s==target then call telly
!.y=!.y+1; if !.y==base then if .combUp(ym) then leave
!.y=!.y+1; if !.y==base then if .combUp(ym) then leave
end
end


Line 603: Line 605:


.combUp: procedure expose !. y bbase; parse arg d; if d==0 then return 1
.combUp: procedure expose !. y bbase; parse arg d; if d==0 then return 1
p=!.d; do u=d to y; !.u=p+1
p=!.d; do u=d to y; !.u=p+1
if !.u>=bbase+u then return .combUp(u-1)
if !.u>=bbase+u then return .combUp(u-1)
p=!.u
p=!.u