*      Knapsack problem/0-1      16/02/2017
KNAPSA01 CSECT
       USING  KNAPSA01,R13
       B      72(R15)
       DC     17F'0'
       STM    R14,R12,12(R13)
       ST     R13,4(R15)
       ST     R15,8(R13)
       LR     R13,R15            end of prolog
       L      R0,N               n
       LA     R1,1
POWER  MH     R1,=H'2'           *2
       BCT    R0,POWER
       BCTR   R1,0               -1
       ST     R1,IMAX            imax=2**n-1
       SR     R6,R6              i=0
       DO WHILE=(C,R6,LE,IMAX)   do i=0 to imax
         SR     R10,R10            im=0
         SR     R8,R8              iw=0
         SR     R9,R9              iv=0
         LA     R7,1               j=1
         DO WHILE=(C,R7,LE,N)      do j=1 to n
           LR     R1,R6              i
           LR     R2,R7              j
           BAL    R14,TSTBIT         call tstbit(i,j)
           IF C,R0,EQ,=F'1' THEN     if tstbit(i,j)=1 then
             LA     R10,1(R10)         im=im+1
             LR     R3,R7              j
             BCTR   R3,0
             SLA    R3,5
             LA     R1,24(R3)
             A      R8,DATA(R1)        iw=iw+data(j).w
             LA     R1,28(R3)
             A      R9,DATA(R1)        iv=iv+data(j).v
           ENDIF  ,                  endif
           LA     R7,1(R7)           j=j+1
         ENDDO  ,                  enddo j
         IF C,R8,LE,MAXW,AND,C,R9,GT,XV THEN  if w<=maxw and iv>xv then
           ST     R6,XB              xb=i
           ST     R10,XM             xm=im
           ST     R8,XW              xw=iw
           ST     R9,XV              xv=iv
         ENDIF  ,                  endif
         LA     R6,1(R6)           i=i+1
       ENDDO  ,                  enddo i
       MVC    PG(2),=C'n='
       L      R1,N               n
       XDECO  R1,XDEC            edit n
       MVC    PG+2(2),XDEC+10
       XPRNT  PG,L'PG            print buffer
       LA     R6,1
       DO WHILE=(C,R6,LE,N)      do i=1 to n
         L      R1,XB              xb
         LR     R2,R6              i
         BAL    R14,TSTBIT         call tstbit(xb,i)
         IF C,R0,EQ,=F'1' THEN     if tstbit(xb,i)=1 then
           LR     R1,R6              i
           BCTR   R1,0
           SLA    R1,5
           LA     R2,DATA(R1)        @data(i).n
           MVC    PG(24),0(R2)
           XPRNT  PG,24              print item
         ENDIF  ,                  endif
         LA     R6,1(R6)           i=i+1
       ENDDO  ,                  enddo i
       L      R1,XM              xm
       XDECO  R1,XDEC            edit xm
       MVC    PGT+6(2),XDEC+10
       L      R1,XW              xw
       XDECO  R1,XDEC            edit xw
       MVC    PGT+16(3),XDEC+9
       L      R1,XV              xv
       XDECO  R1,XDEC            edit xv
       MVC    PGT+26(4),XDEC+8
       XPRNT  PGT,L'PGT          print buffer
       L      R13,4(0,R13)       epilog
       LM     R14,R12,12(R13)
       XR     R15,R15
       BR     R14                exit
TSTBIT EQU    *                  R1 value to test the R2 bit
       LA     R3,32              32
       SR     R3,R2              (32-i)
       STC    R3,XSLL+3
       LR     R0,R1              n
       EX     0,XSLL             SLL R0,(32-i)
       SRL    R0,31
       BR     R14                return R0
XSLL   SLL    R0,0               shift left logical
*
MAXW   DC     F'400'             maximum weight
N      DC     A((DATAE-DATA)/32)
IMAX   DS     F                  number of combinations
XB     DS     F                  max vector
XM     DS     F                  max items
XW     DS     F                  max weight
XV     DS     F                  max value
PG     DC     CL80' '
PGT    DC     CL32'items=.. weight=... value=....'
XDEC   DS     CL12
DATA   DC     CL24'map',F'9',F'150'
       DC     CL24'compass',F'13',F'35'
       DC     CL24'water',F'153',F'200'
       DC     CL24'sandwich',F'50',F'160'
       DC     CL24'glucose',F'15',F'60'
       DC     CL24'tin',F'68',F'45'
       DC     CL24'banana',F'27',F'60'
       DC     CL24'apple',F'39',F'40'
       DC     CL24'cheese',F'23',F'30'
       DC     CL24'beer',F'52',F'10'
       DC     CL24'suntan cream',F'11',F'70'
       DC     CL24'camera',F'32',F'30'
       DC     CL24'T-shirt',F'24',F'15'
       DC     CL24'trousers',F'48',F'10'
       DC     CL24'umbrella',F'73',F'40'
       DC     CL24'book',F'30',F'10'
       DC     CL24'waterproof trousers',F'42',F'70'
       DC     CL24'waterproof overclothes',F'43',F'75'
       DC     CL24'note-case',F'22',F'80'
       DC     CL24'sunglasses',F'7',F'20'
       DC     CL24'towel',F'18',F'12'
       DC     CL24'socks',F'4',F'50'
DATAE  DC     0C
       YREGS
       END    KNAPSA01