2016 Update

This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions

View file

@ -1,32 +1,32 @@
/*REXX pgm: Dinesman's multiple-dwelling problem with "natural" wording.*/
names= 'Baker Cooper Fletcher Miller Smith' /*names of the tenants.*/
floors=5; top=floors; bottom=1; #=floors; sols=0
/*floor 1 is the ground floor. */
do !.1=1 for #;do !.2=1 for #;do !.3=1 for #;do !.4=1 for #;do !.5=1 for #
do p=1 for words(names); _=word(names,p); upper _; call value _,!.p
end /*p*/
/* [↓] don't live on same floor.*/
do j=1 for #-1; do k=j+1 to #; if !.j==!.k then iterate !.5; end;end
/*REXX program solves the Dinesman's multiple─dwelling problem with "natural" wording.*/
names= 'Baker Cooper Fletcher Miller Smith' /*names of multiple─dwelling tenants. */
tenants=words(names) /*the number of tenants in the building*/
floors=5; top=floors; bottom=1; #=floors; /*floor 1 is the ground (bottom) floor.*/
sols=0
do !.1=1 for #; do !.2=1 for #; do !.3=1 for #; do !.4=1 for #; do !.5=1 for #
do p=1 for tenants; _=word(names,p); upper _; call value _, !.p
end /*p*/
do j=1 for #-1 /* [↓] people don't live on same floor*/
do k=j+1 to #; if !.j==!.k then iterate !.5 /*cohab?*/
end /*k*/
end /*j*/
call Waldo /* ◄══ where the rubber meets the road.*/
end; end; end; end; end /*!.5 & !.4 & !.3 & !.2 & !.1*/
call Waldo /* ◄───────────────────where the rubber meets the road.*/
end /*!.5*/; end /*!.4*/; end /*!.3*/; end /*!.2*/; end /*!.1*/
say; say 'found' sols "solution"s(sols)'.'
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────Waldo subroutine────────────────────*/
Waldo:
if Baker == top then return
if Cooper == bottom then return
if Fletcher == bottom | Fletcher == top then return
if Miller \> Cooper then return
if Smith == Fletcher-1 | Smith == Fletcher+1 then return
if Fletcher == Cooper-1 | Fletcher == Cooper+1 then return
say; sols=sols+1 /*list tenants in order in list. */
do p=1 for words(names); _=word(names,p)
say right(_,20) 'lives on the' !.p||th(!.p) "floor."
end /*p*/
return
/*──────────────────────────────────one-liner subroutines───────────────*/
s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer funct.*/
th:procedure;parse arg x;x=abs(x);return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4))
say 'found' sols "solution"s(sols). /*display the number of solutions found*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Waldo: if Baker == top then return
if Cooper == bottom then return
if Fletcher == bottom | Fletcher == top then return
if Miller \> Cooper then return
if Smith == Fletcher-1 | Smith == Fletcher+1 then return
if Fletcher == Cooper -1 | Fletcher == Cooper +1 then return
sols=sols+1
say; do p=1 for tenants; tenant=right( word(names, p), 30)
say tenant 'lives on the' !.p || th(!.p) "floor."
end /*p*/
return /* [↑] show tenants in order in NAMES.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
s: if arg(1)=1 then return ''; return "s" /*a simple pluralizer function.*/
th: arg x; x=abs(x); return word('th st nd rd', 1 +x// 10* (x//100%10\==1)*(x//10<4))