Just another update

This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions

View file

@ -0,0 +1,47 @@
/*REXX program solves the (continuous) burglar's knapsack problem. */
@.= /*═══════ name weight value ══════*/
@.1 = 'flitch 4 30 '
@.2 = 'beef 3.8 36 '
@.3 = 'pork 5.4 43 '
@.4 = 'greaves 2.4 45 '
@.5 = 'brawn 2.5 56 '
@.6 = 'welt 3.7 67 '
@.7 = 'ham 3.6 90 '
@.8 = 'salami 3 95 '
@.9 = 'sausage 5.9 98 '
parse arg maxW d . /*get possible args from the C.L.*/
if maxW=='' | maxW==',' then maxW=15 /*burglar's knapsack max weight. */
if d=='' | d==',' then d= 3 /*# of decimal digits in FORMAT. */
wL=d+length('weight'); nL=d+length('total weight'); vL=d+length('value')
totW=0; totV=0
do #=1 while @.#\==''; parse var @.# n.# w.# v.# .
end /*#*/ /* [↑] assign to separate lists.*/
#=#-1 /*#: number of items in @ list.*/
call show 'unsorted item list' /*display header and the @ list.*/
call sortD /*invoke using a descending sort.*/
call hdr "burglar's knapsack contents"
do j=1 for # while totW<maxW; f=1 /*grab items*/
if totW+w.j>=maxW then f=(maxW-totW)/w.j /*calc fract*/
totW=totW+w.j*f; totV=totV+v.j*f /*add──►tots*/
call syf left(word('{all}',1+(f\==1)),5) n.j, w.j*f, v.j*f
end /*j*/ /*↑show item*/
call sep; say /* [↓] $ supresses trailing Θs.*/
call sy left('total weight',nL,''), $(format(totW,,d))
call sy left('total value',nL,''), , $(format(totV,,d))
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────one─liner subroutines──────────────────────*/
hdr: say; say; say center(arg(1),50,''); say; call title; call sep; return
sep: call sy copies('',nL), copies("",wL), copies('',vL); return
show: call hdr arg(1); do j=1 for #; call syf n.j,w.j,v.j; end; return
sy: say left('',9) left(arg(1),nL) right(arg(2),wL) right(arg(3),vL); return
syf: call sy arg(1), $(format(arg(2),,d)), $(format(arg(3),,d)); return
title: call sy center('item',nL), center("weight",wL), center('value',vL); return
$:x=arg(1);if pos(.,x)>1 then x=left(strip(strip(x,'T',0),,.),length(x));return x
/*──────────────────────────────────SORTD subroutine───────────────────────────*/
sortD: do sort=2 to #; _n=n.sort; _w=w.sort; _v=v.sort /*descending. */
do k=sort-1 by -1 to 1 while v.k/w.k<_v/_w /*order items.*/
p=k+1; n.p=n.k; w.p=w.k; v.p=v.k /*shuffle 'em.*/
end /*k*/ /*[↓] last one*/
a=k+1; n.a=_n; w.a=_w; v.a=_v /*place item. */
end /*sort*/
return /* ↑ ↑ ↑ algorithm is OK for smallish arrays.*/

View file

@ -0,0 +1,77 @@
/*--------------------------------------------------------------------
* 19.09.2014 Walter Pachl translated from FORTRAN
* While this program works with all REXX interpreters,
* see section ooRexx for a version that utilizes the ooRexx features
*-------------------------------------------------------------------*/
maxweight = 15.0
input.0=0
Call init_input 'beef', 3.8, 36.0
Call init_input 'pork', 5.4, 43.0
Call init_input 'ham', 3.6, 90.0
Call init_input 'greaves', 2.4, 45.0
Call init_input 'flitch', 4.0, 30.0
Call init_input 'brawn', 2.5, 56.0
Call init_input 'welt', 3.7, 67.0
Call init_input 'salami', 3.0, 95.0
Call init_input 'sausage', 5.9, 98.0
/* sort the items by descending value per unit of weight */
Do i = 1 to input.0
Parse Var input.i name '*' weight '*' value
vpu=value/weight;
If i=1 Then Do
item.0=1
item.1=input.1
vpu.1=vpu
End
Else Do
Do ii=1 To item.0
If vpu.ii<vpu Then
Leave
End
Do jj=item.0 To ii By -1
jj1=jj+1
item.jj1=item.jj
vpu.jj1=vpu.jj
End
item.ii=input.i
vpu.ii=vpu
item.0=item.0+1
End
End
Say '# vpu name weight value'
Do i=1 To item.0
Parse Var item.i name '*' weight '*' value
Say i format(vpu.i,2,3) left(name,7) format(weight,2,3) format(value,3,3)
End
total_weight=0
total_value =0
Say ' '
Say 'Item Weight Value'
Do i=1 To item.0
Parse Var item.i name '*' weight '*' value
if total_weight+weight < maxweight then Do
total_weight = total_weight + weight
total_value = total_value + value
Say left(name,7) format(weight,3,3) format(value,3,3)
End
Else Do
weight=maxweight-total_weight
value=weight*vpu.i
total_value = total_value + value
total_weight = maxweight
Say left(name,7) format(weight,3,3) format(value,3,3)
Leave
End
End
Say copies('-',23)
Say 'total ' format(total_weight,4,3) format(total_value,3,3)
Exit
init_input: Procedure Expose input.
Parse Arg name,weight,value
i=input.0+1
input.i=name'*'weight'*'value
input.0=i
Return

View file

@ -1,63 +0,0 @@
/*REXX program to solve the burglar's knapsack (continuous) problem. */
@.=''
/*════ name weight value ════*/
@.1 = 'flitch 4 30 '
@.2 = 'beef 3.8 36 '
@.3 = 'pork 5.4 43 '
@.4 = 'greaves 2.4 45 '
@.5 = 'brawn 2.5 56 '
@.6 = 'welt 3.7 67 '
@.7 = 'ham 3.6 90 '
@.8 = 'salami 3 95 '
@.9 = 'sausage 5.9 98 '
nL=length('total weight'); wL=length('weight'); vL=length(' value ')
totW=0; totV=0
do j=1 while @.j\=='' ; parse var @.j n w v .
nL=max(nL,length(n)) ; n.j=n
totW=totW+w ; w.j=w
totV=totV+v ; v.j=v
end /*j*/
items=j-1 /*items is the number of items. */
nL=nL+nL%4 /*nL: max length name + 25%. */
wL=max(wL,length(format(totw,,2))) /*wL: max formatted weight width*/
vL=max(vL,length(format(totv,,2))) /*vL: max formatted value width*/
totW=0; totV=0
call show 'before sorting'
do j=2 to items /*sort by desending value/unit wt*/
k=j-1; _n=n.j; _w=w.j; _v=v.j
do k=k by -1 to 1 while v.k/w.k < _v/_w
kp1=k+1; n.kp1=n.k; w.kp1=w.k; v.kp1=v.k
end /*k*/
kp1=k+1; n.kp1=_n; w.kp1=_w; v.kp1=_v
end /*j*/
call show 'after sorting'
call hdr "burgler's knapsack contents"
maxW=15 /*burgler's knapsack max weight. */
do j=1 for items while totW < maxW
if totW+w.j<maxW then do
totW=totW + w.j
totV=totV + v.j
call syf n.j, w.j, v.j
end
else do
f=(maxW-totW) / w.j
totW=totW + w.j*f
totV=totV + v.j*f
call syf n.j, w.j*f, v.j*f
end
end /*j*/
call sep
call sy left('total weight',nL,''), format(totW,,2)
call sy left('total value',nL,''), , format(totV,,2)
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────one─liner subroutines───────────────*/
hdr: indent=left('',9); call verse arg(1); call title; call sep; return
sep: call sy copies('',nL), copies("",wL), copies('',vL); return
show: call hdr arg(1); do j=1 for items; call syf n.j,w.j,v.j;end; say; return
sy: say indent left(arg(1),nL) right(arg(2),wL) right(arg(3),vL); return
syf: call sy arg(1), format(arg(2),,2), format(arg(3),,2); return
title: call sy center('item',nL),center("weight",wL),center('value',vL); return
verse: say; say center(arg(1),50,''); say; return