

 This page uses content from Wikipedia. The original article was at Burrows–Wheeler_transform. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)



The Burrows–Wheeler transform (BWT, also called block-sorting compression) rearranges a character string into runs of similar characters.

This is useful for compression, since it tends to be easy to compress a string that has runs of repeated characters by techniques such as move-to-front transform and run-length encoding.

More importantly, the transformation is reversible, without needing to store any additional data.

The BWT is thus a "free" method of improving the efficiency of text compression algorithms, costing only some extra computation.



Source: Burrows–Wheeler transform

/*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