Knapsack problem/0-1: Difference between revisions
→{{header|FORTRAN}}
Bwana Pete (talk | contribs) |
|||
| (9 intermediate revisions by 5 users not shown) | |||
Line 2,003:
{{out}}
<pre>Tuple!(int, "tot", string[], "names")(1030, ["banana", "compass", "glucose", "map", "note-case", "sandwich", "socks", "sunglasses", "suntan cream", "water", "overclothes", "waterproof trousers"])</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
This is a good example of using an iterator. The problem involves looking at all different compinations of items in the list. If you increment a number up to a certain maximum, you systematically set all combination of bits in that number. The trick is turning the pattern of bits in a number into indices into the packing list. The iterater handles that and so it can be used in multiple places in the code to step through various the combinations of items in the list.
<syntaxhighlight lang="Delphi">
{Item to store data in}
type TPackItem = record
Name: string;
Weight,Value: integer;
end;
{List of items, weights and values}
const ItemsList: array [0..21] of TPackItem = (
(Name: 'map'; Weight: 9; Value: 150),
(Name: 'compass'; Weight: 13; Value: 35),
(Name: 'water'; Weight: 153; Value: 200),
(Name: 'sandwich'; Weight: 50; Value: 160),
(Name: 'glucose'; Weight: 15; Value: 60),
(Name: 'tin'; Weight: 68; Value: 45),
(Name: 'banana'; Weight: 27; Value: 60),
(Name: 'apple'; Weight: 39; Value: 40),
(Name: 'cheese'; Weight: 23; Value: 30),
(Name: 'beer'; Weight: 52; Value: 10),
(Name: 'suntan cream'; Weight: 11; Value: 70),
(Name: 'camera'; Weight: 32; Value: 30),
(Name: 't-shirt'; Weight: 24; Value: 15),
(Name: 'trousers'; Weight: 48; Value: 10),
(Name: 'umbrella'; Weight: 73; Value: 40),
(Name: 'waterproof trousers'; Weight: 42; Value: 70),
(Name: 'waterproof overclothes'; Weight: 43; Value: 75),
(Name: 'note-case'; Weight: 22; Value: 80),
(Name: 'sunglasses'; Weight: 7; Value: 20),
(Name: 'towel'; Weight: 18; Value: 12),
(Name: 'socks'; Weight: 4; Value: 50),
(Name: 'book'; Weight: 30; Value: 10));
{Iterater object to step through all the indices
{ corresponding to the bits in "N". This is used }
{ step through all the combinations of items }
type TBitIterator = class(TObject)
private
FNumber,FIndex: integer;
public
procedure Start(StartNumber: integer);
function Next(var Index: integer): boolean;
end;
procedure TBitIterator.Start(StartNumber: integer);
{Set the starting value of the number }
begin
FNumber:=StartNumber;
end;
function TBitIterator.Next(var Index: integer): boolean;
{Return the next available index}
begin
Result:=False;
while FNumber>0 do
begin
Result:=(FNumber and 1)=1;
if Result then Index:=FIndex;
FNumber:=FNumber shr 1;
Inc(FIndex);
if Result then break;
end;
end;
{=============================================================================}
procedure GetSums(N: integer; var Weight,Value: integer);
{Iterate through all indices corresponding to N}
{Get get the sum of their values}
var Inx: integer;
var BI: TBitIterator;
begin
BI:=TBitIterator.Create;
try
BI.Start(N);
Weight:=0; Value:=0;
while BI.Next(Inx) do
begin
Weight:=Weight+ItemsList[Inx].Weight;
Value:=Value+ItemsList[Inx].Value;
end;
finally BI.Free; end;
end;
procedure DoKnapsackProblem(Memo: TMemo);
{Find optimized solution to Knapsack problem}
{By iterating through all binary combinations}
var I,J,Inx: integer;
var Max: integer;
var WeightSum,ValueSum: integer;
var BestValue,BestIndex,BestWeight: integer;
var S: string;
var BI: TBitIterator;
begin
BI:=TBitIterator.Create;
try
{Get value that will cover all binary combinations}
Max:=1 shl Length(ItemsList)-1;
BestValue:=0;
{Iterate through all combinations of bits}
for I:=1 to Max do
begin
{Get the sum of the weights and values}
GetSums(I,WeightSum,ValueSum);
{Ignore any weight greater than 400}
if WeightSum>400 then continue;
{Test if this is the best value so far}
if ValueSum>BestValue then
begin
BestValue:=ValueSum;
BestWeight:=WeightSum;
BestIndex:=I;
end;
end;
{Display the best result}
Memo.Lines.Add(' Item Weight Value');
Memo.Lines.Add('---------------------------------------');
BI.Start(BestIndex);
while BI.Next(Inx) do
begin
S:=' '+Format('%-25s',[ItemsList[Inx].Name]);
S:=S+Format('%5d',[ItemsList[Inx].Weight]);
S:=S+Format('%7d',[ItemsList[Inx].Value]);
Memo.Lines.Add(S);
end;
Memo.Lines.Add('---------------------------------------');
Memo.Lines.Add(Format('Total %6d %6d',[BestWeight,BestValue]));
Memo.Lines.Add('Best Inx: '+IntToStr(BestIndex));
Memo.Lines.Add('Best Value: '+IntToStr(BestValue));
Memo.Lines.Add('Best Weight: '+IntToStr(BestWeight));
finally BI.Free; end;
end;
</syntaxhighlight>
{{out}}
<pre>
Item Weight Value
---------------------------------------
map 9 150
compass 13 35
water 153 200
sandwich 50 160
glucose 15 60
banana 27 60
suntan cream 11 70
waterproof trousers 42 70
waterproof overclothes 43 75
note-case 22 80
sunglasses 7 20
socks 4 50
---------------------------------------
Total 396 1030
Best Inx: 1541215
Best Value: 1030
Best Weight: 396
</pre>
=={{header|Dart}}==
Line 2,134 ⟶ 2,301:
max_w = 400
#
if i <= 0
wres = 0
vres = 0
items[] = [ ]
elif weight[i] > maxw
else
v1 += value[i]
if v1 > vres
swap items[] items1[]
items[] &= i
wres = w1 + weight[i]
vres = v1
.
.
.
print "weight: " & w
print "value: " & v
print "items:"
for
print " " & name$[
.
</syntaxhighlight>
Line 3,018 ⟶ 3,185:
socks
Weight: 396 Value: 1030
</pre>
# Numbered list item
=={{header|Fortran}}==
{{trans|Pascal}}
<syntaxhighlight lang="FORTRAN">
Program Knapsack01
! Translation of Pascal version on Rosetta Code.
implicit none
integer, parameter :: NUM_ITEMS = 22
integer, parameter :: MAX_WEIGHT = 400
type :: TItem
character(len=20) :: Name
integer :: Weight, Value
end type TItem
type(TItem), dimension(0:NUM_ITEMS-1) :: ITEMS
integer, dimension(0:NUM_ITEMS, 0:MAX_WEIGHT) :: D
integer :: I, W, V, MaxWeight
! Init Arrays
d = 0
ITEMS = [ TItem('compass', 13, 35), &
TItem('water', 153, 200), &
TItem('sandwich', 50, 160), &
TItem('glucose', 15, 60), &
TItem('tin', 68, 45), &
TItem('banana', 27, 60), &
TItem('apple', 39, 40), &
TItem('cheese', 23, 30), &
TItem('beer', 52, 10), &
TItem('suntan cream', 11, 70), &
TItem('camera', 32, 30), &
TItem('T-shirt', 24, 15), &
TItem('trousers', 48, 10), &
TItem('umbrella', 73, 40), &
TItem('waterproof trousers', 43, 70), &
TItem('waterproof overclothes', 42, 75), &
TItem('note-case', 22, 80), &
TItem('sunglasses', 7, 20), &
TItem('towel', 18, 12), &
TItem('map', 9, 150), &
TItem('socks', 4, 50), &
TItem('book', 30, 10) ]
!
do I = 0, NUM_ITEMS-1
do W = 0, MAX_WEIGHT
if (ITEMS(I)%Weight > W) then
D(I+1, W) = D(I, W)
else
D(I+1, W) = max(D(I, W), D(I, W - ITEMS(I)%Weight) + ITEMS(I)%Value)
end if
end do
end do
W = MAX_WEIGHT
V = D(NUM_ITEMS, W)
MaxWeight = 0
!
write(*, "(/,'bagged:')")
do I = NUM_ITEMS-1, 0, -1 !Pete
if (D(I+1, W) == V) then
if((D(I, (W - ITEMS(I)%Weight)) == V - ITEMS(I)%Value)) then
write(*, "(' ', A,t25,i0,t35,i0)", advance='yes') ITEMS(I)%Name,ITEMS(I)%weight,ITEMS(I)%value
MaxWeight = MaxWeight + ITEMS(I)%Weight
W = W - ITEMS(I)%Weight
V = V - ITEMS(I)%Value
end if
end if
end do
!
write(*, "('value = ', I0)") D(NUM_ITEMS, MAX_WEIGHT)
write(*, "('weight = ', I0)") MaxWeight
end program Knapsack01
</syntaxhighlight>
{{out}}
<pre>
bagged:
socks 4 50
map 9 150
sunglasses 7 20
note-case 22 80
waterproof overcloth 42 75
waterproof trousers 43 70
suntan cream 11 70
banana 27 60
glucose 15 60
sandwich 50 160
water 153 200
compass 13 35
value = 1030
weight = 396
knapsack time = 94 Milliseconds
</pre>
===Branch and Bound Version===
{{trans|Fortran 77}}
<syntaxhighlight lang="fortran">
module ksack2
!
! THIS SUBROUTINE SOLVES THE 0-1 SINGLE KNAPSACK PROBLEM
!
! MAXIMIZE Z = P(1)*X(1) + ... + P(N)*X(N)
!
! SUBJECT TO: W(1)*X(1) + ... + W(N)*X(N) .LE. C ,
! X(J) = 0 OR 1 FOR J=1,...,N.
!
! THE PROGRAM IS INCLUDED IN THE VOLUME
! S. MARTELLO, P. TOTH, "KNAPSACK PROBLEMS: ALGORITHMS
! AND COMPUTER IMPLEMENTATIONS", JOHN WILEY, 1990
! (https://dl.acm.org/doi/book/10.5555/98124)
! AND IMPLEMENTS THE BRANCH-AND-BOUND ALGORITHM DESCRIBED IN
! SECTION 2.5.2 .
! THE PROGRAM DERIVES FROM AN EARLIER CODE PRESENTED IN
! S. MARTELLO, P. TOTH, "ALGORITHM FOR THE SOLUTION OF THE 0-1 SINGLE
! KNAPSACK PROBLEM", COMPUTING, 1978.
! The orignal program was written in Fortran 77 and was an amazing tangle of GOTO statements.
! I have reworked the code in such a manner as to eliminate the GOTO statements and bring it
! to Fortran 2018 LANGUAGE compliance though the code logic remains somewhat untractable.
!
! The routine requires a large parameter string which includes 4 dummy arrays for it's calculations.
! As well, it offers an option to check the input data for correctness.
! Rather than modify the original algorithm, I wrote a simple wrapper called "start_knapsack" that
! allocates those arrays as well as defaulting the input parameter check to "on", hiding them from the user.
! Having said that, the algorithm works very well and is very fast. I've included it in this
! Rosetta Code listing because it scales well and can be used with a large dataset.
! Which a potential user may desire.
! Peter.kelly@acm.org (28-December-2023)
!
! THE INPUT PROBLEM MUST SATISFY THE CONDITIONS
!
! 1) 2 .LE. N .LE. JDIM - 1 ;
! 2) P(J), W(J), C POSITIVE INTEGERS;
! 3) MAX (W(J)) .LE. C ;
! 4) W(1) + ... + W(N) .GT. C ;
! 5) P(J)/W(J) .GE. P(J+1)/W(J+1) FOR J=1,...,N-1. <-- Note well. They need to be sorted in the greatest ratio of (p(j)/w(j)) down to the smallest one
!
! MT1 CALLS 1 PROCEDURE: CHMT1.
!
! MT1 NEEDS 8 ARRAYS ( P , W , X , XX , MIN , PSIGN , WSIGN
! AND ZSIGN ) OF LENGTH AT LEAST N + 1 .
!
! MEANING OF THE INPUT PARAMETERS:
! N = NUMBER OF ITEMS;
! P(J) = PROFIT OF ITEM J (J=1,...,N);
! W(J) = WEIGHT OF ITEM J (J=1,...,N);
! C = CAPACITY OF THE KNAPSACK;
! JDIM = DIMENSION OF THE 8 ARRAYS;
! JCK = 1 IF CHECK ON THE INPUT DATA IS DESIRED,
! = 0 OTHERWISE.
!
! MEANING OF THE OUTPUT PARAMETERS:
! Z = VALUE OF THE OPTIMAL SOLUTION IF Z .GT. 0 ,
! = ERROR IN THE INPUT DATA (WHEN JCK=1) IF Z .LT. 0 : CONDI-
! TION - Z IS VIOLATED;
! X(J) = 1 IF ITEM J IS IN THE OPTIMAL SOLUTION,
! = 0 OTHERWISE.
!
! ARRAYS XX, MIN, PSIGN, WSIGN AND ZSIGN ARE DUMMY.
!
! ALL THE PARAMETERS ARE INTEGER. ON RETURN OF MT1 ALL THE INPUT
! PARAMETERS ARE UNCHANGED.
!
implicit none
contains
subroutine mt1(n , p , w , c , z , x , jdim , jck , xx , min , psign , wsign , zsign)
implicit none
integer :: jdim
integer :: n
integer , intent(inout) , dimension(jdim) :: p
integer , intent(inout) , dimension(jdim) :: w
integer :: c
integer , intent(inout) :: z
integer , intent(out) , dimension(jdim) :: x
integer , intent(in) :: jck
integer , intent(inout) , dimension(jdim) :: xx
integer , intent(inout) , dimension(jdim) :: min
integer , intent(inout) , dimension(jdim) :: psign
integer , intent(inout) , dimension(jdim) :: wsign
integer , intent(inout) , dimension(jdim) :: zsign
!
real :: a
real :: b
integer :: ch
integer :: chs
integer :: diff
integer :: ii
integer :: ii1
integer :: in
integer :: ip
integer :: iu
integer :: j
integer :: j1
integer :: jj
integer :: jtemp
integer :: kk
integer :: lim
integer :: lim1
integer :: ll
integer :: lold
integer :: mink
integer :: n1
integer :: nn
integer :: profit
integer :: r
integer :: t
integer :: next_code_block
!*Code
next_code_block = 1
dispatch_loop: do
select case(next_code_block)
case(1)
z = 0
if( jck==1 )call chmt1(n , p , w , c , z , jdim)
if( z<0 )return
! INITIALIZE.
ch = c
ip = 0
chs = ch
first_loop: do ll = 1 , n
if( w(ll)>chs )exit first_loop
ip = ip + p(ll)
chs = chs - w(ll)
end do first_loop
ll = ll - 1
if( chs==0 )then
z = ip
x(1:ll) = 1
nn = ll + 1
x(nn:n) = 0
return
else
p(n + 1) = 0
w(n + 1) = ch + 1
lim = ip + chs*p(ll + 2)/w(ll + 2)
a = w(ll + 1) - chs
b = ip + p(ll + 1)
lim1 = b - a*float(p(ll))/float(w(ll))
if( lim1>lim )lim = lim1
mink = ch + 1
min(n) = mink
do j = 2 , n
kk = n + 2 - j
if( w(kk)<mink )mink = w(kk)
min(kk - 1) = mink
end do
xx(1:n) = 0
z = 0
profit = 0
lold = n
ii = 1
next_code_block = 4
cycle dispatch_loop
end if
case(2)
! TRY TO INSERT THE II-TH ITEM INTO THE CURRENT SOLUTION.
do while ( w(ii)>ch )
ii1 = ii + 1
if( z>=ch*p(ii1)/w(ii1) + profit )then
next_code_block = 5
cycle dispatch_loop
end if
ii = ii1
end do
! BUILD A NEW CURRENT SOLUTION.
ip = psign(ii)
chs = ch - wsign(ii)
in = zsign(ii)
ll = in
do while ( ll<=n )
if( w(ll)>chs )then
iu = chs*p(ll)/w(ll)
ll = ll - 1
if( iu==0 )then
next_code_block = 3
cycle dispatch_loop
end if
if( z>=profit + ip + iu )then
next_code_block = 5
cycle dispatch_loop
end if
next_code_block = 4
cycle dispatch_loop
else
ip = ip + p(ll)
chs = chs - w(ll)
end if
end do
ll = n
next_code_block = 3
case(3)
if( z>=ip + profit )then
next_code_block = 5
cycle dispatch_loop
end if
z = ip + profit
nn = ii - 1
x(1:nn) = xx(1:nn)
x(ii:ll) = 1
if( ll/=n )then
nn = ll + 1
x(nn:n) = 0
end if
if( z/=lim )then
next_code_block = 5
cycle dispatch_loop
end if
return
case(4)
! SAVE THE CURRENT SOLUTION.
wsign(ii) = ch - chs
psign(ii) = ip
zsign(ii) = ll + 1
xx(ii) = 1
nn = ll - 1
if( nn>=ii )then
do j = ii , nn
wsign(j + 1) = wsign(j) - w(j)
psign(j + 1) = psign(j) - p(j)
zsign(j + 1) = ll + 1
xx(j + 1) = 1
end do
end if
j1 = ll + 1
wsign(j1:lold) = 0
psign(j) = 0
zsign(j1:lold) = [(jtemp, jtemp = j1,lold)]
lold = ll
ch = chs
profit = profit + ip
if( ll<(n - 2) )then
ii = ll + 2
if( ch>=min(ii - 1) )then
next_code_block = 2
cycle dispatch_loop
end if
else if( ll==(n - 2) )then
if( ch>=w(n) )then
ch = ch - w(n)
profit = profit + p(n)
xx(n) = 1
end if
ii = n - 1
else
ii = n
end if
! SAVE THE CURRENT OPTIMAL SOLUTION.
if( z<profit )then
z = profit
x(1:n) = xx(1:n)
if( z==lim )return
end if
if( xx(n)/=0 )then
xx(n) = 0
ch = ch + w(n)
profit = profit - p(n)
end if
next_code_block = 5
case(5)
outer_loop: do ! BACKTRACK.
nn = ii - 1
if( nn==0 )return
middle_loop: do j = 1 , nn
kk = ii - j
if( xx(kk)==1 )then
r = ch
ch = ch + w(kk)
profit = profit - p(kk)
xx(kk) = 0
if( r<min(kk) )then
nn = kk + 1
ii = kk
! TRY TO SUBSTITUTE THE NN-TH ITEM FOR THE KK-TH.
inner_loop: do while ( z<profit + ch*p(nn)/w(nn) )
diff = w(nn) - w(kk)
if( diff<0 )then
t = r - diff
if( t>=min(nn) )then
if( z>=profit + p(nn) + t*p(nn + 1)/w(nn + 1) )exit inner_loop
ch = ch - w(nn)
profit = profit + p(nn)
xx(nn) = 1
ii = nn + 1
wsign(nn) = w(nn)
psign(nn) = p(nn)
zsign(nn) = ii
n1 = nn + 1
wsign(n1:lold) = 0
psign(n1:lold) = 0
zsign(n1:lold) = [(jtemp, jtemp = n1,lold)]
lold = nn
next_code_block = 2
cycle dispatch_loop
end if
else if( diff/=0 )then
if( diff<=r )then
if( z<profit + p(nn) )then
z = profit + p(nn)
x(1:kk) = xx(1:kk)
jj = kk + 1
x(jj:n) = 0
x(nn) = 1
if( z==lim )return
r = r - diff
kk = nn
nn = nn + 1
cycle inner_loop
end if
end if
end if
nn = nn + 1
end do inner_loop
cycle outer_loop
else
ii = kk + 1
next_code_block = 2
cycle dispatch_loop
end if
end if
end do middle_loop
exit outer_loop
end do outer_loop
exit dispatch_loop
end select
end do dispatch_loop
end subroutine mt1
!
subroutine chmt1(n , p , w , c , z , jdim)
integer , intent(in) :: jdim
integer , intent(in) :: n
integer , intent(in) , dimension(jdim) :: p
integer , intent(in) , dimension(jdim) :: w
integer , intent(in) :: c
integer , intent(out) :: z
!
! Local variable declarations
!
integer :: j
integer :: jsw
real :: r
real :: rr
!
! CHECK THE INPUT DATA.
!
if(( n<2) .or. (n>jdim - 1) )then
z = -1
return
else if( c>0 )then
jsw = 0
rr = float(p(1))/float(w(1))
do j = 1 , n
r = rr
if(( p(j)<=0 ).or.( w(j)<=0 ))then
z = -2
return
end if
jsw = jsw + w(j)
if( w(j)<=c )then
rr = float(p(j))/float(w(j))
if( rr>r )then
z = -5
return
end if
else
z = -3
return
end if
end do
if( jsw>c )return
z = -4
return
end if
z = -2
return
end subroutine chmt1
subroutine start_knapsack(n , profit , weight , capacity , result_val , members)
!
! Dummy argument declarations
!
integer , intent(in) :: n
integer , intent(inout) , dimension(n) :: profit
integer , intent(inout) , dimension(n) :: weight
integer , intent(in) :: capacity
integer , intent(inout) :: result_val
integer , intent(inout) , dimension(n) :: members
!
! Local variable declarations
integer :: bigger
integer :: jck
integer , allocatable , dimension(:) :: mini
integer , allocatable , dimension(:) :: psign
integer , allocatable , dimension(:) :: wsign
integer , allocatable , dimension(:) :: xx
integer , allocatable , dimension(:) :: zsign
!
!Designed to invoke MT1
!MT1 NEEDS 8 ARRAYS ( P , W , X , XX , MIN , PSIGN , WSIGN
! AND ZSIGN ) OF LENGTH AT LEAST N + 1 .
! MEANING OF THE INPUT PARAMETERS:
! N = NUMBER OF ITEMS;
! P(J) = PROFIT OF ITEM J (J=1,...,N);
! W(J) = WEIGHT OF ITEM J (J=1,...,N);
! C = CAPACITY OF THE KNAPSACK;
! JDIM = DIMENSION OF THE 8 ARRAYS;
! JCK = 1 IF CHECK ON THE INPUT DATA IS DESIRED,
! = 0 OTHERWISE.
!
! MEANING OF THE OUTPUT PARAMETERS:
! Z = VALUE OF THE OPTIMAL SOLUTION IF Z .GT. 0 ,
! = ERROR IN THE INPUT DATA (WHEN JCK=1) IF Z .LT. 0 : CONDI-
! TION - Z IS VIOLATED;
! X(J) = 1 IF ITEM J IS IN THE OPTIMAL SOLUTION,
! = 0 OTHERWISE.
!
! ARRAYS XX, MIN, PSIGN, WSIGN AND ZSIGN ARE DUMMY.
!
! ALL THE PARAMETERS ARE INTEGER. ON RETURN OF MT1 ALL THE INPUT
! PARAMETERS ARE UNCHANGED.
!
jck = 1 !Set parameter checking on
bigger = n + 100
!
! Allocate the dummy arrays
allocate(xx(bigger))
allocate(mini(bigger))
allocate(psign(bigger))
allocate(wsign(bigger))
allocate(zsign(bigger))
call mt1(n , profit , weight , capacity , result_val , members , bigger , jck , xx , mini , psign , wsign , zsign)
deallocate(xx)
deallocate(mini)
deallocate(psign)
deallocate(wsign)
deallocate(zsign)
end subroutine start_knapsack
end module ksack2
!
program serious_knapsack
use ksack2
integer, parameter :: list_size=22
integer:: p(list_size) ! The weights
integer::n,profit(list_size),capacity,result_val,members(size(p)),valuez,t1,t2,j
character(len=25) :: names(list_size),tempnam
real :: ratio(list_size),rats
logical :: swapped
capacity =400
members = 0
result_val = 0
n = list_size
p(1:list_size) = (/13,153, 50,15,68,27,39,23,52,11,32,24,48,73,43,42,22,07,18,009,04,30/)
profit(1:list_size) =(/35,200,160,60,45,60,40,30,10,70,30,15,10,40,70,75,80,20,12,150,50,10/)
names(1:22) =[character(len=25) ::'compass','water','sandwich','glucose','tin','banana','apple', 'cheese', &
'beer','suntan cream','camera','T-shirt','trousers','umbrella','waterproof trousers', 'waterproof overclothes', &
'note-case','sunglasses','towel','map','socks', 'book']
ratio(1:22) = float(profit(1:22))/float(p(1:22))
! The mt1 algorithm wants the data sorted downwards(large-->small) by the ration of profit/weight
! So, I implemented a quick bubble sort to order the lists
swapped = .true.
do while (swapped)
swapped = .false.
do j = 1,21
if(ratio(j).lt.ratio(j+1))then ! Swaps everywhere
swapped = .true.
t1 = p(j+1) ! Swap the weights
p(j+1) = p(j)
p(j) = t1
t2 = profit(j+1) !Swap the profits
profit(j+1) = profit(j)
profit(j) = t2
tempnam = names(j+1) ! Swap the names around
names(j+1) = names(j)
names(j) = tempnam
rats = ratio(j+1) ! Swap the ratios
ratio(j+1) = ratio(j)
ratio(j) = rats
endif
end do
end do
!
call system_clock(count=xx)
call startup(n,profit(1:22),p(1:22),capacity,result_val,members)
call system_clock(count=yy)
print*,'Total of the sack = ',result_val
capacity = 0
valuez = 0
n = 0
do i = 1,size(members)
if(members(i) /=0)then
capacity = capacity +p(i)
valuez = profit(i) + valuez
n = n+1
print*, names(i),p(i),profit(i)
endif
end do
print*,'Filled capacity = ',capacity,'Value = ',valuez!,'No items = ',n,sum(profit(1:22)),sum(p(1:22))
print*
print*,'First knapsack time = ',(yy-xx),'Milliseconds'
stop 'All done'
end program serious_knapsack
</syntaxhighlight>
{{out}}
<pre>
map 9 150
socks 4 50
suntan cream 11 70
glucose 15 60
note-case 22 80
sandwich 50 160
sunglasses 7 20
compass 13 35
banana 27 60
waterproof overclothes 42 75
waterproof trousers 43 70
water 153 200
Filled capacity = 396 Value = 1030
First knapsack time = 0 Milliseconds
</pre>
Line 4,243 ⟶ 5,032:
document.write("Mx Kol St-st Schifr<br>")
document.write("Mx Amo Price
for (h = a-1; h>(a-1)/2; h--)
Line 8,261 ⟶ 9,050:
{{libheader|Wren-fmt}}
Based on the Go example, though modified to give output in tabular form.
<syntaxhighlight lang="
var wants = [
| |||