aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

fix utf8

Browse source
This commit is contained in:
Ingy döt Net 2013-04-09 15:58:49 -07:00
parent 80737d5a6a
commit fc81c9e6d0
45 changed files with 169 additions and 178 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/99_Bottles_of_Beer/REXX/99_bottles_of_beer.rexx
View file

@ -15,5 +15,5 @@ say 'no more bottles of beer.' /*so sad ... */
say 'Go to the store and buy some more,' /*replenishment of the beer.*/
say '99 bottles of beer on the wall.' /*All is well in the tavern.*/
exit /*we're done & also sloshed.*/
/*───────────────────────────────────S subroutine───────────────────────*/
/*───────────────────────────────────S subroutine───────────────────────*/
s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer funct.*/

4
Task/Ackermann_function/REXX/ackermann_function-2.rexx
View file

@ -6,13 +6,13 @@ high=24
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,10)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
if m==0 then return n+1

4
Task/Ackermann_function/REXX/ackermann_function-3.rexx
View file

@ -13,13 +13,13 @@ numeric digits 100 /*have REXX to use up to 100 digit integers.*/
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,10)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
if m==0 then return n+1

4
Task/Ackermann_function/REXX/ackermann_function.rexx
View file

@ -11,13 +11,13 @@ high=24
end /*k*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
/*──────────────────────────────────ACKERMANN_TELL subroutine───────────*/
ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/
nnn=right(nn,length(high))
say 'Ackermann('mm","nnn')='right(ackermann(mm,nn),high),
left('',12) 'calls='right(calls,high)
return
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
/*──────────────────────────────────ACKERMANN subroutine────────────────*/
ackermann: procedure expose calls /*compute the Ackerman function. */
parse arg m,n; calls=calls+1
if m==0 then return n+1

6
Task/Anagrams/REXX/anagrams.rexx
View file

@ -14,20 +14,20 @@ wL.=0 /*number of words of length L. */
@s.words=@@s.L._ /*and also, sorted length L vers.*/
end /*j*/
a.= /*all the anagrams for word X. */
say copies('─',30) words 'words in the dictionary file: ' ifid
say copies('─',30) words 'words in the dictionary file: ' ifid
n.=0 /*number of anagrams for word X. */
do j=1 for words /*process the usable words found.*/
x=@.j; Lx=length(x); xs=@s.j /*get some vital statistics for X*/
do k=1 for wL.Lx /*process all the words of len L.*/
if xs\==@@s.Lx.k then iterate /*is this a true anagram of X ? */
if x==@@.Lx.k then iterate /*skip doing anagram on itself. */
n.j=n.j+1; a.j=a.j @@.Lx.k /*bump counter, add ──► anagrams.*/
n.j=n.j+1; a.j=a.j @@.Lx.k /*bump counter, add ──► anagrams.*/
end /*k*/
end /*j*/
m=n.1 /*assume first (len=1) is largest*/
do j=2 to words; m=max(m,n.j); end /*find the maximum anagram count.*/
do k=1 for words; if n.k==m then if word(a.k,1)>@.k then say @.k a.k; end
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ESORT───────────────────────────────*/
/*──────────────────────────────────ESORT───────────────────────────────*/
esort:procedure expose !.;h=!.0;do while h>1;h=h%2;do i=1 for !.0-h;j=i;k=h+i
do while !.k<!.j;t=!.j;!.j=!.k;!.k=t;if h>=j then leave;j=j-h;k=k-h;end;end;end;return

10
Task/Anagrams/Racket/anagrams.rkt
View file

@ -9,13 +9,13 @@
(define (hash-words words)
(for/fold ([ws-hash (hash)]) ([w words])
(hash-update ws-hash
(list->string (sort (string->list w) < #:key (λ (c) (char->integer c))))
(λ (ws) (cons w ws))
(λ () '()))))
(list->string (sort (string->list w) < #:key (λ (c) (char->integer c))))
(λ (ws) (cons w ws))
(λ () '()))))
(define (get-maxes h)
(define max-ws (apply max (map length (hash-values h))))
(define max-keys (filter (λ (k) (= (length (hash-ref h k)) max-ws)) (hash-keys h)))
(map (λ (k) (hash-ref h k)) max-keys))
(define max-keys (filter (λ (k) (= (length (hash-ref h k)) max-ws)) (hash-keys h)))
(map (λ (k) (hash-ref h k)) max-keys))
(get-maxes (hash-words (get-lines "http://www.puzzlers.org/pub/wordlists/unixdict.txt")))

2
Task/Arrays/REXX/arrays-2.rexx
View file

@ -9,5 +9,5 @@ say 'element 50 is:' a(50)
say 'element 3000 is:' a(3000)
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────A subroutine────────────────────────*/
/*──────────────────────────────────A subroutine────────────────────────*/
a: _a_ = arg(1); return a._a_

2
Task/Arrays/REXX/arrays-6.rexx
View file

@ -19,7 +19,7 @@ a.civet="A.K.A.: toddycats"
characters. To illustrate:
--------------------------------------------------------------------------*/
stuff=')g.u.t.s( or ½ of an intestine!'
stuff=')g.u.t.s( or ½ of an intestine!'
a.stuff=44
/*--------------------------------------------------------------

2
Task/Balanced_brackets/0DESCRIPTION
View file

@ -1,5 +1,5 @@
'''Task''':
* Generate a string with <math>\mathrm{N}</math> opening brackets (“<code>[</code>”) and <math>\mathrm{N}</math> closing brackets (“<code>]</code>”), in some arbitrary order.
* Generate a string with <math>\mathrm{N}</math> opening brackets (“<code>[</code>”) and <math>\mathrm{N}</math> closing brackets (“<code>]</code>”), in some arbitrary order.
* Determine whether the generated string is ''balanced''; that is, whether it consists entirely of pairs of opening/closing brackets (in that order), none of which mis-nest.
'''Examples''':

28
Task/Balanced_brackets/REXX/balanced_brackets-3.rexx
View file

@ -21,17 +21,17 @@ call teller
count=0
nested=0
do j=1 /*generate lots of permutations. */
q=translate(strip(x2b(d2x(j)),'L',0),"][",01) /*convert──►[].*/
q=translate(strip(x2b(d2x(j)),'L',0),"][",01) /*convert──►[].*/
if countstr(']',q)\==countstr('[',q) then iterate /*compliant?*/
call checkBal q
if length(q)>20 then leave /*done all 20-char possibilities?*/
end
/*───────────────────────────────────TELLER subroutine──────────────────*/
/*───────────────────────────────────TELLER subroutine──────────────────*/
teller: say
say count " expressions were checked, " nested ' were balanced, ',
count-nested " were unbalanced."
return
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
checkBal: procedure expose nested count; parse arg y; count=count+1
nest=0
do j=1 for length(y); _=substr(y,j,1) /*pick off character.*/
@ -43,16 +43,16 @@ nest=0
end /*j*/
nested=nested + (nest==0)
return nest==0
/* ┌──────────────────────────────────────────────────────────────────┐
│ COUNTSTR counts the number of occurances of a string (or char)│
│ within another string (haystack) without overlap. If either arg │
│ is null, 0 (zero) is returned. To make the subroutine case │
│ insensative, change the PARSE ARG ... statement to ARG ... │
│ Example: yyy = 'The quick brown fox jumped over the lazy dog.' │
│ zz = countstr('o',yyy) /*ZZ will be set to 4 */ │
│ Note that COUNTSTR is also a built-in function of the newer │
│ REXX interpreters, and the result should be identical. Checks │
│ could be added to validate if 2 or 3 arguments are passed. │
└──────────────────────────────────────────────────────────────────┘ */
/* ┌──────────────────────────────────────────────────────────────────┐
│ COUNTSTR counts the number of occurances of a string (or char)│
│ within another string (haystack) without overlap. If either arg │
│ is null, 0 (zero) is returned. To make the subroutine case │
│ insensative, change the PARSE ARG ... statement to ARG ... │
│ Example: yyy = 'The quick brown fox jumped over the lazy dog.' │
│ zz = countstr('o',yyy) /*ZZ will be set to 4 */ │
│ Note that COUNTSTR is also a built-in function of the newer │
│ REXX interpreters, and the result should be identical. Checks │
│ could be added to validate if 2 or 3 arguments are passed. │
└──────────────────────────────────────────────────────────────────┘ */
countstr: procedure; parse arg n,h,s; if s=='' then s=1; w=length(n)
do r=0 until _==0; _=pos(n,h,s); s=_+w; end; return r

6
Task/Balanced_brackets/REXX/balanced_brackets.rexx
View file

@ -23,13 +23,13 @@ q=']]][[[[]' ; call checkBal q; say yesno.result q
say yesno.result q
end
exit
/*───────────────────────────────────PAND subroutine────────────────────*/
/*───────────────────────────────────PAND subroutine────────────────────*/
pand: p=random(0,1); return p || \p
/*───────────────────────────────────RAND subroutine────────────────────*/
/*───────────────────────────────────RAND subroutine────────────────────*/
rand: pp=pand(); pp=pand()pp; pp=copies(pp,arg(1))
i=random(2,length(pp)); pp=left(pp,i-1)substr(pp,i)
return pp
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
/*───────────────────────────────────CHECKBAL subroutine────────────────*/
checkBal: procedure expose @.; arg y /*check for balanced brackets [] */
nest=0; if @.y then return '-1' /*already done this expression ? */
@.y=1 /*indicate expression processed. */

4
Task/Balanced_ternary/0DESCRIPTION
View file

@ -1,4 +1,4 @@
[[wp:Balanced ternary|Balanced ternary]] is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary integer is in base 3, and each digit can have the values 1, 0, or −1. For example, decimal 11 = 3<sup>2</sup> + 3<sup>1</sup> − 3<sup>0</sup>, thus can be written as "++−", while 6 = 3<sup>2</sup> − 3<sup>1</sup> + 0 × 3<sup>0</sup>, i.e., "+−0".
[[wp:Balanced ternary|Balanced ternary]] is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary integer is in base 3, and each digit can have the values 1, 0, or −1. For example, decimal 11 = 3<sup>2</sup> + 3<sup>1</sup> − 3<sup>0</sup>, thus can be written as "++−", while 6 = 3<sup>2</sup> − 3<sup>1</sup> + 0 × 3<sup>0</sup>, i.e., "+−0".
For this task, implement balanced ternary representation of integers with the following
@ -11,6 +11,6 @@ For this task, implement balanced ternary representation of integers with the fo
'''Test case''' With balanced ternaries ''a'' from string "+-0++0+", ''b'' from native integer -436, ''c'' "+-++-":
* write out ''a'', ''b'' and ''c'' in decimal notation;
* calculate ''a'' × (''b'' − ''c''), write out the result in both ternary and decimal notations.
* calculate ''a'' × (''b'' − ''c''), write out the result in both ternary and decimal notations.
'''Note:''' The pages [[generalised floating point addition]] and [[generalised floating point multiplication]] have code implementing [[wp:arbitrary precision|arbitrary precision]] [[wp:floating point|floating point]] balanced ternary.

2
Task/Balanced_ternary/Prolog/balanced_ternary-2.pro
View file

@ -114,7 +114,7 @@ normalise(N, L1, L) :-
% special case of number 0 !
strip_nombre([48]) --> {!}, "0".
% enlève les zéros inutiles
% enlève les zéros inutiles
strip_nombre([48 | L]) -->
strip_nombre(L).

14
Task/Balanced_ternary/REXX/balanced_ternary.rexx
View file

@ -1,6 +1,6 @@
/*REXX pgm converts decimal ◄───► balanced ternary; also performs arith.*/
/*REXX pgm converts decimal ◄───► balanced ternary; also performs arith.*/
numeric digits 10000 /*handle almost any size numbers.*/
Ao = '+-0++0+' ; Abt = Ao /* [↓] 2 literals used by sub.*/
Ao = '+-0++0+' ; Abt = Ao /* [↓] 2 literals used by sub.*/
Bo = '-436' ; Bbt = d2bt(Bo) ; @ = '(decimal)'
Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
call btShow '[a]', Abt
@ -9,7 +9,7 @@ Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
say; $bt = btMul(Abt,btSub(Bbt,Cbt))
call btshow '[a*(b-c)]', $bt
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────BT2D subroutine─────────────────────*/
/*──────────────────────────────────BT2D subroutine─────────────────────*/
d2bt: procedure; parse arg x 1; p=0; $.='-'; $.1='+'; $.0=0; #=
x=x/1
do until x==0; _=(x//(3**(p+1)))%3**p
@ -17,11 +17,11 @@ x=x/1
x=x-_*(3**p); p=p+1; #=$._ || #
end /*until*/
return #
/*──────────────────────────────────BT2D subroutine─────────────────────*/
/*──────────────────────────────────BT2D subroutine─────────────────────*/
bt2d: procedure; parse arg x; r=reverse(x); #=0; $.=-1; $.0=0; _='+'; $._=1
do j=1 for length(x); _=substr(r,j,1); #=#+$._*3**(j-1); end
return #
/*──────────────────────────────────BTADD subroutine────────────────────*/
/*──────────────────────────────────BTADD subroutine────────────────────*/
btAdd: procedure; parse arg x,y; rx=reverse(x); ry=reverse(y); carry=0
$.='-'; $.0=0; $.1='+'; @.=0; _='-'; @._=-1; _="+"; @._=1; #=
@ -35,7 +35,7 @@ $.='-'; $.0=0; $.1='+'; @.=0; _='-'; @._=-1; _="+"; @._=1; #=
#=$.s || #
end /*j*/
if carry\==0 then #=$.carry || #; return btNorm(#)
/*──────────────────────────────────BTMUL subroutine────────────────────*/
/*──────────────────────────────────BTMUL subroutine────────────────────*/
btMul: procedure; parse arg x,y; if x==0 | y==0 then return 0; S=1
x=btNorm(x); y=btNorm(y) /*handle: 0-xxx values.*/
if left(x,1)=='-' then do; x=btNeg(x); S=-S; end /*positate.*/
@ -48,7 +48,7 @@ P=0
end /*until*/
if S==-1 then P=btNeg(P) /*adjust product sign. */
return P /*return the product P.*/
/*───────────────────────────────one-line subroutines───────────────────*/
/*───────────────────────────────one-line subroutines───────────────────*/
btNeg: return translate(arg(1), '-+', "+-") /*negate the bal_tern #*/
btNorm: _=strip(arg(1),'L',0); if _=='' then _=0; return _ /*normalize*/
btSub: return btAdd(arg(1), btNeg(arg(2))) /*subtract two BT args.*/

6
Task/Best_shuffle/REXX/best_shuffle.rexx
View file

@ -12,7 +12,7 @@ w=w+5 /*add five spaces to widest word.*/
say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new)
end /*n*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────BESTSHUFFLE subroutine──────────────*/
/*──────────────────────────────────BESTSHUFFLE subroutine──────────────*/
bestShuffle: procedure; parse arg x 1 ox; Lx=length(x)
if Lx<3 then return reverse(x) /*fast track these puppies. */
@ -22,7 +22,7 @@ if Lx<3 then return reverse(x) /*fast track these puppies. */
_=verify(x,a); if _==0 then iterate /*switch 1st rep with some char. */
y=substr(x,_,1); x=overlay(a,x,_)
x=overlay(y,x,j)
rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬ enuf unique*/
rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬ enuf unique*/
y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd rep with later char.*/
x=overlay(a,x,_); x=overlay(y,x,j+1) /*OVERLAYs: a fast way to swap*/
end /*j*/
@ -34,7 +34,7 @@ if Lx<3 then return reverse(x) /*fast track these puppies. */
else x=left(x,k-1)substr(x,k+1,1)a || substr(x,k+2)
end /*k*/
return x
/*──────────────────────────────────KSAME procedure─────────────────────*/
/*──────────────────────────────────KSAME procedure─────────────────────*/
kSame: procedure; parse arg x,y; k=0
do m=1 for min(length(x),length(y))
k=k + (substr(x,m,1) == substr(y,m,1))

2
Task/Binary_search/REXX/binary_search.rexx
View file

@ -24,7 +24,7 @@ if loc==-1 then do
say
say 'arithmetic mean of the' high "values=" avg
exit /*stick a fork in it, we're done.*/
/*─────────────────────────────────────BINARYSEARCH subroutine──────────*/
/*─────────────────────────────────────BINARYSEARCH subroutine──────────*/
binarySearch: procedure expose @ ?; parse arg low,high
if high<low then return -1
mid=(low+high)%2

2
Task/Binary_strings/REXX/binary_strings.rexx
View file

@ -27,5 +27,5 @@ tt=changestr('~~',other,";") /*change 2 tildes to a semicolon.*/
joined=dignsta || dingst2 /*join 2 strs together (concat). */
exit /*stick a fork in it, we're done.*/
/*─────────────────────────────────C2B subroutine───────────────────────*/
/*─────────────────────────────────C2B subroutine───────────────────────*/
c2b: return x2b(c2x(arg(1))) /*return the string as a binary string. */

22
Task/Bulls_and_cows/REXX/bulls_and_cows.rexx
View file

@ -5,9 +5,9 @@
/* Pigs and Bulls */
/* Bulls and Cleots */
/* MasterMind (or Master Mind) */
/*══════════════════════════════════════════════════════════════════════*/
/*══════════════════════════════════════════════════════════════════════*/
?=''; do until length(?)==4 /*generate unique 4-digit number.*/
r=random(1,9) /*change 1──►0 to allow a 0 dig*/
r=random(1,9) /*change 1──►0 to allow a 0 dig*/
if pos(r,?)\==0 then iterate /*don't allow a repeated digit. */
?=? || r
end /*until*/
@ -19,25 +19,25 @@ prompt='[Bulls & Cows game] ', /*build the prompt text string. */
say prompt; pull n; n=space(n,0); if n=='' then iterate
if abbrev('QUIT',n,1) then exit /*Does the user want to quit now?*/
g=?; L=length(n); bulls=0; cows=0
/*bull count─────────────────────*/
/*bull count─────────────────────*/
do j=1 for L; if substr(n,j,1)\==substr(g,j,1) then iterate
bulls=bulls+1 /*bump the bull count. */
g=overlay(' ',g,j) /*disallow this for a cow count. */
end /*j*/
/*cow count─────────────────────*/
/*cow count─────────────────────*/
do k=1 for L; x=substr(n,k,1); if pos(x,g)==0 then iterate
cows=cows+1 /*bump the cow count. */
g=translate(g,,x) /*this allows for rule variants. */
end /*k*/
if bulls\==4 then say "───── You got" bulls 'bull's(bulls) "and" cows 'cow's(cows)"."
if bulls\==4 then say "───── You got" bulls 'bull's(bulls) "and" cows 'cow's(cows)"."
end /*until bulls==4*/
say; say " ┌─────────────────────────────────────────┐"
say " │ │"
say " │ Congratulations, you've guessed it !! │"
say " │ │"
say " └─────────────────────────────────────────┘"; say
say; say " ┌─────────────────────────────────────────┐"
say " │ │"
say " │ Congratulations, you've guessed it !! │"
say " │ │"
say " └─────────────────────────────────────────┘"; say
exit
/*──────────────────────────────────S subroutine────────────────────────*/
/*──────────────────────────────────S subroutine────────────────────────*/
s: if arg(1)==1 then return ''; return 's'

2
Task/Caesar_cipher/0DESCRIPTION
View file

@ -1,3 +1,3 @@
Implement a [[wp:Caesar cipher|Caesar cipher]], both encryption and decryption. The key is an integer from 1 to 25. This cipher rotates the letters of the alphabet (A to Z). The encryption replaces each letter with the 1st to 25th next letter in the alphabet (wrapping Z to A). So key 2 encrypts "HI" to "JK", but key 20 encrypts "HI" to "BC". This simple "monoalphabetic substitution cipher" provides almost no security, because an attacker who has the encrypted message can either use frequency analysis to guess the key, or just try all 25 keys.
Caesar cipher is identical to [[Vigenère cipher]] with key of length 1. Also, [[Rot-13]] is identical to Caesar cipher with key 13.
Caesar cipher is identical to [[Vigenère cipher]] with key of length 1. Also, [[Rot-13]] is identical to Caesar cipher with key 13.

4
Task/Caesar_cipher/REXX/caesar_cipher-2.rexx
View file

@ -6,7 +6,7 @@ y=caesar(p, key) ; say ' cyphered:' y
z=caesar(y,-key) ; say ' uncyphered:' z
if z\==p then say "plain text doesn't match uncyphered cyphered text."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
caesar: procedure; parse arg s,k; @='abcdefghijklmnopqrstuvwxyz'
@=translate(@)@'0123456789(){}[]<>' /*add uppercase, digs, group symb*/
@=@'~!@#$%^&*_+:";?,./`-= ''' /*add other characters here. */
@ -19,5 +19,5 @@ if _\==0 then call err 'unsupported character:' substr(s,_,1)
if k>0 then ky=k+1
else ky=L+1-ak
return translate(s,substr(@||@,ky,L),@)
/*──────────────────────────────────ERR subroutine──────────────────────*/
/*──────────────────────────────────ERR subroutine──────────────────────*/
err: say; say '***error!***'; say; say arg(1); say; exit 13

4
Task/Caesar_cipher/REXX/caesar_cipher.rexx
View file

@ -8,7 +8,7 @@ y=caesar(p, key) ; say ' cyphered:' y
z=caesar(y,-key) ; say ' uncyphered:' z
if z\==p then say "plain text doesn't match uncyphered cyphered text."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
/*──────────────────────────────────CAESAR subroutine───────────────────*/
caesar: procedure; arg s,k; @='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; L=length(@)
ak=abs(k)
if ak > length(@)-1 | k==0 | k=='' then call err k 'key is invalid'
@ -18,5 +18,5 @@ if _\==0 then call err 'unsupported character:' substr(s,_,1)
if k>0 then ky=k+1 /*either cypher it, or ... */
else ky=27-ak /* decypher it. */
return translate(s,substr(@||@,ky,L),@)
/*──────────────────────────────────ERR subroutine──────────────────────*/
/*──────────────────────────────────ERR subroutine──────────────────────*/
err: say; say '***error!***'; say; say arg(1); say; exit 13

4
Task/Calendar/0DESCRIPTION
View file

@ -1,11 +1,11 @@
Create a routine that will generate a text calendar for any year. Test the calendar by generating a calendar for the year 1969, on a device of the time. Choose one of the following devices:
* A line printer with a width of 132 characters.
* An [[wp:IBM_3270#Displays|IBM 3278 model 4 terminal]] (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43.
* An [[wp:IBM_3270#Displays|IBM 3278 model 4 terminal]] (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43.
(Ideally, the program will generate well-formatted calendars for any page width from 20 characters up.)
Kudos (κῦδος) for routines that also correctly transition from Julian to Gregorian calendar in September 1752.
Kudos (κῦδος) for routines that also correctly transition from Julian to Gregorian calendar in September 1752.
This task is inspired by [http://www.ee.ryerson.ca/~elf/hack/realmen.html Real Programmers Don't Use PASCAL] by Ed Post, Datamation, volume 29 number 7, July 1983.
THE REAL PROGRAMMER'S NATURAL HABITAT

22
Task/Calendar/REXX/calendar.rexx
View file

@ -62,7 +62,7 @@ calfill=left(copies(calfill,cw),cw)
_yyyy=yyyy; calPuts=0; cv=1; _mm=mm+0; month=word(months,mm)
dy.2=28+ly(_yyyy); dim=dy._mm; _dd=01; dow=dow(_mm,_dd,_yyyy); $dd=dd+0
/*─────────────────────────────now: the business of the building the cal*/
/*─────────────────────────────now: the business of the building the cal*/
call calGen
do _j=2 to mc
if cv_\=='' then do
@ -80,10 +80,10 @@ call calGen
call fcalPuts
return _
/*─────────────────────────────calGen subroutine────────────────────────*/
/*─────────────────────────────calGen subroutine────────────────────────*/
calGen: cellX=;cellJ=;cellM=;calCells=0;calline=0
call calPut
call calPutl copies('─',calwidth),"┌┐"; call calHd
call calPutl copies('─',calwidth),"┌┐"; call calHd
call calPutl month ' ' _yyyy ; call calHd
if narrowest | narrower then call calPutl daysn
else do jw=1 for 3
@ -97,23 +97,23 @@ calfb=1
if sd>32 & \shorter then call calPut
return
/*─────────────────────────────cellDraw subroutine──────────────────────*/
/*─────────────────────────────cellDraw subroutine──────────────────────*/
cellDraw: parse arg zz,cdDOY;zz=right(zz,2);calCells=calCells+1
if calCells>7 then do
calLine=calLine+1
cellX=substr(cellX,2)
cellJ=substr(cellJ,2)
cellM=substr(cellM,2)
cellB=translate(cellX,,")(─-"#)
cellB=translate(cellX,,")(─-"#)
if calLine==1 then call cx
call calCsm; call calPutl cellX; call calCsj; call cx
cellX=; cellJ=; cellM=; calCells=1
end
cdDOY=right(cdDOY,cw); cellM=cellM'│'center('',cw)
cellX=cellX'│'centre(zz,cw); cellJ=cellJ'│'center('',cw)
cdDOY=right(cdDOY,cw); cellM=cellM'│'center('',cw)
cellX=cellX'│'centre(zz,cw); cellJ=cellJ'│'center('',cw)
return
/*═════════════════════════════general 1-line subs══════════════════════*/
/*═════════════════════════════general 1-line subs══════════════════════*/
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abbl: return verify(arg(1)'a',@abc,'M')-1
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
@ -121,8 +121,8 @@ calCsj: if sd>49 & \shorter then call calPutl cellB; if sd>24 & \short then c
calCsm: if sd>24 & \short then call calPutl cellM; if sd>49 & \shorter then call calPutl cellB; return
calHd: if sd>24 & \shorter then call calPutl ; if sd>32 & \shortest then call calPutl ; return
calPb: calPuts=calPuts+1; maxKalPuts=max(maxKalPuts,calPuts); if symbol('CT.'calPuts)\=='VAR' then ct.calPuts=; ct.calPuts=overlay(arg(1),ct.calPuts,cv); return
calPutl: call calPut copies(' ',cindent)left(arg(2)"│",1)center(arg(1),calwidth)||right('│'arg(2),1);return
cx:cx_='├┤';cx=copies(copies('─',cw)'┼',7);if calft then do;cx=translate(cx,'┬',"┼");calft=0;end;if calfb then do;cx=translate(cx,'┴',"┼");cx_='└┘';calfb=0;end;call calPutl cx,cx_;return
calPutl: call calPut copies(' ',cindent)left(arg(2)"│",1)center(arg(1),calwidth)||right('│'arg(2),1);return
cx:cx_='├┤';cx=copies(copies('─',cw)'┼',7);if calft then do;cx=translate(cx,'┬',"┼");calft=0;end;if calfb then do;cx=translate(cx,'┴',"┼");cx_='└┘';calfb=0;end;call calPutl cx,cx_;return
dow: procedure; arg m,d,y; if m<3 then do; m=m+12; y=y-1; end; yl=left(y,2); yr=right(y,2); w=(d+(m+1)*26%10+yr+yr%4+yl%4+5*yl)//7; if w==0 then w=7; return w
er :parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2;if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
@ -142,4 +142,4 @@ numx: return num(arg(1),arg(2),1)
p: return word(arg(1),1)
put: _=arg(1);_=translate(_,,'_'chk);if \grid then _=ungrid(_);if lowerCase then _=lower(_);if upperCase then upper _;if shortest&_=' ' then return;call tell _;return
tell: say arg(1);return
ungrid: return translate(arg(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
ungrid: return translate(arg(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")

48
Task/Closest-pair_problem/0DESCRIPTION
View file

@ -5,15 +5,15 @@ The straightforward solution is a O(n<sup>2</sup>) algorithm (which we can call
'''bruteForceClosestPair''' of P(1), P(2), ... P(N)
'''if''' N &lt; 2 '''then'''
'''return''' ∞
'''return''' ∞
'''else'''
minDistance ← |P(1) - P(2)|
minPoints ← { P(1), P(2) }
'''foreach''' i ∈ [1, N-1]
'''foreach''' j ∈ [i+1, N]
minDistance ← |P(1) - P(2)|
minPoints ← { P(1), P(2) }
'''foreach''' i ∈ [1, N-1]
'''foreach''' j ∈ [i+1, N]
'''if''' |P(i) - P(j)| < minDistance '''then'''
minDistance ← |P(i) - P(j)|
minPoints ← { P(i), P(j) }
minDistance ← |P(i) - P(j)|
minPoints ← { P(i), P(j) }
'''endif'''
'''endfor'''
'''endfor'''
@ -25,30 +25,30 @@ A better algorithm is based on the recursive divide&amp;conquer approach, as exp
'''closestPair''' of (xP, yP)
where xP is P(1) .. P(N) sorted by x coordinate, and
yP is P(1) .. P(N) sorted by y coordinate (ascending order)
'''if''' N ≤ 3 '''then'''
'''if''' N ≤ 3 '''then'''
'''return''' closest points of xP using brute-force algorithm
'''else'''
xL ← points of xP from 1 to ⌈N/2⌉
xR ← points of xP from ⌈N/2⌉+1 to N
xm ← xP(⌈N/2⌉)<sub>x</sub>
yL ← { p ∈ yP : p<sub>x</sub> ≤ xm }
yR ← { p ∈ yP : p<sub>x</sub> &gt; xm }
(dL, pairL) ← ''closestPair'' of (xL, yL)
(dR, pairR) ← ''closestPair'' of (xR, yR)
(dmin, pairMin) ← (dR, pairR)
xL ← points of xP from 1 to ⌈N/2⌉
xR ← points of xP from ⌈N/2⌉+1 to N
xm ← xP(⌈N/2⌉)<sub>x</sub>
yL ← { p ∈ yP : p<sub>x</sub> ≤ xm }
yR ← { p ∈ yP : p<sub>x</sub> &gt; xm }
(dL, pairL) ← ''closestPair'' of (xL, yL)
(dR, pairR) ← ''closestPair'' of (xR, yR)
(dmin, pairMin) ← (dR, pairR)
'''if''' dL &lt; dR '''then'''
(dmin, pairMin) ← (dL, pairL)
(dmin, pairMin) ← (dL, pairL)
'''endif'''
yS ← { p ∈ yP : |xm - p<sub>x</sub>| &lt; dmin }
nS ← number of points in yS
(closest, closestPair) ← (dmin, pairMin)
yS ← { p ∈ yP : |xm - p<sub>x</sub>| &lt; dmin }
nS ← number of points in yS
(closest, closestPair) ← (dmin, pairMin)
'''for''' i '''from''' 1 '''to''' nS - 1
k ← i + 1
'''while''' k ≤ nS '''and''' yS(k)<sub>y</sub> - yS(i)<sub>y</sub> &lt; dmin
k ← i + 1
'''while''' k ≤ nS '''and''' yS(k)<sub>y</sub> - yS(i)<sub>y</sub> &lt; dmin
'''if''' |yS(k) - yS(i)| &lt; closest '''then'''
(closest, closestPair) ← (|yS(k) - yS(i)|, {yS(k), yS(i)})
(closest, closestPair) ← (|yS(k) - yS(i)|, {yS(k), yS(i)})
'''endif'''
k ← k + 1
k ← k + 1
'''endwhile'''
'''endfor'''
'''return''' closest, closestPair

4
Task/Closest-pair_problem/REXX/closest_pair_problem.rexx
View file

@ -23,12 +23,12 @@ minDD=(@.nearA.xx-@.nearB.xx)**2 + (@.nearA.yy-@.nearB.yy)**2
end /*j*/
say 'For' N "points:"; say
say ' 'center('x',w,"═")' ' center('y',w,"═")
say ' 'center('x',w,"═")' ' center('y',w,"═")
say 'The points ['right(@.nearA.xx,w)"," right(@.nearA.yy,w)"]" ' and'
say ' ['right(@.nearB.xx,w)"," right(@.nearB.yy,w)"]"; say
say 'the minimum distance between them is: ' sqrt(abs(minDD))
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────sqrt subroutine────────────────────*/
/*───────────────────────────────────sqrt subroutine────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0;d=digits();numeric digits 11
g=.sqrtG(); do j=0 while p>9; m.j=p; p=p%2+1; end
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end

2
Task/Collections/REXX/collections.rexx
View file

@ -31,6 +31,6 @@ fib.5 = 5
fib.6 = 8
fib.7 =17
do n=-5 to 5 /*define an array from -5 ──► 5 */
do n=-5 to 5 /*define an array from -5 ──► 5 */
sawtooth.n=n
end /*n*/ /*eleven elements will be defined. */

14
Task/Comments/REXX/comments.rexx
View file

@ -14,20 +14,20 @@ There can be no intervening character between the slash and asterisk (or
the asterisk and slash). These two joined characters cannot be separated
via a continued line, as in the manner of:
say 'If I were two─faced,' ,
say 'If I were two─faced,' ,
'would I be wearing this one?' ,
' --- Abraham Lincoln'
Here come's the thingy that ends this REXX comment. ───┐
│
│
↓
Here come's the thingy that ends this REXX comment. ───┐
│
│
↓
*/
hour = 12 /*high noon */
midnight = 00 /*first hour of the day */
suits = 1234 /*card suits: ♥ ♦ ♣ ♠ */
suits = 1234 /*card suits: ♥ ♦ ♣ ♠ */
hutchHdr = '/*'
hutchEnd = "*/"
@ -35,7 +35,7 @@ hutchEnd = "*/"
/* the previous two "hutch" assignments aren't
the start nor the end of a REXX comment. */
x=1000000 ** /*¡big power!*/ 1000
x=1000000 ** /*¡big power!*/ 1000
/*not a real good place for a comment (above),
but essentially, a REXX comment can be

8
Task/Death_Star/REXX/death_star.rexx
View file

@ -4,12 +4,12 @@ numeric digits 20 /*use a fair amount of precision.*/
lightSource = norm('-50 30 50')
call drawSphereM 2, .5, lightSource
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────drawSphereM subroutine──────────────*/
/*──────────────────────────────────drawSphereM subroutine──────────────*/
drawSphereM: procedure; parse arg k,ambient,lightSource
z1=0; z2=0
parse var lightSource s1 s2 s3 /*break-apart the light source. */
shading='·:!ºoe@░▒▓' /*shading chars for ASCI machines*/
shading='·:!ºoe@░▒▓' /*shading chars for ASCI machines*/
if 1=='f1'x then shading='.:!*oe&#%@' /*shading chars for EBCDIC machs.*/
shadesLength=length(shading)
@ -52,7 +52,7 @@ hole=' 1 1 -6 20'; parse var hole hole.cx hole.cy hole.cz hole.radius
end /*i*/
return
/*──────────────────────────────────hitSphere subroutine────────────────*/
/*──────────────────────────────────hitSphere subroutine────────────────*/
hitSphere: procedure expose z1 z2; parse arg $.cx $.cy $.cz $.radius, x0, y0
x=x0-$.cx
y=y0-$.cy
@ -61,7 +61,7 @@ hitSphere: procedure expose z1 z2; parse arg $.cx $.cy $.cz $.radius, x0, y0
z1=$.cz-_
z2=$.cz+_
return 1
/*──────────────────────────────────"1-liner" subroutines───────────────*/
/*──────────────────────────────────"1-liner" subroutines───────────────*/
V3: procedure; parse arg v; return norm(v)
dot.: procedure; parse arg x,y; d=dot(x,y); if d<0 then return -d; return 0
dot: procedure; parse arg x,y; s=0; do j=1 for words(x); s=s+word(x,j)*word(y,j); end; return s

4
Task/Detect_division_by_zero/REXX/detect_division_by_zero.rexx
View file

@ -6,9 +6,9 @@ y = x-x /*setting to zero the obtuse way.*/
z = x/y /*this'll do it, furrrr shurrre. */
exit /*We're kaput. Ja vohl ! */
/*───────────────────────────────error handling subroutines and others.─*/
/*───────────────────────────────error handling subroutines and others.─*/
err: if rc==42 then do; say; say /*1st, check for a specific error*/
say center(' division by zero is a no-no. ',79,'═')
say center(' division by zero is a no-no. ',79,'═')
say; say
exit 130
end

2
Task/Detect_division_by_zero/Racket/detect_division_by_zero.rkt
View file

@ -1,5 +1,5 @@
#lang racket
(with-handlers ([exn:fail:contract:divide-by-zero?
(λ (e) (displayln "Divided by zero"))])
(λ (e) (displayln "Divided by zero"))])
(/ 1 0))

12
Task/Determine_if_a_string_is_numeric/REXX/determine_if_a_string_is_numeric.rexx
View file

@ -33,14 +33,14 @@ zzz=' - 000008.201e-00000000000000002 '
if \datatype(yyy,'n') then say 'oops, not numeric:' yyy
if \datatype(yyy,'N') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'N') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'numeric') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'nimrod.') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'N') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'numeric') then say 'oops, not numeric:' yyy
if ¬datatype(yyy,'nimrod.') then say 'oops, not numeric:' yyy
if datatype(yyy)\=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)/=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬= 'NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬=='NUM' then say 'oops, not numeric:' yyy
if datatype(yyy)¬= 'NUM' then say 'oops, not numeric:' yyy
/*note: REXX only looks at the first char for DATATYPE's 2nd arg. */
/*note: some REXX interpreters don't support the ¬ (not) character.*/
/*note: some REXX interpreters don't support the ¬ (not) character.*/

6
Task/Entropy/REXX/entropy-2.rexx
View file

@ -17,11 +17,11 @@ sum=0 /*calc info entropy for each char*/
say ' input string: ' $
say 'string length: ' L
say ' unique chars: ' n ; say
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────LOG2 subroutine─────────────────────*/
/*──────────────────────────────────LOG2 subroutine─────────────────────*/
log2: procedure; parse arg x 1 xx; ig= x>1.5; is=1-2*(ig\==1); ii=0
numeric digits digits()+5 /* [↓] precision of E must be > digits().*/
numeric digits digits()+5 /* [↓] precision of E must be > digits().*/
e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
do while ig & xx>1.5 | \ig&xx<.5; _=e; do k=-1; iz=xx* _**-is
if k>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end

2
Task/FizzBuzz/REXX/fizzbuzz-2.rexx
View file

@ -1,4 +1,4 @@
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
do n=1 for 100
select

2
Task/FizzBuzz/REXX/fizzbuzz-3.rexx
View file

@ -1,4 +1,4 @@
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
do n=1 for 100; _=
if n//3 ==0 then _= 'Fizz'

2
Task/FizzBuzz/REXX/fizzbuzz.rexx
View file

@ -1,4 +1,4 @@
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */
do j=1 to 100; z=j
if j//3 ==0 then z='Fizz'

12
Task/Knuth_shuffle/REXX/knuth_shuffle.rexx
View file

@ -1,9 +1,9 @@
/*REXX program shuffles a deck of playing cards using the Knuth shuffle.*/
rank='ace duece trey 4 5 6 7 8 9 10 jack queen king'
suit='club spade diamond heart'
say '────────────────── getting a new deck out of the box...'
say '────────────────── getting a new deck out of the box...'
deck.1=' color joker' /*good decks have a color joker, */
deck.2=' b&w joker' /*∙∙∙ and a black & white joker. */
deck.2=' b&w joker' /*∙∙∙ and a black & white joker. */
cards=2 /*now, two cards are in the deck.*/
do j =1 for words(suit)
do k=1 for words(rank)
@ -13,7 +13,7 @@ cards=2 /*now, two cards are in the deck.*/
end /*j*/
call showDeck 'ace' /*inserts blank when ACE is found*/
say '────────────────── shuffling' cards "cards..."
say '────────────────── shuffling' cards "cards..."
do s=cards by -1 to 1; rand=random(1,s)
if rand\==s then do /*swap two cards in the card deck*/
@ -24,14 +24,14 @@ say '────────────â
end /*s*/
call showDeck
say '────────────────── ready to play schafkopf (take out jokers first).'
say '────────────────── ready to play schafkopf (take out jokers first).'
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────SHOWDECK subroutine─────────────────*/
/*──────────────────────────────────SHOWDECK subroutine─────────────────*/
showDeck: parse arg break; say
do m=1 for cards
if pos(break,deck.m)\==0 then say /*blank, easier to read cards*/
say 'card' right(m,2) '───►' deck.m
say 'card' right(m,2) '───►' deck.m
end /*m*/
say
return

6
Task/Ordered_words/REXX/ordered_words.rexx
View file

@ -3,7 +3,7 @@ ifid = 'UNIXDICT.TXT' /*filename of the word dictionary*/
@.= /*placeholder for list of words. */
mL=0 /*maximum length of ordered words*/
call linein ifid,1,0 /*point to the first word in dict*/
/*(above)───in case file is open.*/
/*(above)───in case file is open.*/
do j=1 while lines(ifid)\==0 /*keep reading until exhausted. */
x=linein(ifid); w=length(x) /*get a word and also its length.*/
if w<mL then iterate /*if not long enough, ignore it. */
@ -14,7 +14,7 @@ call linein ifid,1,0 /*point to the first word in dict*/
if \datatype(_,'U') then iterate /*Not a letter? Then skip it. */
if _<z then iterate j /*is letter < than the previous ?*/
z=_ /*we have a newer current letter.*/
end /*k*/ /*(above) logic includes ≥ order.*/
end /*k*/ /*(above) logic includes ≥ order.*/
mL=w /*maybe define a new maximum len.*/
@.w=@.w x /*add orig. word to a word list.*/
@ -24,5 +24,5 @@ q=words(@.mL) /*just a handy-dandy var to have.*/
say q 'word's(q) "found (of length" mL')'; say /*show #words & length*/
do n=1 for q; say word(@.mL,n); end /*list all the words. */
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────S subroutine────────────────────────*/
/*──────────────────────────────────S subroutine────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*a simple pluralizer.*/

2
Task/Pi/REXX/pi.rexx
View file

@ -6,7 +6,7 @@ numeric digits digs /*big digs, the slower the spits.*/
pi=0; s=16; r=4; v=5; vs=v*v; g=239; gs=g*g; old=; spewed=0; j=1
call time 'E'
/*─────────────────────────────────────John Machin's formula for pi. */
/*─────────────────────────────────────John Machin's formula for pi. */
do n=1 by 2
pi=pi + s/(n*v) - r/(n*g)
if pi==old then leave /*no further with current DIGITS.*/

2
Task/Search_a_list/REXX/search_a_list-2.rexx
View file

@ -34,7 +34,7 @@ if found then return j /*return haystack index number. */
else say needle "wasn't found in the haystack!"
return 0 /*indicates needle wasn't found. */
/*─────────────────────────────────────────────── incidentally, to find */
/*─────────────────────────────────────────────── incidentally, to find */
/* the number of haystack items: */
hayItems=0