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

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

58
Task/Burrows-Wheeler-transform/REXX/burrows-wheeler-transform.rexx Normal file
View file

@ -0,0 +1,58 @@
/*REXX program performs a Burrows─Wheeler transform (BWT) on a character string(s). */
$.= /*the default text for (all) the inputs*/
parse arg $.1 /*obtain optional arguments from the CL*/
if $.1='' then do; $.1= "banana" /*Not specified? Then use the defaults*/
$.2= "BANANA"
$.3= "appellee"
$.4= "dogwood"
$.5= "TO BE OR NOT TO BE OR WANT TO BE OR NOT?"
$.6= "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES"
$.7= "^ABC|"
$.7= "bad─bad thingy"'fd'x /* ◄─── this string can't be processed.*/
end
/* [↑] show blank line between outputs*/
do t=1 while $.t\=''; if t\==1 then say /*process each of the inputs (or input)*/
out= BWT($.t) /*invoke the BWT function, get result*/
ori= iBWT(out) /* " " iBWT " " " */
say ' input ───► ' $.t /*display input string to term.*/
say ' output ───► ' out /* " output " " " */
say 'original ───► ' ori /* " reconstituted " " " */
end /*t*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
BWT: procedure expose ?.; parse arg y,,$ /*obtain the input; nullify $ string. */
?.1= 'fd'x; ?.2= "fc"x /*assign the STX and ETX strings. */
do i=1 for 2 /* [↓] check for invalid input string.*/
_= verify(y, ?.i, 'M'); if _==0 then iterate; er= '***error*** BWT: '
say er "invalid input: " y
say er 'The input string contains an invalid character at position' _"."; exit _
end /*i*/ /* [↑] if error, perform a hard exit.*/
y= ?.1 || y || ?.2; L= length(y) /*get the input & add a fence; gel len.*/
@.1= y; m= L - 1 /*define the first element of the table*/
do j=2 for m; _= j-1 /*now, define the rest of the elements.*/
@.j= right(@._,1)left(@._,m) /*construct a table from the Y input.*/
end /*j*/ /* [↑] each element: left & right part*/
call cSort L /*invoke lexicographical sort for array*/
do k=1 for L /* [↓] construct the answer from array*/
$= $ || right(@.k, 1) /*build the answer from each of ··· */
end /*k*/ /* ··· the array's right─most character*/
return $ /*return the constructed answer. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
iBWT: procedure expose ?.; parse arg y,,@. /*obtain the input; nullify @. string.*/
L= length(y) /*compute the length of the input str. */
do j=1 for L /* [↓] step through each input letters*/
do k=1 for L /* [↓] step through each row of table.*/
@.k= substr(y, k, 1) || @.k /*construct a row of the table of chars*/
end /*k*/ /* [↑] order of table row is inverted.*/
call cSort L /*invoke lexicographical sort for array*/
end /*j*/ /* [↑] answer is the penultimate entry*/
do #=1
if right(@.#, 1)==?.2 then return substr(@.#, 2, L-2) /*return correct result*/
end /*#*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
cSort: procedure expose @.; parse arg n; m=n-1 /*N: is the number of @ array elements.*/
do m=m for m by -1 until ok; ok=1 /*keep sorting the @ array until done.*/
do j=1 for m; k= j+1; if @.j<<=@.k then iterate /*elements in order?*/
_= @.j; @.j= @.k; @.k= _; ok= 0 /*swap two elements; flag as not done.*/
end /*j*/
end /*m*/; return