/*REXX program reads 2 files & displays a ranked list of Rosetta Code languages by users*/
parse arg catFID lanFID outFID .                 /*obtain optional arguments from the CL*/
call init                                        /*initialize some  REXX  variables.    */
call get                                         /*obtain data from two separate files. */
call eSort #,0                                   /*sort languages along with members.   */
call tSort                                       /*  "      "     that are tied in rank.*/
call eSort #,1                                   /*  "      "     along with members.   */
call out                                         /*create the RC_USER.OUT (output) file.*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg _;   do jc=length(_)-3  to 1  by -3; _= insert(",",_,jc); end;  return _
s:      if arg(1)==1  then return arg(3);      return word(arg(2) 's',1)   /*pluralizer.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
eSort: procedure expose #. @. !tr.;    arg N,p2;     h= N      /*sort: number of members*/
            do     while  h>1;         h= h % 2                /*halve number of records*/
              do i=1  for N-h;         j= i;         k= h + i  /*sort this part of list.*/
              if p2  then do  while !tR.k==!tR.j  &  @.k>@.j   /*this uses a hard swap ↓*/
                          @= @.j;  #= !tR.j;  @.j= @.k;  !tR.j= !tR.k;   @.k= @;  !tR.k= #
                          if h>=j  then leave;               j= j - h;     k= k - h
                          end   /*while !tR.k==···*/
                     else do  while #.k<#.j                    /*this uses a hard swap ↓*/
                          @= @.j;  #= #.j;    @.j= @.k;    #.j= #.k;     @.k= @;    #.k= #
                          if h>=j  then leave;               j= j - h;     k= k - h
                          end   /*while #.k<···*/
              end               /*i*/           /*hard swaps needed for embedded blanks.*/
            end                 /*while h>1*/;               return
/*──────────────────────────────────────────────────────────────────────────────────────*/
get: langs= 0;           call rdr 'languages'    /*assign languages  ───►  L.ααα        */
                         call rdr 'categories'   /*append categories ───► catHeap       */
     #= 0
           do j=1  until  catHeap==''            /*process the heap of categories.      */
           parse var catHeap cat.j (sep) catHeap /*get a category from the  catHeap.    */
           parse var cat.j  cat.j '<' "(" mems . /*untangle the strange─looking string. */
           cat.j= space(cat.j); ?=cat.j; upper ? /*remove any superfluous blanks.       */
           if ?=='' | \L.?          then iterate /*it's blank  or  it's not a language. */
           if pos(',', mems)\==0    then mems= space(translate(mems,,","), 0) /*¬commas.*/
           if \datatype(mems, 'W')  then iterate /*is the "members" number not numeric? */
           #.0= #.0 + mems                       /*bump the number of  members  found.  */
           if u.?\==0  then do;     do f=1  for #  until [email protected].f
                                    end   /*f*/
                            #.f= #.f + mems; iterate j   /*languages in different cases.*/
                            end                  /* [↑]  handle any possible duplicates.*/
           u.?= u.? + 1;       #= # + 1          /*bump a couple of counters.           */
           #.#= #.# + mems;  @.#= cat.j;  @u.#=? /*bump the counter;  assign it (upper).*/
           end   /*j*/

     !.=;        @tno= '(total) number of'       /*array holds indication of TIED langs.*/
     call tell right(commas(#),    9) @tno 'languages detected in the category file'
     call tell right(commas(langs),9) '   "       "    "     "         "     "  "  language   "'
     call tell right(commas(#.0),  9) @tno 'entries (users of lanugages) detected', , 1
     term= 0
     return                                      /*don't show any more msgs──►term. [↑] */
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: sep= '█';  L.=0;  #.=0;  u.=#.;  catHeap=;  term=1;  old.= /*assign some REXX vars*/
      if catFID==''  then catFID= "RC_USER.CAT"  /*Not specified?  Then use the default.*/
      if lanFID==''  then lanFID= "RC_USER.LAN"  /* "      "         "   "   "     "    */
      if outFID==''  then outFID= "RC_USER.OUT"  /* "      "         "   "   "     "    */
      call tell center('timestamp: '  date()  time("Civil"),79,'═'), 2, 1;      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
out:  w= length( commas(#) );     rank= 0        /* [↓]  show by ascending rank of lang.*/
          do t=#  by -1  for #;   rank= rank + 1 /*bump rank of a programming language. */
          call tell   right('rank:'    right(commas(!tR.t), w),  20-1)      right(!.t, 7),
                      right('('commas(#.t)  left("entr"s(#.t, 'ies', "y")')', 9), 20)  @.t
          end   /*#*/                            /* [↑]   S(···)   pluralizes a word.   */
      call tell left('', 27)  "☼  end─of─list.  ☼", 1, 2;      return    /*bottom title.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
rdr:  arg which 2;        igAst= 1               /*ARG uppers WHICH, obtain the 1st char*/
      if which=='L'  then inFID= lanFID          /*use this fileID for the  languages.  */
      if which=='C'  then inFID= catFID          /* "    "     "    "   "   categories. */
      Uyir=  'α«ëα«»α«┐α«░α»ì/Uyir'              /*Unicode (in text)  name for  Uyir    */
      old.0= '╬£C++'     ;    new.0= "µC++"      /*Unicode ╬£C++  ───► ASCII─8: µC++    */
      old.1= 'UC++'      ;    new.1= "µC++"      /*old      UC++  ───► ASCII─8: µC++    */
      old.2= '╨£╨Ü-'     ;    new.2= "MK-"       /*Unicode ╨£╨Ü─  ───► ASCII-8: MK-     */
      old.3= 'D├⌐j├á'    ;    new.3= "Déjà"      /*Unicode ├⌐j├á  ───► ASCII─8: Déjà    */
      old.4= 'Cach├⌐'    ;    new.4= "Caché"     /*Unicode Cach├⌐ ───► ASCII─8: Caché   */
      old.5= '??-61/52'  ;    new.5= "MK-61/52"  /*somewhere past, a mis─translated: MK-*/
      old.6= 'F┼ìrmul├ª' ;    new.6= 'Fôrmulæ'   /*Unicode        ───► ASCII─8: Fôrmulæ */
      old.7= '╨£iniZinc' ;    new.7= 'MiniZinc'  /*Unicode        ───► ASCII─8: MiniZinc*/
      old.8=  Uyir       ;    new.8= 'Uyir'      /*Unicode        ───► ASCII─8: Uyir    */
      old.9= 'Perl 6'    ;    new.9= 'Raku'      /* (old name)    ───► (new name)       */

        do recs=0   while  lines(inFID) \== 0    /*read a file, a single line at a time.*/
        $= translate( linein(inFID), , '9'x)     /*handle any stray  TAB  ('09'x) chars.*/
        $$= space($);   if $$==''  then iterate  /*ignore all blank lines in the file(s)*/
                do v=0  while old.v \== ''       /*translate Unicode variations of langs*/
                if pos(old.v, $$) \==0  then $$= changestr(old.v, $$, new.v)
                end   /*v*/                      /* [↑]  handle different lang spellings*/
        if igAst  then do;  igAst= pos(' * ', $)==0;      if igAst  then iterate;      end
        if pos('RETRIEVED FROM', translate($$))\==0  then leave   /*pseudo End─Of─Data?.*/
        if which=='L'  then do;  if left($$, 1)\=="*"  then iterate  /*lang ¬legitimate?*/
                                 parse upper var   $$   '*'  $$  "<";    $$= space($$)
                                 if $$==''  then iterate
                                 $$= $$ 'USER'
                                 L.$$= 1
                                 langs= langs + 1     /*bump # of languages/users found.*/
                                 iterate
                            end                  /* [↓]  extract computer language name.*/
        if left($$, 1)=='*'  then $$= sep  ||  space( substr($$, 2) )
        catHeap= catHeap  $$                     /*append to the catHeap (CATegory) heap*/
        end   /*recs*/
      call  tell   right( commas(recs), 9)       'records read from file: '        inFID
      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
tell:          do '0'arg(2);   call lineout outFID," "     ;   if term  then say ;     end
                               call lineout outFID,arg(1)  ;   if term  then say arg(1)
               do '0'arg(3);   call lineout outFID," "     ;   if term  then say ;     end
       return       /*show BEFORE blank lines (if any), message, show AFTER blank lines.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
tSort: tied=;                            r= 0    /*add true rank (tR) ───► the entries. */
               do j=#  by -1  for #;     r= r+1;   tR= r;   !tR.j= r;   jp= j+1;   jm= j-1
               if tied==''  then pR= r;  tied=   /*handle when language rank is untied. */
               if #.j==#.jp | #.j==#.jm  then do;    !.j= '[tied]';     tied= !.j;     end
               if #.j==#.jp              then do;    tR= pR;            !tR.j= pR;     end
                                         else pR= r
               end   /*j*/;      return


res = []
until res.sum >= 75 && res.count{|n| n >= 15} >= 2 do
  res = Array.new(6) do
    a = Array.new(4){rand(1..6)}
    a.sum - a.min
  end
end

p res
puts "sum: #{res.sum}"


dim statnames$(6)
data "STR", "CON", "DEX", "INT", "WIS", "CHA"
for i = 1 to 6
    read statnames$(i)
next i
dim stat(6)
acceptable = false

while 1
    sum = 0 : n15 = 0
    for i = 1 to 6
        stat(i) = rollstat()
        sum = sum + stat(i)
	if stat(i) >= 15 then n15 = n15 + 1
    next i
    if sum >= 75 and n15 >= 2 then exit while
wend

for i = 1 to 6
    print statnames$(i); ": "; stat(i)
next i
print "-------"
print "TOT: "; sum
end

function d6()
    d6 = 1 + int(rnd(1) * 6)
end function

function rollstat()
    a = d6() : b = d6() : c = d6() : d = d6()
    rollstat = a + b + c + d - min(min(a, b), min(c, d))
end function


use rand::distributions::Uniform;
use rand::prelude::{thread_rng, ThreadRng};
use rand::Rng;

fn main() {
    for _ in 0..=10 {
        attributes_engine();
    }
}

#[derive(Copy, Clone, Debug)]
pub struct Dice {
    amount: i32,
    range: Uniform<i32>,
    rng: ThreadRng,
}

impl Dice {
    //  Modeled after d20 polyhederal dice use and notation.
    //  roll_pool() - returns Vec<i32> with length of vector determined by dice amount.
    //  attribute_out() - returns i32, by sorting a dice pool of 4d6, dropping the lowest integer, and summing all elements.
    pub fn new(amount: i32, size: i32) -> Self {
        Self {
            amount,
            range: Uniform::new(1, size + 1),
            rng: thread_rng(),
        }
    }

    fn roll_pool(mut self) -> Vec<i32> {
        (0..self.amount)
            .map(|_| self.rng.sample(self.range))
            .collect()
    }

    fn attribute_out(&self) -> i32 {
        // Sort dice pool lowest to high and drain all results to exclude the lowest before summing.
        let mut attribute_array: Vec<i32> = self.roll_pool();
        attribute_array.sort();
        attribute_array.drain(1..=3).sum()
    }
}

fn attributes_finalizer() -> (Vec<i32>, i32, bool) {
    let die: Dice = Dice::new(4, 6);
    let mut attributes: Vec<i32> = Vec::new();

    for _ in 0..6 {
        attributes.push(die.attribute_out())
    }

    let attributes_total: i32 = attributes.iter().sum();

    let numerical_condition: bool = attributes
        .iter()
        .filter(|attribute| **attribute >= 15)
        .count()
        >= 2;

    (attributes, attributes_total, numerical_condition)
}

fn attributes_engine() {
    loop {
        let (attributes, attributes_total, numerical_condition) = attributes_finalizer();
        if (attributes_total >= 75) && (numerical_condition) {
            println!(
                "{:?} | sum: {:?}",
                attributes, attributes_total
            );
            break;
        } else {
            continue;
        }
    }
}


**
** Generates a run-length encoding for a string
**
class RLE
{
  Run[] encode(Str s)
  {
    runs := Run[,]

    s.size.times |i|
    {
      ch := s[i]
      if (runs.size==0 || runs.last.char != ch)
        runs.add(Run(ch))
      runs.last.inc
    }
    return runs
  }

  Str decode(Run[] runs)
  {
    buf := StrBuf()
    runs.each |run|
    {
      run.count.times { buf.add(run.char.toChar) }
    }
    return buf.toStr
  }

  Void main()
  {
    echo(decode(encode(
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
        )))
  }

}

internal class Run
{
  Int char
  Int count := 0
  new make(Int ch) { char = ch }
  Void inc() { ++count }

  override Str toStr() { return "${count}${char.toChar}" }
}


variable a
: n>a  (.) tuck a @ swap move a +! ;
: >a   a @ c! 1 a +! ;
: encode ( c-addr +n a -- a n' )
  dup a ! -rot over [email protected] 1 2swap 1 /string bounds ?do
    over i [email protected] = if 1+
    else n>a >a i [email protected] 1 then
  loop n>a >a  a @ over - ;

: digit?  [char] 0 [ char 9 1+ literal ] within ;
: decode ( c-addr +n a -- a n' )
  dup a ! 0 2swap bounds ?do
    i [email protected] digit? if 10 * i [email protected] [char] 0 - + else
    a @ over i [email protected] fill a +! 0 then
  loop drop a @ over - ;


copy "http://rosettacode.org/mw/index.php?title=Special:Categories&limit=5000" categ.html, replace
import delimited categ.html, delim("@") enc("utf-8") clear
keep if ustrpos(v1,"/wiki/Category:") & ustrpos(v1,"_User")
gen i = ustrpos(v1,"href=")
gen j = ustrpos(v1,char(34),i+1)
gen k = ustrpos(v1,char(34),j+1)
gen s = usubstr(v1,j+7,k-j-7)
replace i = ustrpos(v1,"title=")
replace j = ustrpos(v1,">",i+1)
replace k = ustrpos(v1," User",j+1)
gen lang = usubstr(v1,j+1,k-j)
keep s lang
gen users=.

forval i=1/`c(N)' {
	local s
	preserve
	copy `"https://rosettacode.org/mw/index.php?title=`=s[`i']'&redirect=no"' `i'.html, replace
	import delimited `i'.html, delim("@") enc("utf-8") clear
	count if ustrpos(v1,"/wiki/User")
	local m `r(N)'
	restore
	replace users=`m' in `i'
	erase `i'.html
}

drop s
gsort -users lang
compress
leftalign
list in f/50
save rc_users, replace


/* rc_rank_languages_by_number_of_users.wren */

import "./pattern" for Pattern
import "./fmt" for Fmt

var CURLOPT_URL = 10002
var CURLOPT_FOLLOWLOCATION = 52
var CURLOPT_WRITEFUNCTION = 20011
var CURLOPT_WRITEDATA = 10001

foreign class Buffer {
    construct new() {}  // C will allocate buffer of a suitable size

    foreign value       // returns buffer contents as a string
}

foreign class Curl {
    construct easyInit() {}

    foreign easySetOpt(opt, param)

    foreign easyPerform()

    foreign easyCleanup()
}

var curl = Curl.easyInit()

var getContent = Fn.new { |url|
    var buffer = Buffer.new()
    curl.easySetOpt(CURLOPT_URL, url)
    curl.easySetOpt(CURLOPT_FOLLOWLOCATION, 1)
    curl.easySetOpt(CURLOPT_WRITEFUNCTION, 0)  // write function to be supplied by C
    curl.easySetOpt(CURLOPT_WRITEDATA, buffer)
    curl.easyPerform()
    return buffer.value
}

var p = Pattern.new(" User\">[+1^<]<//a>\u200f\u200e ([#13/d] member~s)")
var url = "http://rosettacode.org/mw/index.php?title=Special:Categories&limit=4000"
var content = getContent.call(url)
var matches = p.findAll(content)
var over100s = []
for (m in matches) {
    var numUsers = Num.fromString(m.capsText[1])
    if (numUsers >= 100) {
       var language = m.capsText[0][0..-6]
       over100s.add([language, numUsers])
    }
}
over100s.sort { |a, b| a[1] > b[1] }
System.print("Languages with at least 100 users as at 4 January, 2022:")
var rank = 0
var lastScore = 0
var lastRank = 0
for (i in 0...over100s.count) {
    var pair = over100s[i]
    var eq = " "
    rank = i + 1
    if (lastScore == pair[1]) {
        eq = "="
        rank = lastRank
    } else {
        lastScore = pair[1]
        lastRank = rank
    }
    Fmt.print("$-2d$s  $-11s  $d", rank, eq, pair[0], pair[1])
}


const MIN_USERS=60;
var [const] CURL=Import("zklCurl"), YAJL=Import("zklYAJL")[0];

fcn rsGet{
   continueValue,r,curl := "",List, CURL();
   do{	// eg 5 times
      page:=("http://rosettacode.org/mw/api.php?action=query"
        "&generator=categorymembers&prop=categoryinfo"
	"&gcmtitle=Category%%3ALanguage%%20users"
	"&rawcontinue=&format=json&gcmlimit=350"
	"%s").fmt(continueValue);
      page=curl.get(page);
      page=page[0].del(0,page[1]);  // get rid of HTML header
      json:=YAJL().write(page).close();
      json["query"]["pages"].pump(r.append,'wrap(x){ x=x[1];
         //("2708",Dictionary(title:Category:C User,...,categoryinfo:D(pages:373,size:373,...)))
	 // or title:SmartBASIC
	 if((pgs:=x.find("categoryinfo")) and (pgs=pgs.find("pages")) and
	    pgs>=MIN_USERS)
	   return(pgs,x["title"].replace("Category:","").replace(" User",""));
	   return(Void.Skip);
      });
      if(continueValue=json.find("query-continue",""))
        continueValue=String("&gcmcontinue=",
	   continueValue["categorymembers"]["gcmcontinue"]);
   }while(continueValue);
   r
}

allLangs:=rsGet();
allLangs=allLangs.sort(fcn(a,b){ a[0]>b[0] });
println("========== ",Time.Date.prettyDay()," ==========");
foreach n,pgnm in ([1..].zip(allLangs))
   { println("#%3d with %4s users: %s".fmt(n,pgnm.xplode())) }


import scala.util.Random
Random.setSeed(1)

def rollDice():Int = {
  val v4 = Stream.continually(Random.nextInt(6)+1).take(4)
  v4.sum - v4.min
}

def getAttributes():Seq[Int] = Stream.continually(rollDice()).take(6)

def getCharacter():Seq[Int] = {
  val attrs = getAttributes()
  println("generated => " + attrs.mkString("[",",", "]"))
  (attrs.sum, attrs.filter(_>15).size) match {
    case (a, b)  if (a < 75 || b < 2) => getCharacter
    case _ => attrs
  }
}

println("picked => " + getCharacter.mkString("[", ",", "]"))


$ include "seed7_05.s7i";

const proc: main is func
  local
    var integer: count is 0;
    var integer: total is 0;
    var integer: attribIdx is 0;
    var integer: diceroll is 0;
    var integer: sumOfRolls is 0;
    var array integer: attribute is 6 times 0;
    var array integer: dice is 4 times 0;
  begin
    repeat
      count := 0;
      total := 0;
      for key attribIdx range attribute do
        for key diceroll range dice do
          dice[diceroll] := rand(1, 6);
        end for;
        dice := sort(dice);
        sumOfRolls := 0;
        for diceroll range 2 to maxIdx(dice) do  # Discard the lowest roll
          sumOfRolls +:= dice[diceroll];
        end for;
        attribute[attribIdx] := sumOfRolls;
        total +:= sumOfRolls;
        if sumOfRolls >= 15 then
          incr(count);
        end if;
      end for;
    until total >= 75 and count >= 2;
    writeln("Attributes:");
    for key attribIdx range attribute do
       writeln(attribIdx <& " ..... " <& attribute[attribIdx] lpad 2);
    end for;
    writeln("       ----");
    writeln("Total  " <& total lpad 3);
  end func;


program RLE
  implicit none

  integer, parameter :: bufsize = 100   ! Sets maximum size of coded and decoded strings, adjust as necessary
  character(bufsize) :: teststr = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
  character(bufsize) :: codedstr = "", decodedstr = ""

  call Encode(teststr, codedstr)
  write(*,"(a)") trim(codedstr)
  call Decode(codedstr, decodedstr)
  write(*,"(a)") trim(decodedstr)

contains

subroutine Encode(instr, outstr)
  character(*), intent(in)  :: instr
  character(*), intent(out) :: outstr
  character(8) :: tempstr = ""
  character(26) :: validchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  integer :: a, b, c, i

  if(verify(trim(instr), validchars) /= 0) then
    outstr = "Invalid input"
    return
  end if
  outstr = ""
  c = 1
  a = iachar(instr(1:1))
  do i = 2, len(trim(instr))
    b = iachar(instr(i:i))
    if(a == b) then
      c = c + 1
    else
      write(tempstr, "(i0)") c
      outstr = trim(outstr) // trim(tempstr) // achar(a)
      a = b
      c = 1
    end if
  end do
  write(tempstr, "(i0)") c
  outstr = trim(outstr) // trim(tempstr) // achar(b)
end subroutine

subroutine Decode(instr, outstr)
  character(*), intent(in)  :: instr
  character(*), intent(out) :: outstr
  character(26) :: validchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  integer :: startn, endn, n

  outstr = ""
  startn = 1
  do while(startn < len(trim(instr)))
    endn = scan(instr(startn:), validchars) + startn - 1
    read(instr(startn:endn-1), "(i8)") n
    outstr = trim(outstr) // repeat(instr(endn:endn), n)
    startn = endn + 1
  end do
end subroutine
end program


FUNCTION min(a, b)
    IF a < b THEN LET min = a ELSE LET min = b
END FUNCTION

FUNCTION d6
    LET d6 = 1 + INT(RND * 6)
END FUNCTION

FUNCTION rollstat
    LET a = d6
    LET b = d6
    LET c = d6
    LET d = d6
    LET rollstat = a + b + c + d - min(min(a, b), min(c, d))
END FUNCTION

DIM statnames$(6)
DATA "STR", "CON", "DEX", "INT", "WIS", "CHA"
FOR i = 1 TO 6
    READ statnames$(i)
NEXT i
DIM stat(6)
LET acceptable = 0

RANDOMIZE                         ! RANDOMIZE TIMER en QBasic
DO
   LET sum = 0
   LET n15 = 0
   FOR i = 1 TO 6
       LET stat(i) = rollstat
       LET sum = sum + stat(i)
       IF stat(i) >= 15 THEN LET n15 = n15 + 1
   NEXT i
   IF sum >= 75 AND n15 >= 2 THEN LET acceptable = 1
LOOP UNTIL acceptable = 1

FOR i = 1 TO 6
    PRINT statnames$(i); ": "; stat(i)
NEXT i
PRINT "--------"
PRINT "TOT: "; sum
END


function main {
  typeset attrs=(str dex con int wis cha)
  typeset -A values
  typeset attr
  typeset -i value total fifteens
  while true; do
    fifteens=0
    total=0
    for attr in "${attrs[@]}"; do
      # "random" values repeat in zsh if run in a subshell
      r4d6drop >/tmp/$$
      read value </tmp/$$
      values[$attr]=$value
      (( total += value ))
      if (( value >= 15 )); then
        (( fifteens += 1 ))
      fi
    done
    if (( total >= 75 && fifteens >= 2 )); then
      break
    fi
  done
  rm -f /tmp/$$
  for attr in "${attrs[@]}"; do
    printf '%s: %d\n' "$attr" "${values[$attr]}"
  done
}

function r4d6drop {
   typeset -i d1=RANDOM%6+1 d2=RANDOM%6+1 d3=RANDOM%6+1 d4=RANDOM%6+1
   typeset e=$(printf '%s\n' $d1 $d2 $d3 $d4 |
     sort -n | tail -n +2 | tr $'\n' +)
  printf '%d\n' $(( ${e%+} ))
}

main "[email protected]"


Dim As String initial, encoded, decoded

Function RLDecode(i As String) As String
    Dim As Long Loop0
    dim as string rCount, outP, m

    For Loop0 = 1 To Len(i)
        m = Mid(i, Loop0, 1)
        Select Case m
        Case "0" To "9"
            rCount += m
        Case Else
            If Len(rCount) Then
                outP += String(Val(rCount), m)
                rCount = ""
            Else
                outP += m
            End If
        End Select
    Next
    RLDecode = outP
End Function

Function RLEncode(i As String) As String
    Dim As String tmp1, tmp2, outP
    Dim As Long Loop0, rCount

    tmp1 = Mid(i, 1, 1)
    tmp2 = tmp1
    rCount = 1

    For Loop0 = 2 To Len(i)
        tmp1 = Mid(i, Loop0, 1)
        If tmp1 <> tmp2 Then
            outP += Ltrim(Rtrim(Str(rCount))) + tmp2
            tmp2 = tmp1
            rCount = 1
        Else
            rCount += 1
        End If
    Next

    outP += Ltrim(Rtrim(Str(rCount)))
    outP += tmp2
    RLEncode = outP
End Function

Input "Type something: ", initial
encoded = RLEncode(initial)
decoded = RLDecode(encoded)
Print initial
Print encoded
Print decoded
End


Module Module1

    Dim r As New Random

    Function getThree(n As Integer) As List(Of Integer)
        getThree = New List(Of Integer)
        For i As Integer = 1 To 4 : getThree.Add(r.Next(n) + 1) : Next
        getThree.Sort() : getThree.RemoveAt(0)
    End Function

    Function getSix() As List(Of Integer)
        getSix = New List(Of Integer)
        For i As Integer = 1 To 6 : getSix.Add(getThree(6).Sum) : Next
    End Function

    Sub Main(args As String())
        Dim good As Boolean = False : Do
            Dim gs As List(Of Integer) = getSix(), gss As Integer = gs.Sum,
                hvc As Integer = gs.FindAll(Function(x) x > 14).Count
            Console.Write("attribs: {0}, sum={1}, ({2} sum, high vals={3})",
                          String.Join(", ", gs), gss, If(gss >= 75, "good", "low"), hvc)
            good = gs.Sum >= 75 AndAlso hvc > 1
            Console.WriteLine(" - {0}", If(good, "success", "failure"))
        Loop Until good
    End Sub
End Module


import "random" for Random
import "/sort" for Sort

var rand = Random.new()
var vals = List.filled(6, 0)
while (true) {
    for (i in 0..5) {
        var rns = List.filled(4, 0)
        for (j in 0..3) rns[j] = rand.int(1, 7)
        var sum = rns.reduce { |acc, n| acc + n }
        Sort.insertion(rns)
        vals[i] = sum - rns[0]
    }
    var total = vals.reduce { |acc, n| acc + n }
    if (total >= 75) {
        var fifteens = vals.count { |n| n >= 15 }
        if (fifteens >= 2) {
            System.print("The six values are: %(vals)")
            System.print("Their total is: %(total)")
            break
        }
    }
}


Public Sub Main()
Dim sString As String = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Dim siCount As Short = 1
Dim siStart As Short = 1
Dim sHold As New String[]
Dim sTemp As String

sString &= " "

Repeat
  sTemp = Mid(sString, siCount, 1)
  Do
    Inc siCount
    If Mid(sString, siCount, 1) <> sTemp Then Break
    If siCount = Len(sString) Then Break
  Loop
  sHold.add(Str(siCount - siStart) & sTemp)
  siStart = siCount
Until siCount = Len(sString)

Print sString & gb.NewLine & sHold.Join(", ")

End


func Gen; \Return sum of the three largest of four random values
int  I, R, Min, SI, Sum, Die(4);
[Min:= 7;  Sum:= 0;
for I:= 0 to 4-1 do
    [R:= Ran(6)+1; \R = 1..6
    if R < Min then
        [Min:= R;  SI:= I];
    Sum:= Sum+R;
    Die(I):= R;
    ];
return Sum - Die(SI);
];

int Total, Count, J, Value(6);
[repeat Total:= 0;  Count:= 0;
        for J:= 0 to 6-1 do
            [Value(J):= Gen;
            if Value(J) >= 15 then Count:= Count+1;
            Total:= Total + Value(J);
            ];
until   Total >= 75 and Count >= 2;
Text(0, "Total: ");  IntOut(0, Total);  CrLf(0);
for J:= 0 to 6-1 do
        [IntOut(0, Value(J));  ChOut(0, ^ )];
CrLf(0);
]


sub d6()
    //simulates a marked regular hexahedron coming to rest on a plane
    return  1 + int(ran(6))
end sub

sub roll_stat()
    //rolls four dice, returns the sum of the three highest
    a = d6() : b = d6(): c = d6(): d = d6()
    return a + b + c + d - min(min(a, b), min(c, d))
end sub

dim statnames$(6)
statnames$(1) = "STR"
statnames$(2) = "CON"
statnames$(3) = "DEX"
statnames$(4) = "INT"
statnames$(5) = "WIS"
statnames$(6) = "CHA"

dim stat(6)
acceptable = false

repeat
    sum = 0
    n15 = 0
    for i = 1 to 6
        stat(i) = roll_stat()
        sum = sum + stat(i)
        if stat(i) >= 15 then n15 = n15 + 1 : fi
    next i
    if sum >= 75 and n15 >= 2 then acceptable = true : fi
until acceptable

for i = 1 to 6
    print statnames$(i), ": ", stat(i) using "##"
next i
print "-------\nTOT: ", sum
end


reg attrs=List(), S,N;
do{
   attrs.clear();
   do(6){
      abcd:=(4).pump(List,(0).random.fp(1,7));   // list of 4 [1..6] randoms
      attrs.append(abcd.sum(0) - (0).min(abcd)); // sum and substract min
   }
}while((S=attrs.sum(0))<75 or (N=attrs.filter('>=(15)).len())<2);
println("Random numbers: %s\nSums to %d, with %d >= 15"
        .fmt(attrs.concat(","),S,N));


package main

import "fmt"

// encoding scheme:
// encode to byte array
// byte value < 26 means single character: byte value + 'A'
// byte value 26..255 means (byte value - 24) copies of next byte
func rllEncode(s string) (r []byte) {
    if s == "" {
        return
    }
    c := s[0]
    if c < 'A' || c > 'Z' {
        panic("invalid")
    }
    nc := byte(1)
    for i := 1; i < len(s); i++ {
        d := s[i]
        switch {
        case d != c:
        case nc < (255 - 24):
            nc++
            continue
        }
        if nc > 1 {
            r = append(r, nc+24)
        }
        r = append(r, c-'A')
        if d < 'A' || d > 'Z' {
            panic("invalid")
        }
        c = d
        nc = 1
    }
    if nc > 1 {
        r = append(r, nc+24)
    }
    r = append(r, c-'A')
    return
}

func main() {
    s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
    fmt.Println("source: ", len(s), "bytes:", s)
    e := rllEncode(s)
    fmt.Println("encoded:", len(e), "bytes:", e)
    d := rllDecode(e)
    fmt.Println("decoded:", len(d), "bytes:", d)
    fmt.Println("decoded = source:", d == s)
}

func rllDecode(e []byte) string {
    var c byte
    var d []byte
    for i := 0; i < len(e); i++ {
        b := e[i]
        if b < 26 {
            c = 1
        } else {
            c = b - 24
            i++
            b = e[i]
        }
        for c > 0 {
            d = append(d, b+'A')
            c--
        }
    }
    return string(d)
}


def rleEncode(text) {
    def encoded = new StringBuilder()
    (text =~ /(([A-Z])\2*)/).each { matcher ->
        encoded.append(matcher[1].size()).append(matcher[2])
    }
    encoded.toString()
}

def rleDecode(text) {
    def decoded = new StringBuilder()
    (text =~ /([0-9]+)([A-Z])/).each { matcher ->
        decoded.append(matcher[2] * Integer.parseInt(matcher[1]))
    }
    decoded.toString()
}


import Data.List (group)

-- Datatypes
type Encoded = [(Int, Char)] -- An encoded String with form [(times, char), ...]

type Decoded = String

-- Takes a decoded string and returns an encoded list of tuples
rlencode :: Decoded -> Encoded
rlencode = fmap ((,) <$> length <*> head) . group

-- Takes an encoded list of tuples and returns the associated decoded String
rldecode :: Encoded -> Decoded
rldecode = concatMap (uncurry replicate)

main :: IO ()
main = do
  let input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
      -- Output encoded and decoded versions of input
      encoded = rlencode input
      decoded = rldecode encoded
  putStrLn $ "Encoded: " <> show encoded <> "\nDecoded: " <> show decoded


procedure main(arglist)

   s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"

   write(" s=",image(s))
   write("s1=",image(s1 := rle_encode(s)))
   write("s2=",image(s2 := rle_decode(s1)))

   if s ~== s2 then write("Encode/Decode problem.")
               else write("Encode/Decode worked.")
end

procedure rle_encode(s)
   es := ""
   s ? while c := move(1) do es ||:= *(move(-1),tab(many(c))) || c
   return es
end

procedure rle_decode(es)
   s := ""
   es ? while s ||:= Repl(tab(many(&digits)),move(1))
   return s
end

procedure Repl(n, c)
    return repl(c,n)
end


import java.util.regex.Matcher;
import java.util.regex.Pattern;
public class RunLengthEncoding {

    public static String encode(String source) {
        StringBuffer dest = new StringBuffer();
        for (int i = 0; i < source.length(); i++) {
            int runLength = 1;
            while (i+1 < source.length() && source.charAt(i) == source.charAt(i+1)) {
                runLength++;
                i++;
            }
            dest.append(runLength);
            dest.append(source.charAt(i));
        }
        return dest.toString();
    }

    public static String decode(String source) {
        StringBuffer dest = new StringBuffer();
        Pattern pattern = Pattern.compile("[0-9]+|[a-zA-Z]");
        Matcher matcher = pattern.matcher(source);
        while (matcher.find()) {
            int number = Integer.parseInt(matcher.group());
            matcher.find();
            while (number-- != 0) {
                dest.append(matcher.group());
            }
        }
        return dest.toString();
    }

    public static void main(String[] args) {
        String example = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
        System.out.println(encode(example));
        System.out.println(decode("1W1B1W1B1W1B1W1B1W1B1W1B1W1B"));
    }
}


function encode(input) {
    var encoding = [];
    var prev, count, i;
    for (count = 1, prev = input[0], i = 1; i < input.length; i++) {
        if (input[i] != prev) {
            encoding.push([count, prev]);
            count = 1;
            prev = input[i];
        }
        else
            count ++;
    }
    encoding.push([count, prev]);
    return encoding;
}


def runs:
  reduce .[] as $item
    ( [];
      if . == [] then [ [ $item, 1] ]
      else .[length-1] as $last
      | if $last[0] == $item then .[length-1] = [$item, $last[1] + 1]
        else . + [[$item, 1]]
        end
      end ) ;


using IterTools

encode(str::String) = collect((length(g), first(g)) for g in groupby(first, str))
decode(cod::Vector) = join(repeat("$l", n) for (n, l) in cod)

for original in ["aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa", "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"]
    encoded = encode(original)
    decoded = decode(encoded)
    println("Original: $original\n -> encoded: $encoded\n -> decoded: $decoded")
end


tailrec fun runLengthEncoding(text:String,prev:String=""):String {
    if (text.isEmpty()){
        return prev
    }
    val initialChar = text.get(0)
    val count = text.takeWhile{ it==initialChar }.count()
    return runLengthEncoding(text.substring(count),prev + "$count$initialChar" )
}

fun main(args: Array<String>) {
    assert(runLengthEncoding("TTESSST") == "2T1E3S1T")
    assert(runLengthEncoding("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
                   == "12W1B12W3B24W1B14W")
}


define rle(str::string)::string => {
	local(orig = #str->values->asCopy,newi=array, newc=array, compiled=string)
	while(#orig->size) => {
		if(not #newi->size) => {
			#newi->insert(1)
			#newc->insert(#orig->first)
			#orig->remove(1)
		else
			if(#orig->first == #newc->last) => {
				#newi->get(#newi->size) += 1
			else
				#newi->insert(1)
				#newc->insert(#orig->first)
			}
			#orig->remove(1)
		}
	}
	loop(#newi->size) => {
		#compiled->append(#newi->get(loop_count)+#newc->get(loop_count))
	}
	return #compiled
}
define rlde(str::string)::string => {
	local(o = string)
	while(#str->size) => {
		loop(#str->size) => {
			if(#str->isualphabetic(loop_count)) => {
				if(loop_count == 1) => {
					#o->append(#str->get(loop_count))
					#str->removeLeading(#str->get(loop_count))
					loop_abort
				}
				local(num = integer(#str->substring(1,loop_count)))
				#o->append(#str->get(loop_count)*#num)
				#str->removeLeading(#num+#str->get(loop_count))
				loop_abort
			}
		}
	}
	return #o
}
//Tests:
rle('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW')
rle('dsfkjhhkdsjfhdskhshdjjfhhdlsllw')

rlde('12W1B12W3B24W1B14W')
rlde('1d1s1f1k1j2h1k1d1s1j1f1h1d1s1k1h1s1h1d2j1f2h1d1l1s2l1w')


mainwin 100 20

    'In$ ="aaaaaaaaaaaaaaaaaccbbbbbbbbbbbbbbba" ' testing...
    In$ ="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
    '   Out$= "12W1B12W3B24W1B14W"

    Out$ =Encoded$( In$)
    Inv$ =Decoded$( Out$)

    print " Supplied string ="; In$
    Print " RLE version     ="; Out$
    print " Decoded back to ="; Inv$

    end

    function Encoded$( k$)
        r$    =""
        r     =1
        for i =2 to len( k$)
            prev$   =mid$( k$, i -1, 1)
            c$      =mid$( k$, i,    1)
            if c$ =prev$ then   '   entering a run of this character
                r =r +1
            else                '   it occurred only once
                r$ =r$ +str$( r) +prev$
                r =1
            end if
        next i
        r$ =r$ +str$( r) +c$
        Encoded$ =r$
    end function

    function Decoded$( k$)
        r$ =""
        v  =0
        for i =1 to len( k$)
            i$ =mid$( k$, i, 1)
            if instr( "0123456789", i$) then
                v =v *10 +val( i$)
            else
                for m =1 to v
                    r$ =r$ +i$
                next m
                v =0
            end if
        next i
        Decoded$ =r$
    end function


function rlEncode str
    local charCount
    put 1 into charCount
    repeat with i = 1 to the length of str
        if char i of str = char (i + 1) of str then
            add 1 to charCount
        else
            put char i of str & charCount after rle
            put 1 into charCount
        end if
    end repeat
    return rle
end rlEncode

function rlDecode str
    repeat with i = 1 to the length of str
        if char i of str is not a number then
            put char i of str into curChar
            put 0 into curNum
        else
            repeat with n = i to len(str)
                if isnumber(char n of str) then
                    put char n of str after curNum
                else
                    put repeatString(curChar,curNum) after rldec
                    put n - 1 into i
                    exit repeat
                end if
            end repeat
        end if
        if i = len(str) then --dump last char
            put repeatString(curChar,curNum) after rldec
        end if
    end repeat
    return rldec
end rlDecode

function repeatString str,rep
    repeat rep times
        put str after repStr
    end repeat
    return repStr
end repeatString


to encode :str [:out "||] [:count 0] [:last first :str]
  if empty? :str [output (word :out :count :last)]
  if equal? first :str :last [output (encode bf :str :out :count+1 :last)]
  output (encode bf :str (word :out :count :last) 1 first :str)
end

to reps :n :w
  output ifelse :n = 0 ["||] [word :w reps :n-1 :w]
end
to decode :str [:out "||] [:count 0]
  if empty? :str [output :out]
  if number? first :str [output (decode bf :str :out 10*:count + first :str)]
  output (decode bf :str word :out reps :count first :str)
end

make "foo "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
make "rle encode :foo
show equal? :foo decode :rle


local C, Ct, R, Cf, Cc = lpeg.C, lpeg.Ct, lpeg.R, lpeg.Cf, lpeg.Cc
astable = Ct(C(1)^0)

function compress(t)
    local ret = {}
    for i, v in ipairs(t) do
      if t[i-1] and v == t[i-1] then
        ret[#ret - 1] = ret[#ret - 1] + 1
      else
        ret[#ret + 1] = 1
        ret[#ret + 1] = v
      end
    end
    t = ret
    return table.concat(ret)
end
q = io.read()
print(compress(astable:match(q)))

undo = Ct((Cf(Cc"0" * C(R"09")^1, function(a, b) return 10 * a + b end) * C(R"AZ"))^0)

function decompress(s)
  t = undo:match(s)
  local ret = ""
  for i = 1, #t - 1, 2 do
    for _ = 1, t[i] do
      ret = ret .. t[i+1]
    end
  end
  return ret
end


Module RLE_example {
	inp$="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
	Print "Input: ";inp$
	Function RLE$(r$){
		Function rle_run$(&r$) {
			if len(r$)=0 then exit
			p=1
			c$=left$(r$,1)
			while c$=mid$(r$, p, 1) {p++}
			=format$("{0}{1}",p-1, c$)
			r$=mid$(r$, p)
		}
		def repl$
		while len(r$)>0 {repl$+=rle_run$(&r$)}
		=repl$
	}
	RLE_encode$=RLE$(inp$)
	Print "RLE Encoded: ";RLE_encode$
	Function RLE_decode$(r$) {
		def repl$
		def long m, many=1
		while r$<>"" and many>0 {
			many=val(r$, "INT", &m)
			repl$+=string$(mid$(r$, m, 1), many)
			r$=mid$(r$,m+1)
		}
		=repl$
	}
	RLE_decode$=RLE_decode$(RLE_encode$)
	Print "RLE Decoded: ";RLE_decode$
	Print "Checked: ";RLE_decode$=inp$
}
RLE_example


RunLengthEncode[input_String]:= (l |-> {[email protected], [email protected]}) /@ ([email protected]@input)


rle(a) := block(
   [n: slength(a), b: "", c: charat(a, 1), k: 1],
   for i from 2 thru n do
      if cequal(c, charat(a, i)) then k: k + 1 else (b: sconcat(b, k, c), c: charat(a, i), k: 1),
   sconcat(b, k, c)
)$

rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW");
"12W1B12W3B24W1B14W"


	LOC	Data_Segment
	GREG	@
Buf	OCTA	0,0,0,0         integer print buffer
Char	BYTE	0,0             single char print buffer
task	BYTE	"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWW"
	BYTE    "WWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",0
len	GREG	@-1-task

// task should become this
tEnc	BYTE	"12W1B12W3B24W1B14W",0

	GREG	@
// tuple array for encoding purposes
// each tuple is a tetra (4 bytes long or 2 wydes long)
// (c,l) in which c is a char and l = number of chars c
// high wyde of the tetra contains the char
// low wyde  .. ..  ..    contains the length
RLE	TETRA	0

	LOC	#100            locate program
	GREG	@
// print number to stdout
// destroys input arg $3 !
Prt64	LDA	$255,Buf+23    points to LSD
//			       do
2H	DIV	$3,$3,10        (N,R) = divmod (N,10)
	GET	$13,rR          get remainder
	INCL	$13,'0'         convert to ascii
	STBU	$13,$255        store ascii digit
	BZ	$3,3F
	SUB	$255,$255,1     move pointer down
	JMP	2B             While N !=0
3H	TRAP	0,Fputs,StdOut print number to standard out
	GO	$127,$127,0    return

	GREG	@
// print char to stdout
PChar	LDA	$255,Char
	STBU	$4,$255
	TRAP	0,Fputs,StdOut
	GO	$127,$127,0

	GREG	@
// encode routine
// $0 string pointer
// $1 index var
// $2 pointer to tuple array
// $11 temp var tuple
Encode	SET	$1,0        initialize index = 0
	SET	$11,0       postion in string = 0
	LDBU	$3,$0,$1    get first char
	ADDU	$6,$3,0     remember it
                            do
1H	INCL	$1,1          repeat  incr index
	LDBU	$3,$0,$1              get a char
	BZ	$3,2F                 if EOS then finish
	CMP	$7,$3,$6
	PBZ	$7,1B         while new == old
	XOR	$4,$4,$4      new tuple
	ADDU	$4,$6,0
	SLU	$4,$4,16      old char to tuple -> (c,_)
	SUB	$7,$1,$11     length = index - previous position
	ADDU	$11,$1,0      incr position
	OR	$4,$4,$7      length l to tuple -> (c,l)
	STT	$4,$2         put tuple in array
	ADDU	$6,$3,0       remember new char
	INCL	$2,4          incr 'tetra' pointer
	JMP	1B          loop
2H	XOR	$4,$4,$4    put last tuple in array
	ADDU	$4,$6,0
	SLU	$4,$4,16
	SUB	$7,$1,$11
	ADDU	$11,$1,0
	OR	$4,$4,$7
	STT	$4,$2
	GO	$127,$127,0 return

	GREG	@
Main	LDA	$0,task      pointer uncompressed string
	LDA	$2,RLE	     pointer tuple array
	GO	$127,Encode  encode string
	LDA	$2,RLE	     points to start tuples
	SET	$5,#ffff     mask for extracting length
1H	LDTU	$3,$2        while not End of Array
	BZ	$3,2F
	SRU	$4,$3,16      char   = (c,_)
	AND	$3,$3,$5      length = (_,l)
	GO	$127,Prt64    print length
	GO	$127,PChar    print char
	INCL	$2,4          incr tuple pointer
	JMP	1B           wend
2H	SET	$4,#a        print NL
	GO	$127,PChar

// decode using the RLE tuples
	LDA	$2,RLE	     pointer tuple array
	SET	$5,#ffff     mask
1H	LDTU	$3,$2        while not End of Array
	BZ	$3,2F
	SRU	$4,$3,16      char   = (c,_)
	AND	$3,$3,$5      length = (_,l)
//                            for (i=0;i<length;i++) {
3H	GO	$127,PChar      print a char
	SUB	$3,$3,1
	PBNZ	$3,3B
	INCL	$2,4
	JMP	1B            }
2H	SET	$4,#a        print NL
	GO	$127,PChar
	TRAP	0,Halt,0     EXIT


import parseutils, strutils

proc compress(input: string): string =
  var
    count = 1
    prev = '\0'

  for ch in input:
    if ch != prev:
      if prev != '\0':
        result.add $count & prev
      count = 1
      prev = ch
    else:
      inc count
  result.add $count & prev

proc uncompress(text: string): string =
  var start = 0
  var count: int
  while true:
    let n = text.parseInt(count, start)
    if n == 0 or start + n >= text.len:
      raise newException(ValueError, "corrupted data.")
    inc start, n
    result.add repeat(text[start], count)
    inc start
    if start == text.len: break

const Text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"

echo "Text:         ", Text
let compressed = Text.compress()
echo "Compressed:   ", compressed
echo "Uncompressed: ", compressed.uncompress()


use RegEx;

class RunLengthEncoding {
  function : Main(args : String[]) ~ Nil {
    input := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";

    encoded := Encode(input);
    "encoding: {$encoded}"->PrintLine();
    test := encoded->Equals("12W1B12W3B24W1B14W");
    "encoding match: {$test}"->PrintLine();

    decoded := Decode(encoded);
    test := input->Equals(decoded);
    "decoding match: {$test}"->PrintLine();
  }

  function : Encode(source : String) ~ String {
    dest := "";
    each(i : source) {
      runLength := 1;
      while(i+1 < source->Size() & source->Get(i) = source->Get(i+1)) {
        runLength+= 1;
        i+= 1;
      };
      dest->Append(runLength);
      dest->Append(source->Get(i));
    };

    return dest;
  }

  function : Decode(source : String) ~ String {
    output := "";
    regex := RegEx->New("[0-9]+|([A-Z]|[a-z])");
    found := regex->Find(source);
    count : Int;
    each(i : found) {
      if(i % 2 = 0) {
        count := found->Get(i)->As(String)->ToInt();
      }
      else {
        letter := found->Get(i)->As(String);
        while(count <> 0) {
          output->Append(letter);
          count -= 1;
        };
      };
    };

    return output;
  }
}


let encode str =
  let len = String.length str in
  let rec aux i acc =
    if i >= len then List.rev acc
    else
      let c1 = str.[i] in
      let rec aux2 j =
        if j >= len then (c1, j-i)
        else
          let c2 = str.[j] in
          if c1 = c2
          then aux2 (j+1)
          else (c1, j-i)
      in
      let (c,n) as t = aux2 (i+1) in
      aux (i+n) (t::acc)
  in
  aux 0 []
;;

let decode lst =
  let l = List.map (fun (c,n) -> String.make n c) lst in
  (String.concat "" l)


: encode(s)
   StringBuffer new
   s group apply(#[ tuck size asString << swap first <<c ]) ;

: decode(s)
| c i |
   StringBuffer new
   0 s forEach: c [
      c isDigit ifTrue: [ 10 * c asDigit + continue ]
      loop: i [ c <<c ] 0
      ]
   drop ;


(define (RLE str)
   (define iter (string->list str))
   (let loop ((iter iter) (chr (car iter)) (n 0) (rle '()))
      (cond
         ((null? iter)
            (reverse (cons (cons n chr) rle)))
         ((char=? chr (car iter))
            (loop (cdr iter) chr (+ n 1) rle))
         (else
            (loop (cdr iter) (car iter) 1 (cons (cons n chr) rle))))))

(define (decode rle)
   (apply string-append (map (lambda (p)
      (make-string (car p) (cdr p))) rle)))


declare
  fun {RLEncode Xs}
     for G in {Group Xs} collect:C do
	{C {Length G}#G.1}
     end
  end

  fun {RLDecode Xs}
     for C#Y in Xs append:Ap do
	{Ap {Replicate Y C}}
     end
  end

  %% Helpers
  %% e.g. "1122" -> ["11" "22"]
  fun {Group Xs}
     case Xs of nil then nil
     [] X|Xr then
	Ys Zs
        {List.takeDropWhile Xr fun {$ W} W==X end ?Ys ?Zs}
     in
        (X|Ys) | {Group Zs}
     end
  end
  %% e.g. 3,4 -> [3 3 3 3]
  fun {Replicate X N}
     case N of 0 then nil
     else X|{Replicate X N-1}
     end
  end

  Data = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
  Enc = {RLEncode Data}
in
  {System.showInfo Data}
  {Show Enc}
  {System.showInfo {RLDecode Enc}}


rle(s)={
  if(s=="", return(s));
  my(v=Vec(s),cur=v[1],ct=1,out="");
  v=concat(v,99); \\ sentinel
  for(i=2,#v,
    if(v[i]==cur,
      ct++
    ,
      out=Str(out,ct,cur);
      cur=v[i];
      ct=1
    )
  );
  out
};
elr(s)={
  if(s=="", return(s));
  my(v=Vec(s),ct=eval(v[1]),out="");
  v=concat(v,99); \\ sentinel
  for(i=2,#v,
    if(v[i]>="0" && v[i]<="9",
      ct=10*ct+eval(v[i])
    ,
      for(j=1,ct,out=Str(out,v[i]));
      ct=0
    )
  );
  out
};
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
elr(%)


Program RunLengthEncoding(output);

procedure encode(s: string; var counts: array of integer; var letters: string);
  var
    i, j: integer;
  begin
    j := 0;
    letters := '';
    if length(s) > 0 then
    begin
      j := 1;
      letters := letters + s[1];
      counts[1] := 1;
      for i := 2 to length(s) do
        if s[i] = letters[j] then
          inc(counts[j])
        else
        begin
          inc(j);
          letters := letters + s[i];
          counts[j] := 1;
        end;
    end;
  end;

procedure decode(var s: string; counts: array of integer; letters: string);
  var
    i, j: integer;
  begin
    s := '';
    for i := 1 to length(letters) do
      for j := 1 to counts[i] do
        s := s + letters[i];
  end;

var
  s: string;
  counts: array of integer;
  letters: string;
  i: integer;
begin
  s := 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWW';
  writeln(s);
  setlength(counts, length(s));
  encode(s, counts, letters);
  for i := 1 to length(letters) - 1 do
    write(counts[i], ' * ', letters[i], ', ');
  writeln(counts[length(letters)], ' * ', letters[length(letters)]);
  decode(s, counts, letters);
  writeln(s);
end.


sub encode {
    shift =~ s/(.)\1*/length($&).$1/grse;
}

sub decode {
    shift =~ s/(\d+)(.)/$2 x $1/grse;
}


with javascript_semantics
function encode(string s)
    sequence r = {}
    if length(s) then
        integer ch = s[1],
                count = 1
        for i=2 to length(s) do
            if s[i]!=ch then
                r &= {count,ch}
                ch = s[i]
                count = 1
            else
                count += 1
            end if
        end for
        r &= {count,ch}
    end if
    return r
end function

function decode(sequence s)
    string r = ""
    for i=1 to length(s) by 2 do
        r &= repeat(s[i+1],s[i])
    end for
    return r
end function

sequence s = encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
?s
?decode(s)


<?php
function encode($str)
{
    return preg_replace_callback('/(.)\1*/', function ($match) {
        return strlen($match[0]) . $match[1];
    }, $str);
}

function decode($str)
{
    return preg_replace_callback('/(\d+)(\D)/', function($match) {
        return str_repeat($match[2], $match[1]);
    }, $str);
}

echo encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'), PHP_EOL;
echo decode('12W1B12W3B24W1B14W'), PHP_EOL;
?>


rle(S) = RLE =>
  RLE = "",
  Char = S[1],
  I = 2,
  Count = 1,
  while (I <= S.len)
    if Char == S[I] then
      Count := Count + 1
    else
      RLE := RLE ++ Count.to_string() ++ Char.to_string(),
      Count := 1,
      Char := S[I]
    end,
    I := I + 1
  end,
  RLE := RLE ++ Count.to_string() ++ Char.to_string().


(de encode (Str)
   (pack
      (make
         (for (Lst (chop Str) Lst)
            (let (N 1  C)
               (while (= (setq C (pop 'Lst)) (car Lst))
                  (inc 'N) )
               (link N C) ) ) ) ) )

(de decode (Str)
   (pack
      (make
         (let N 0
            (for C (chop Str)
               (if (>= "9" C "0")
                  (setq N (+ (format C) (* 10 N)))
                  (do N (link C))
                  (zero N) ) ) ) ) ) )

(and
   (prinl "Data:    " "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
   (prinl "Encoded: " (encode @))
   (prinl "Decoded: " (decode @)) )


declare (c1, c2) character (1);
declare run_length fixed binary;
declare input file;

open file (input) title ('/RLE.DAT,type(text),recsize(20000)');
on endfile (input) go to epilog;

get file (input) edit (c1) (a(1));
run_length = 1;
do forever;
   get file (input) edit (c2) (a(1));
   if c1 = c2 then
      run_length = run_length + 1;
   else
      do; put edit (trim(run_length), c1) (a); run_length=1; end;
   c1 = c2;
end;
epilog:
   put edit (trim(run_length), c1) (a);
   put skip;

/* The reverse of the above operation: */
declare c character (1);
declare i fixed binary;
declare new file;

open file (new) title ('/NEW.DAT,type(text),recsize(20000)');
on endfile (new) stop;
do forever;
   run_length = 0;
   do forever;
      get file (new) edit (c) (a(1));
      if index('0123456789', c) = 0 then leave;
      run_length = run_length*10 + c;
   end;
   put edit ((c do i = 1 to run_length)) (a);
end;


FUNCTION RLDecode (i AS STRING) AS STRING
    DIM Loop0 AS LONG, rCount AS STRING, outP AS STRING, m AS STRING

    FOR Loop0 = 1 TO LEN(i)
        m = MID$(i, Loop0, 1)
        SELECT CASE m
            CASE "0" TO "9"
                rCount = rCount & m
            CASE ELSE
                IF LEN(rCount) THEN
                    outP = outP & STRING$(VAL(rCount), m)
                    rCount=""
                ELSE
                    outP = outP & m
                END IF
        END SELECT
    NEXT
    FUNCTION = outP
END FUNCTION

FUNCTION RLEncode (i AS STRING) AS STRING
    DIM tmp1 AS STRING, tmp2 AS STRING, outP AS STRING
    DIM Loop0 AS LONG, rCount AS LONG

    tmp1 = MID$(i, 1, 1)
    tmp2 = tmp1
    rCount = 1

    FOR Loop0 = 2 TO LEN(i)
        tmp1 = MID$(i, Loop0, 1)
        IF tmp1 <> tmp2 THEN
            outP = outP & TRIM$(STR$(rCount)) & tmp2
            tmp2 = tmp1
            rCount = 1
        ELSE
            INCR rCount
        END IF
    NEXT

    outP = outP & TRIM$(STR$(rCount))
    outP = outP & tmp2
    FUNCTION = outP
END FUNCTION

FUNCTION PBMAIN () AS LONG
    DIM initial AS STRING, encoded AS STRING, decoded AS STRING
    initial = INPUTBOX$("Type something.")
    encoded = RLEncode(initial)
    decoded = RLDecode(encoded)
    'in PB/Win, "?" = MSGBOX; in PB/DOS & PB/CC. "?" = PRINT
    ? initial & $CRLF & encoded & $CRLF & decoded
END FUNCTION


function Compress-RLE ($s) {
    $re = [regex] '(.)\1*'
    $ret = ""
    foreach ($m in $re.Matches($s)) {
        $ret += $m.Length
        $ret += $m.Value[0]
    }
    return $ret
}

function Expand-RLE ($s) {
    $re = [regex] '(\d+)(.)'
    $ret = ""
    foreach ($m in $re.Matches($s)) {
        $ret += [string] $m.Groups[2] * [int] [string] $m.Groups[1]
    }
    return $ret
}


% the test
run_length :-
	L = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
	writef('encode %s\n', [L]),
	encode(L, R),
	writeln(R), nl,
	writef('decode %w\n', [R]),
	decode(R, L1),
	writeln(L1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  encode
%
%  translation
%  from
%  "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
%  to
%  "12W1B12W3B24W1B14W"
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
encode(In, Out) :-
	% Because of the special management of the "strings" by Prolog
	( is_list(In) -> I = In; string_to_list(In, I)),
	packList(I, R1),
	dcg_packList2List(R1,R2, []),
	string_to_list(Out,R2).

dcg_packList2List([[N, V]|T]) -->
	{ number_codes(N, LN)},
	LN,
	[V],
	dcg_packList2List(T).

dcg_packList2List([]) --> [].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  decode
%
%  translation
%  from
%  "12W1B12W3B24W1B14W"
%  to
%  "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
decode(In, Out) :-
	% Because of the special management of the "strings" by Prolog
	( is_list(In) -> I = In; string_to_list(In, I)),
	dcg_List2packList(I, R1, []),
	packList(L1, R1),
	string_to_list(Out, L1).

dcg_List2packList([H|T]) -->
	{code_type(H, digit)},
	parse_number([H|T], 0).

dcg_List2packList([]) --> [].

parse_number([H|T], N) -->
	{code_type(H, digit), !,
	N1 is N*10 + H - 48 },
	parse_number(T, N1).

parse_number([H|T], N) -->
	[[N, H]],
	dcg_List2packList(T).

% use of library clpfd allows packList(?In, ?Out) to works
% in both ways In --> Out and In <-- Out.

:- use_module(library(clpfd)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% ?- packList([a,a,a,b,c,c,c,d,d,e], L).
%  L = [[3,a],[1,b],[3,c],[2,d],[1,e]] .
% ?- packList(R,  [[3,a],[1,b],[3,c],[2,d],[1,e]]).
% R = [a,a,a,b,c,c,c,d,d,e] .
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
packList([],[]).

packList([X],[[1,X]]) :- !.

packList([X|Rest],[XRun|Packed]):-
    run(X,Rest, XRun,RRest),
    packList(RRest,Packed).

run(Var,[],[1,Var],[]).

run(Var,[Var|LRest],[N1, Var],RRest):-
    N #> 0,
    N1 #= N + 1,
    run(Var,LRest,[N, Var],RRest).

run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
    dif(Var,Other).


using system;

encode s = strcat $ map (sprintf "%d%s") $ encode $ chars s with
  encode [] = [];
  encode [email protected](x:_) = (#takewhile (==x) xs,x) : encode (dropwhile (==x) xs);
end;

decode s = strcat [c | n,c = parse s; i = 1..n] with
  parse s::string = regexg item "([0-9]+)(.)" REG_EXTENDED s 0;
  item info = val (reg 1 info!1), reg 2 info!1;
end;

let s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
let r = encode s; // "12W1B12W3B24W1B14W"
decode r;


Procedure.s RLDecode(toDecode.s)
  Protected.s repCount, output, currChar, tmp
  Protected *c.Character = @toDecode

  While *c\c <> #Null
    currChar = Chr(*c\c)
    Select *c\c
      Case '0' To '9'
        repCount + currChar
      Default
        If repCount
          tmp = Space(Val(repCount))
          ReplaceString(tmp, " ", currChar, #PB_String_InPlace)
          output + tmp
          repCount = ""
        Else
          output + currChar
        EndIf
    EndSelect
    *c + SizeOf(Character)
  Wend

  ProcedureReturn output
EndProcedure

Procedure.s RLEncode(toEncode.s)
  Protected.s currChar, prevChar, output
  Protected repCount
  Protected *c.Character = @toEncode

  prevChar = Chr(*c\c)
  repCount = 1

  *c + SizeOf(Character)
  While *c\c <> #Null
    currChar = Chr(*c\c)
    If currChar <> prevChar
      output + Str(repCount) + prevChar
      prevChar = currChar
      repCount = 1
    Else
      repCount + 1
    EndIf
    *c + SizeOf(Character)
  Wend

  output + Str(repCount)
  output + prevChar
  ProcedureReturn output
EndProcedure

If OpenConsole()
  Define initial.s, encoded.s, decoded.s

  Print("Type something: ")
  initial = Input()
  encoded = RLEncode(initial)
  decoded = RLDecode(encoded)
  PrintN(initial)
  PrintN(RLEncode(initial))
  PrintN(RLDecode(encoded))

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


def encode(input_string):
    count = 1
    prev = None
    lst = []
    for character in input_string:
        if character != prev:
            if prev:
                entry = (prev, count)
                lst.append(entry)
            count = 1
            prev = character
        else:
            count += 1
    else:
        try:
            entry = (character, count)
            lst.append(entry)
            return (lst, 0)
        except Exception as e:
            print("Exception encountered {e}".format(e=e))
            return (e, 1)

def decode(lst):
    q = []
    for character, count in lst:
        q.append(character * count)
    return ''.join(q)

#Method call
value = encode("aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa")
if value[1] == 0:
    print("Encoded value is {}".format(value[0]))
    decode(value[0])


  [ lookandsay ]          is encode ( $ --> $ )

  [ $ "" 0 rot
    witheach
      [ dup
        char 0 char 9 1+
        within iff
          [ char 0 -
            swap 10 * + ]
        else
          [ swap of join
            0 ] ]
    drop ]                is decode ( $ --> $ )

  $ "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
   dup echo$ cr
   encode
   dup echo$ cr
   decode
   echo$ cr


runlengthencoding <- function(x)
{
   splitx <- unlist(strsplit(input, ""))
   rlex <- rle(splitx)
   paste(with(rlex, as.vector(rbind(lengths, values))), collapse="")
}

input <- "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
runlengthencoding(input)


#lang racket
(define (encode str)
  (regexp-replace* #px"(.)\\1*" str (λ (m c) (~a (string-length m) c))))
(define (decode str)
  (regexp-replace* #px"([0-9]+)(.)" str (λ (m n c) (make-string (string->number n) (string-ref c 0)))))


sub encode($str) { $str.subst(/(.) $0*/, { $/.chars ~ $0 }, :g) }

sub decode($str) { $str.subst(/(\d+) (.)/, { $1 x $0 }, :g) }

my $e = encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW');
say $e;
say decode($e);


/*REXX program  encodes and displays a string  by using a  run─length  encoding scheme. */
parse arg input .                                /*normally, input would be in a file.  */
default= 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
if input=='' | input==","  then input=   default /*Not specified?  Then use the default.*/
encode= RLE(input) ;     say '  input='  input   /*encode input string;  display input. */
                         say 'encoded='  encode  /*                      display run─len*/
decode= RLD(encode);     say 'decoded='  decode  /*decode the run─len;   display decode.*/
if decode==input  then say 'OK'; else say "¬ OK" /*display yay or nay (success/failure).*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
err: say;    say "***error***  input data isn't alphabetic:"   c;       say;     exit 13
/*──────────────────────────────────────────────────────────────────────────────────────*/
RLE: procedure;  parse arg x;     $=             /*$:  is the output string  (so far).  */
                        Lx= length(x)            /*get length of the plain text string. */
       do j=1  by 0  to Lx;  c= substr(x, j, 1)  /*obtain a character from plain text.  */
       if \datatype(c, 'M')  then call err       /*Character not a letter?  Issue error.*/
       r= 0                                      /*R:  is NOT the number of characters. */
                     do k=j+1  to Lx  while substr(x, k, 1)==c   /*while characters ≡ C */
                     r= r + 1                    /*bump the replication count for a char*/
                     end   /*k*/
       j= j + r + 1                              /*increment (add to) the DO loop index.*/
       if r==0  then $= $ ||      c              /*don't use  R  if it is equal to zero.*/
                else $= $ || r || c              /*add character to the encoded string. */
       end   /*j*/;                   return $   /*return the encoded string to caller. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
RLD: procedure;  parse arg x;     $=             /*$:  is the output string  (so far).  */
                        Lx= length(x)            /*get the length of the encoded string.*/
       do j=1  by 0  to Lx;  c= substr(x, j, 1)  /*obtain a character from run encoding.*/
       if \datatype(c, 'W')  then do;   $= $ || c;     j= j + 1;     iterate /*j*/
                                  end            /* [↑]  a loner char, add it to output.*/
       #= 1                                      /*          [↓]  W:  use a Whole number*/
              do k=j+1  to Lx  while datatype(substr(x,k,1), 'w') /*while numeric*/
              #= # + 1                           /*bump the count of the numeric chars. */
              end   /*k*/
       n= substr(x, j, #) + 1                    /*#:  the length of encoded character. */
       $= $  ||  copies( substr(x, k, 1), n)     /*N:  is now the number of characters. */
       j= j + # + 1                              /*increment the DO loop index by D+1.  */
       end   /*j*/;                   return $   /*return the decoded string to caller. */


# Project : Run-length encoding

load "stdlib.ring"
test = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
num = 0
nr = 0
decode = newlist(7,2)
for n = 1 to len(test) - 1
     if test[n] = test[n+1]
        num = num + 1
     else
        nr = nr + 1
        decode[nr][1] = (num + 1)
        decode[nr][2] = test[n]
        see "" + (num + 1) + test[n]
        num = 0
     ok
next
see "" + (num + 1) + test[n]
see nl
nr = nr + 1
decode[nr][1] = (num + 1)
decode[nr][2] = test[n]
for n = 1 to len(decode)
     dec = copy(decode[n][2], decode[n][1])
     see dec
next


# run_encode("aaabbbbc") #=> [["a", 3], ["b", 4], ["c", 1]]
def run_encode(string)
  string
    .chars
    .chunk{|i| i}
    .map {|kind, array| [kind, array.length]}
end

# run_decode([["a", 3], ["b", 4], ["c", 1]]) #=> "aaabbbbc"
def run_decode(char_counts)
  char_counts
    .map{|char, count| char * count}
    .join
end


string$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
beg = 1
i   = 1
[loop]
s$ = mid$(string$,beg,1)
while mid$(string$,i,1) = s$
  i = i + 1
wend
press$ = press$ ; i-beg;s$
beg    = i
if i < len(string$) then goto [loop]
print "Compressed:";press$

beg = 1
i   = 1
[expand]
while mid$(press$,i,1) <= "9"
  i = i + 1
wend
for j = 1 to val(mid$(press$,beg, i - beg))
  expand$ = expand$ + mid$(press$,i,1)
next j
i   = i + 1
beg = i
if i < len(press$) then goto [expand]
print "  Expanded:";expand$


fn encode(s: &str) -> String {
    s.chars()
        // wrap all values in Option::Some
        .map(Some)
        // add an Option::None onto the iterator to clean the pipeline at the end
        .chain(std::iter::once(None))
        .scan((0usize, '\0'), |(n, c), elem| match elem {
            Some(elem) if *n == 0 || *c == elem => {
                // the run continues or starts here
                *n += 1;
                *c = elem;
                // this will not have an effect on the final string because it is empty
                Some(String::new())
            }
            Some(elem) => {
                // the run ends here
                let run = format!("{}{}", n, c);
                *n = 1;
                *c = elem;
                Some(run)
            }
            None => {
                // the string ends here
                Some(format!("{}{}", n, c))
            }
        })
        // concatenate together all subresults
        .collect()
}

fn decode(s: &str) -> String {
    s.chars()
        .fold((0usize, String::new()), |(n, text), c| {
            if c.is_ascii_digit() {
                // some simple number parsing
                (
                    n * 10 + c.to_digit(10).expect("invalid encoding") as usize,
                    text,
                )
            } else {
                // this must be the character that is repeated
                (0, text + &format!("{}", c.to_string().repeat(n)))
            }
        })
        .1
}

fn main() {
    let text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
    let encoded = encode(text);
    let decoded = decode(&encoded);

    println!("original: {}\n encoded: {}\n decoded: {}", text, encoded, decoded);
    assert_eq!(text, decoded);
}


def encode(s: String) = (1 until s.size).foldLeft((1, s(0), new StringBuilder)) {
  case ((len, c, sb), index) if c != s(index) => sb.append(len); sb.append(c); (1, s(index), sb)
  case ((len, c, sb), _) => (len + 1, c, sb)
} match {
  case (len, c, sb) => sb.append(len); sb.append(c); sb.toString
}

def decode(s: String) = {
  val sb = new StringBuilder
  val Code = """(\d+)([A-Z])""".r
  for (Code(len, c) <- Code findAllIn s) sb.append(c * len.toInt)
  sb.toString
}


(define (run-length-decode v)
   (apply string-append (map (lambda (p) (make-string (car p) (cdr p))) v)))

(define (run-length-encode s)
(let ((n (string-length s)))
(let loop ((i (- n 2)) (c (string-ref s (- n 1))) (k 1) (v '()))
(if (negative? i) (cons (cons k c) v)
    (let ((x (string-ref s i)))
    (if (char=? c x) (loop (- i 1) c (+ k 1) v)
                     (loop (- i 1) x 1 (cons (cons k c) v))))))))

(run-length-encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
; ((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W))
(run-length-decode '((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W)))
; "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"


$ include "seed7_05.s7i";
  include "scanstri.s7i";

const func string: letterRleEncode (in string: data) is func
  result
    var string: result is "";
  local
    var char: code is ' ';
    var integer: index is 1;
  begin
    if length(data) <> 0 then
      code := data[1];
      repeat
        incr(index);
      until index > length(data) or code <> data[index];
      result := str(pred(index)) & str(code) & letterRleEncode(data[index ..]);
    end if;
  end func;

const func string: letterRleDecode (in var string: data) is func
  result
    var string: result is "";
  local
    var integer: count is 0;
  begin
    if length(data) <> 0 then
      count := integer parse getDigits(data);
      result := data[1 len 1] mult count & letterRleDecode(data[2 ..]);
    end if;
  end func;

const proc: main is func
  begin
    writeln(letterRleEncode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"));
    writeln(letterRleDecode("12W1B12W3B24W1B14W"));
  end func;


|compress decompress|
compress := [:string |
   String streamContents:[:out |
       |count prev|

       count := 0.
       (string,'*')  "trick to avoid final run handling in loop"
          inject:nil
          into:[:prevChar :ch |
              ch ~= prevChar ifTrue:[
                  count = 0 ifFalse:[
                      count printOn:out.
                      out nextPut:prevChar.
                      count := 0.
                  ].
              ].
              count := count + 1.
              ch
          ]
   ]
].

decompress := [:string |
   String streamContents:[:out |
       string readingStreamDo:[:in |
           [in atEnd] whileFalse:[
               |n ch|
               n := Integer readFrom:in.
               ch := in next.
               out next:n put:ch.
            ]
       ]
   ].
].


*       # Encode RLE
        define('rle(str)c,n') :(rle_end)
rle     str len(1) . c :f(return)
        str span(c) @n =
        rle = rle n c :(rle)
rle_end

*       # Decode RLE
        define('elr(str)c,n') :(elr_end)
elr     str span('0123456789') . n len(1) . c = :f(return)
        elr = elr dupl(c,n) :(elr)
elr_end

*       # Test and display
        str = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
        output = str;
        str = rle(str); output = str
        str = elr(str); output = str
end


-- variable table
DROP TABLE IF EXISTS var;
CREATE temp TABLE var (	VALUE VARCHAR(1000) );
INSERT INTO var(VALUE) SELECT 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW';

-- select
WITH recursive
ints(num) AS
(
	SELECT 1
	UNION ALL
	SELECT num+1
	FROM ints
	WHERE num+1 <= LENGTH((SELECT VALUE FROM var))
)
,
chars(num,chr,nextChr,isGroupEnd) AS
(
	SELECT tmp.*, CASE WHEN tmp.nextChr <> tmp.chr THEN 1 ELSE 0 END groupEnds
	FROM (
	SELECT num,
		   SUBSTRING((SELECT VALUE FROM var), num, 1) chr,
		   (SELECT SUBSTRING((SELECT VALUE FROM var), num+1, 1)) nextChr
	FROM ints
	) tmp
)
SELECT (SELECT VALUE FROM var) plain_text, (
	SELECT string_agg(concat(CAST(maxNoWithinGroup AS VARCHAR(10)) , chr), '' ORDER BY num)
	FROM (
		SELECT *, MAX(noWithinGroup) OVER (partition BY chr, groupNo) maxNoWithinGroup
		FROM (
			SELECT	num,
					chr,
					groupNo,
					ROW_NUMBER() OVER( partition BY chr, groupNo ORDER BY num) noWithinGroup
			FROM (
			SELECT *, (SELECT COUNT(*)
					   FROM chars chars2
					   WHERE chars2.isGroupEnd = 1 AND
					   chars2.chr = chars.chr AND
					   chars2.num < chars.num) groupNo
			FROM chars
			) tmp
		) sub
	) final
	WHERE noWithinGroup = 1
	) Rle_Compressed


fun encode str =
  let
    fun aux (sub, acc) =
      case Substring.getc sub
       of NONE           => rev acc
        | SOME (x, sub') =>
            let
              val (y, z) = Substring.splitl (fn c => c = x) sub'
            in
              aux (z, (x, Substring.size y + 1) :: acc)
            end
  in
    aux (Substring.full str, [])
  end

fun decode lst =
  concat (map (fn (c,n) => implode (List.tabulate (n, fn _ => c))) lst)


import Foundation

// "WWWBWW" -> [(3, W), (1, B), (2, W)]
func encode(input: String) -> [(Int, Character)] {
    return input.characters.reduce([(Int, Character)]()) {
        if $0.last?.1 == $1 { var r = $0; r[r.count - 1].0++; return r }
        return $0 + [(1, $1)]
    }
}

// [(3, W), (1, B), (2, W)] -> "WWWBWW"
func decode(encoded: [(Int, Character)]) -> String {
    return encoded.reduce("") { $0 + String(count: $1.0, repeatedValue: $1.1) }
}


proc encode {string} {
    set encoding {}
    # use a regular expression to match runs of one character
    foreach {run -} [regexp -all -inline {(.)\1+|.} $string] {
        lappend encoding [string length $run] [string index $run 0]
    }
    return $encoding
}

proc decode {encoding} {
    foreach {count char} $encoding  {
        append decoded [string repeat $char $count]
    }
    return $decoded
}


loop:   ordcop [lch?]\loop;
ordcop: ord/copy;
ord:    char(ch)/last [ch!=lch?]\new [cnt++] fail;
new:    ( [lch?] parse(out) | () ) [lch=ch] [cnt=1] fail;
out:    decimal(cnt) scopy = { 2 1 };
last:   parse(out) [lch=0];
copy:   smark any(!<<>>);

ch:     0;
lch:    0;
cnt:    0;


STRING PROC FNStringGetDecodeStringCharacterEqualCountS( STRING inS )
 STRING s1[255] = ""
 STRING s2[255] = ""
 STRING s3[255] = ""
 STRING s4[255] = ""
 INTEGER I = 0
 INTEGER J = 0
 INTEGER K = 0
 INTEGER L = 0
 K = Length( inS )
 I = 1 - 1
 REPEAT
  J = 1 - 1
  s3 = ""
  REPEAT
   I = I + 1
   J = J + 1
   s1 = SubStr( inS, I, 1 )
   s3 = s3 + s1
   s4 = SubStr( inS, I + 1, 1 )
  UNTIL ( NOT ( s4 IN '0'..'9' ) )
  FOR L = 1 TO Val( s3 )
   s2 = s2 + s4
  ENDFOR
  I = I + 1
 UNTIL ( I >= ( K - 1 ) )
 RETURN( s2 )
END
//
STRING PROC FNStringGetEncodeStringCharacterEqualCountS( STRING inS )
 STRING s1[255] = ""
 STRING s2[255] = ""
 INTEGER I = 0
 INTEGER J = 0
 INTEGER K = 0
 K = Length( inS )
 I = 1 - 1
 REPEAT
  J = 1 - 1
  REPEAT
   I = I + 1
   J = J + 1
   s1 = SubStr( inS, I, 1 )
  UNTIL ( NOT ( SubStr( inS, I + 1, 1 ) == s1 ) )
  s2 = s2 + Str( J ) + s1
 UNTIL ( I >= ( K - 1 ) )
 RETURN( s2 )
END
//
STRING PROC FNStringGetEncodeDecodeStringCharacterEqualCountS( STRING inS )
 STRING s1[255] = FNStringGetEncodeStringCharacterEqualCountS( inS )
 STRING s2[255] = FNStringGetDecodeStringCharacterEqualCountS( s1 )
 RETURN( s2 )
END
//
PROC Main()
 STRING s1[255] = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
 STRING s2[255] = ""
 IF ( NOT ( Ask( "string: get: encode: decode: string: character: equal: count: inS  = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
 s2 = FNStringGetEncodeDecodeStringCharacterEqualCountS( s1 )
 Warn( "equal strings if result is 1", ",", " ", "and the result is", ":", " ", s1 == s2 )
END


$$ MODE TUSCRIPT,{}
input="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",output=""
string=strings(input," ? ")
letter=ACCUMULATE(string,freq)
freq=SPLIT(freq),letter=SPLIT(letter)
output=JOIN(freq,"",letter)
output=JOIN(output,"")
PRINT input
PRINT output


encode() {
    local phrase=$1
    [[ -z $phrase ]] && return
    local result="" count=0 char=${phrase:0:1}
    for ((i = 0; i < ${#phrase}; i++)); do
        if [[ ${phrase:i:1} == "$char" ]]; then
            ((count++))
        else
            result+="$(encode_sequence "$count" "$char")"
            char=${phrase:i:1}
            count=1
        fi
    done
    result+="$(encode_sequence "$count" "$char")"
    echo "$result"
}

encode_sequence() {
    local count=$1 char=$2
    ((count == 1)) && count=""
    echo "${count}${char}"
}

decode() {
    local phrase=$1
    local result=""
    local count char

    while [[ $phrase =~ ([[:digit:]]+)([^[:digit:]]) ]]; do
        printf -v phrase "%s%s%s" \
            "${phrase%%${BASH_REMATCH[0]}*}" \
            "$(repeat "${BASH_REMATCH[1]}" "${BASH_REMATCH[2]}")" \
            "${phrase#*${BASH_REMATCH[0]}}"
    done
    echo "$phrase"
}

repeat() {
    local count=$1 char=$2
    local result
    # string of count spaces
    printf -v result "%*s" "$count" ""
    # replace spaces with the char
    echo "${result// /$char}"
}


#import std
#import nat

encode = (rlc ==); *= ^lhPrNCT\~&h %nP+ length

decode = (rlc ~&l-=digits); *=zyNCXS ^|DlS/~& iota+ %np

test_data = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'

#show+

example =

<
   encode test_data,
   decode encode test_data>


Option Explicit

Sub Main()
Dim p As String
   p = length_encoding("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
   Debug.Print p
   Debug.Print length_decoding(p)
End Sub

Private Function length_encoding(S As String) As String
Dim F As String, r As String, a As String, n As Long, c As Long, k As Long
   r = Left(S, 1)
   c = 1
   For n = 2 To Len(S)
      If r <> Mid(S, n, 1) Then
         a = a & c & r
         r = Mid(S, n, 1)
         c = 1
      Else
         c = c + 1
      End If
   Next
   length_encoding = a & c & r
End Function

Private Function length_decoding(S As String) As String
Dim F As Long, r As String, a As String
   For F = 1 To Len(S)
      If IsNumeric(Mid(S, F, 1)) Then
         r = r & Mid(S, F, 1)
      Else
         a = a & String(CLng(r), Mid(S, F, 1))
         r = vbNullString
      End If
   Next
   length_decoding = a
End Function


:RL_ENCODE:
BOF
While (!At_EOF) {
    if (At_EOL) { Line(1) Continue }    // skip newlines
    #1 = Cur_Char                       // #1 = character
    Match("(.)\1*", REGEXP)             // count run length
    #2 = Chars_Matched                  // #2 = run length
    if (#2 > 127) { #2 = 127 }          // can be max 127
    if (#2 > 1 || #1 > 127) {
        Del_Char(#2)
        Ins_Char(#2 | 128)              // run length (high bit set)
        Ins_Char(#1)                    // character
    } else {                            // single ASCII char
        Char                            // skip
    }
}
Return

:RL_DECODE:
BOF
While (!At_EOF) {
    #2 = Cur_Char
    if (#2 > 127) {                     // is this run length?
        #1 = Cur_Char(1)                // #1 = character value
        Del_Char(2)
        Ins_Char(#1, COUNT, #2 & 127)
    } else {                            // single ASCII char
        Char
    }
}
Return


import "/pattern" for Pattern

var p = Pattern.new("/u") // match any upper case letter

var encode = Fn.new { |s|
    if (s == "") return s
    var e = ""
    var curr = s[0]
    var count = 1
    var i = 1
    while (i < s.count) {
        if (s[i] == curr) {
            count = count + 1
        } else {
            e = e + count.toString + curr
            curr = s[i]
            count = 1
        }
        i = i + 1
    }
    return e + count.toString + curr
}

var decode = Fn.new { |e|
    if (e == "") return e
    var letters = Pattern.matchesText(p.findAll(e))
    var numbers = p.splitAll(e)[0..-2].map { |s| Num.fromString(s) }.toList
    return (0...letters.count).reduce("") { |acc, i| acc + letters[i]*numbers[i] }.join()
}

var strings = [
   "AA",
   "RROSETTAA",
   "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
]

for (s in strings) {
    System.print("Original text      : %(s)")
    var e = encode.call(s)
    System.print("Encoded text       : %(e)")
    var d = decode.call(e)
    System.print("Decoded text       : %(d)")
    System.print("Original = decoded : %(s == d)\n")
}


include c:\cxpl\codes;  \intrinsic 'code' declarations
string 0;               \use zero-terminated strings, instead of MSb terminated

proc Compress(S);       \Compress string using run-length encoding, & display it
char S;
int  I, C0, C, N;
[I:= 0;
C0:= S(I);  I:= I+1;
repeat  ChOut(0, C0);
        N:= 0;
        repeat  C:= S(I);  I:= I+1;
                N:= N+1;
        until   C#C0;
        if N>1 then IntOut(0, N-1);
        C0:= C;
until   C=0;
]; \Compress

proc Expand(S);         \Expand compressed string, and display it
char S;
int  I, C0, C, N;
[I:= 0;
C0:= S(I);  I:= I+1;
repeat  ChOut(0, C0);
        C:= S(I);  I:= I+1;
        if C>=^1 & C<=^9 then
                [N:= 0;
                while C>=^0 & C<=^9 do
                        [N:= N*10 + C-^0;
                        C:= S(I);  I:= I+1;
                        ];
                while N do [ChOut(0, C0);  N:= N-1];
                ];
        C0:= C;
until   C=0;
]; \Expand

[Compress("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW");
CrLf(0);
Expand("W11BW11B2W23BW13");  CrLf(0);
]


const MAX_LEN=250, MIN_LEN=3;
fcn compress(text){ // !empty byte/text stream -->Data (byte stream)
   sink:=Data(); cnt:=Ref(0);
   write:='wrap(c,n){ // helper function
      while(n>MAX_LEN){
         sink.write(1); sink.write(MAX_LEN); sink.write(c);
	 n-=MAX_LEN;
      }
      if(n>MIN_LEN){ sink.write(1); sink.write(n); sink.write(c); }
      else { do(n) { sink.write(c); } }
   };
   text.reduce('wrap(a,b){
      if(a==b) cnt.inc();
      else{ write(a,cnt.value); cnt.set(1); }
      b
   },text[0]) : write(_,cnt.value);
   sink;
}


V languages = [‘abap’, ‘actionscript’, ‘actionscript3’,
               ‘ada’, ‘apache’, ‘applescript’, ‘apt_sources’, ‘asm’, ‘asp’,
               ‘autoit’, ‘avisynth’, ‘bar’, ‘bash’, ‘basic4gl’, ‘bf’,
               ‘blitzbasic’, ‘bnf’, ‘boo’, ‘c’, ‘caddcl’, ‘cadlisp’, ‘cfdg’,
               ‘cfm’, ‘cil’, ‘c_mac’, ‘cobol’, ‘cpp’, ‘cpp-qt’, ‘csharp’, ‘css’,
               ‘d’, ‘delphi’, ‘diff’, ‘_div’, ‘dos’, ‘dot’, ‘eiffel’, ‘email’,
               ‘foo’, ‘fortran’, ‘freebasic’, ‘genero’, ‘gettext’, ‘glsl’, ‘gml’,
               ‘gnuplot’, ‘go’, ‘groovy’, ‘haskell’, ‘hq9plus’, ‘html4strict’,
               ‘idl’, ‘ini’, ‘inno’, ‘intercal’, ‘io’, ‘java’, ‘java5’,
               ‘javascript’, ‘kixtart’, ‘klonec’, ‘klonecpp’, ‘latex’, ‘lisp’,
               ‘lolcode’, ‘lotusformulas’, ‘lotusscript’, ‘lscript’, ‘lua’,
               ‘m68k’, ‘make’, ‘matlab’, ‘mirc’, ‘modula3’, ‘mpasm’, ‘mxml’,
               ‘mysql’, ‘nsis’, ‘objc’, ‘ocaml’, ‘ocaml-brief’, ‘oobas’,
               ‘oracle11’, ‘oracle8’, ‘pascal’, ‘per’, ‘perl’, ‘php’, ‘php-brief’,
               ‘pic16’, ‘pixelbender’, ‘plsql’, ‘povray’, ‘powershell’,
               ‘progress’, ‘prolog’, ‘providex’, ‘python’, ‘qbasic’, ‘rails’,
               ‘reg’, ‘robots’, ‘ruby’, ‘sas’, ‘scala’, ‘scheme’, ‘scilab’,
               ‘sdlbasic’, ‘smalltalk’, ‘smarty’, ‘sql’, ‘tcl’, ‘teraterm’,
               ‘text’, ‘thinbasic’, ‘tsql’, ‘typoscript’, ‘vb’, ‘vbnet’,
               ‘verilog’, ‘vhdl’, ‘vim’, ‘visualfoxpro’, ‘visualprolog’,
               ‘whitespace’, ‘winbatch’, ‘xml’, ‘xorg_conf’, ‘xpp’, ‘z80’]

V text =
‘Lorem ipsum saepe audire elaboraret ne quo, id equidem
atomorum inciderint usu. <foo>In sit inermis deleniti percipit</foo>,
ius ex tale civibus omittam. <barf>Vix ut doctus cetero invenire</barf>, his eu
altera electram. Tota adhuc altera te sea, soluta appetere ut mel</bar>.
Quo quis graecis vivendo te, <baz>posse nullam lobortis ex usu. Eam volumus perpetua
constituto id, mea an omittam fierent vituperatoribus.’

L(lang) languages
   text = text.replace(‘<’lang‘>’, ‘<lang ’lang‘>’)
   text = text.replace(‘</’lang‘>’, ‘</’""‘lang>’)
   text = text.replace(‘’, ‘<lang ’lang‘>’)
text = text.replace(‘’, ‘</’""‘lang>’)

print(text)


; usage: > fixtags.ahk input.txt ouput.txt
FileRead, text, %1%
langs = ada,awk,autohotkey,etc
slang = /lang
slang := "<" . slang . "/>"
Loop, Parse, langs, `,
{
  tag1 = <%A_LoopField%>
  tag2 = </%A_LoopField%>
  text := RegExReplace(text, tag1, "<lang " . A_LoopField . ">")
  text := RegExReplace(text, tag2, slang)
  text := RegExReplace(text, "<code (.+?)>(.*?)</code>"
          , "<lang $1>$2" . slang)
}
FileAppend, % text, %2%


import std.stdio, std.regex, std.string, std.array;

immutable langs = "_div abap actionscript actionscript3 ada apache
applescript apt_sources asm asp autoit avisynth bash basic4gl bf
blitzbasic bnf boo c c_mac caddcl cadlisp cfdg cfm cil cobol cpp
cpp-qt csharp css d delphi diff dos dot eiffel email fortran
freebasic genero gettext glsl gml gnuplot groovy haskell hq9plus
html4strict idl ini inno intercal io java java5 javascript kixtart
klonec klonecpp latex lisp lolcode lotusformulas lotusscript
lscript lua m68k make matlab mirc modula3 mpasm mxml mysql nsis
objc ocaml ocaml-brief oobas oracle11 oracle8 pascal per perl php
php-brief pic16 pixelbender plsql povray powershell progress
prolog providex python qbasic rails reg robots ruby sas scala
scheme scilab sdlbasic smalltalk smarty sql tcl teraterm text
thinbasic tsql typoscript vb vbnet verilog vhdl vim visualfoxpro
visualprolog whitespace winbatch xml xorg_conf xpp z80".split;

string fixTags(string text) {
    static immutable slang = "/lang";
    static immutable code = "code";

    foreach (immutable lang; langs) {
        text = text.replace("<%s>".format(lang),
                            "<lang %s>".format(lang));
        text = text.replace("</%s>".format(lang),
                            "<%s>".format(slang));
    }

    return text.replace("<%s (.+?)>(.*?)</%s>"
                        .format(code, code).regex("g"),
                        "<lang $1>$2<%s>".format(slang));
}

void main() {
    ("lorem ipsum <c>some c code</c>dolor sit amet, <csharp>some " ~
    "csharp code</csharp> consectetur adipisicing elit, <code r>" ~
    " some r code </code>sed do eiusmod tempor incididunt")
    .fixTags
    .writeln;
}


program Fix_code_tags;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.RegularExpressions;

const
  LANGS: array of string = ['abap', 'actionscript', 'actionscript3', 'ada',
    'apache', 'applescript', 'apt_sources', 'asm', 'asp', 'autoit', 'avisynth',
    'bash', 'basic4gl', 'bf', 'blitzbasic', 'bnf', 'boo', 'c', 'caddcl',
    'cadlisp', 'cfdg', 'cfm', 'cil', 'c_mac', 'cobol', 'cpp', 'cpp-qt', 'csharp',
    'css', 'd', 'delphi', 'diff', '_div', 'dos', 'dot', 'eiffel', 'email',
    'fortran', 'freebasic', 'genero', 'gettext', 'glsl', 'gml', 'gnuplot', 'go',
    'groovy', 'haskell', 'hq9plus', 'html4strict', 'idl', 'ini', 'inno',
    'intercal', 'io', 'java', 'java5', 'javascript', 'kixtart', 'klonec',
    'klonecpp', 'latex', 'lisp', 'lolcode', 'lotusformulas', 'lotusscript',
    'lscript', 'lua', 'm68k', 'make', 'matlab', 'mirc', 'modula3', 'mpasm',
    'mxml', 'mysql', 'nsis', 'objc', 'ocaml', 'ocaml-brief', 'oobas', 'oracle11',
    'oracle8', 'pascal', 'per', 'perl', 'php', 'php-brief', 'pic16',
    'pixelbender', 'plsql', 'povray', 'powershell', 'progress', 'prolog',
    'providex', 'python', 'qbasic', 'rails', 'reg', 'robots', 'ruby', 'sas',
    'scala', 'scheme', 'scilab', 'sdlbasic', 'smalltalk', 'smarty', 'sql', 'tcl',
    'teraterm', 'text', 'thinbasic', 'tsql', 'typoscript', 'vb', 'vbnet',
    'verilog', 'vhdl', 'vim', 'visualfoxpro', 'visualprolog', 'whitespace',
    'winbatch', 'xml', 'xorg_conf', 'xpp', 'z80'];

procedure repl(const Match: TMatch; var code: ansistring);

  procedure replace(_new: ansistring);
  begin
    code := StringReplace(code, Match.Value, '<' + _new + '>', [rfReplaceAll]);
  end;

begin
  if Match.Value = '/code' then
  begin
    replace('/lang');
    exit;
  end;

  if Match.Value = '</code>' then
  begin
    replace('/lang');
    exit;
  end;

  var mid := Lowercase(Trim(copy(Match.Value, 2, length(Match.Value) - 2)));

  for var lg in LANGS do
  begin
    if mid = lg then
    begin
      replace(format('lang %s', [lg]));
      exit;
    end;

    if mid[1] = '/' then
    begin
      replace('/lang');
      exit;
    end;

    if (pos('code', mid) = 1) and (copy(mid, 6, length(mid) - 2) = lg) then
    begin
      replace(format('lang %s', [lg]));
      exit;
    end;
  end;
end;

function Lang(input: ansistring): ansistring;
var
  reg: Tregex;
  match: TMatch;
begin
  reg := TRegex.Create('<[^>]+>');
  Result := input;
  for match in reg.Matches(input) do
    Repl(match, Result);
end;

function ReadAll: Ansistring;
var
  Buffer: array[0..1000] of byte;
  StdIn: TStream;
  Count: Integer;
  buf: Ansistring;
begin
  StdIn := THandleStream.Create(GetStdHandle(STD_INPUT_HANDLE));
  Result := '';
  while True do
  begin
    Count := StdIn.Read(Buffer, 1000);
    if Count = 0 then
      Break;
    SetLength(buf, Count);
    CopyMemory(@buf[1], @Buffer[0], Count);
    Result := Result + buf;
  end;
  StdIn.Free;
end;

procedure Fix();
var
  input, output: ansistring;
begin
  input := ReadAll;
  output := Lang(input);
  writeln(output);
end;

begin
  Fix;
end.


#! /usr/bin/env escript
-module( fix_code_tags ).
-mode( compile ).

main( _ ) ->
	File_lines = loop( io:get_line(""), [] ),
	Code_fixed_lines = fix_code_tag( binary:list_to_bin(File_lines) ),
%	true = code:add_pathz( "ebin" ),
%	ok = find_unimplemented_tasks:init(),
%	Dict = dict:from_list( [dict_tuple(X) || X <- rank_languages_by_popularity:rosettacode_languages()],
	Dict = dict:from_list( [dict_tuple(X) || X <- ["foo", "bar", "baz"]] ),
	{_Dict, All_fixed_lines} = lists:foldl( fun fix_language_tag/2, {Dict, Code_fixed_lines}, dict:fetch_keys(Dict) ),
	io:fwrite( "~s", [binary:bin_to_list(All_fixed_lines)] ).

dict_tuple( Language ) -> {binary:list_to_bin(string:to_lower(Language)), binary:list_to_bin(Language)}.

fix_code_tag( Binary ) ->
	Avoid_wiki = binary:list_to_bin( [<<"<">>, <<"lang ">>] ),
	Code_fixed_lines = binary:replace( Binary, <<"<code ">>, Avoid_wiki, [global] ),
	Avoid_wiki_again = binary:list_to_bin( [<<"</">>, <<"lang ">>] ),
	binary:replace( Code_fixed_lines, <<"</code>">>, Avoid_wiki_again, [global] ).

fix_language_tag( Language_key, {Dict, Binary} ) ->
	Language = fix_language_tag_rosettacode_language( Language_key, dict:find(Language_key, Dict) ),
	Language_start_old = binary:list_to_bin( [<<"<">>, Language, <<">">>] ),
	Language_start_new = binary:list_to_bin( [<<"<">>, <<"lang ">>, Language, <<">">>] ),
	Fixed_lines = binary:replace( Binary, Language_start_old, Language_start_new, [global] ),
	Language_stop_old = binary:list_to_bin( [<<"</">>, Language, <<">">>] ),
	Language_stop_new = binary:list_to_bin( [<<"</">>, <<"lang>">>] ),
	{Dict, binary:replace( Fixed_lines, Language_stop_old, Language_stop_new, [global] )}.

fix_language_tag_rosettacode_language( _Language_key, {ok, Language} ) -> Language;
fix_language_tag_rosettacode_language( Language_key, error ) -> Language_key.

loop( eof, Acc ) -> lists:reverse( Acc );
loop( Line, Acc ) -> loop( io:get_line(""), [Line | Acc] ).


open System
open System.Text.RegularExpressions

[<EntryPoint>]
let main argv =
    let langs = [| "foo"; "foo 2"; "bar"; "baz" |];    // An array of (pseudo) languages we handle
    let regexStringAlternationOfLanguageNames = String.Join("|", (Array.map Regex.Escape langs))
    let regexForOldLangSyntax =
        new Regex(String.Format("""
            <                   # Opening of a tag.
            (                   # Group alternation of 2 cases
                (                   # Group for alternation of 2 cases with a language name
                    (?<CloseMarker>/)   # Might be a closing tag,
                    |                   # Or
                    code\s              # an old <code ...> tag
                )?                  # End of alternation; optional
                \b(?<Lang>{0})\b    # Followed by the captured Language alternation
            |                   # Or
                (?<CloseMarker>/code)# An old </code> end tag
            )                   # End of group
            >                   # The final tag closing
            """, regexStringAlternationOfLanguageNames),
            RegexOptions.IgnorePatternWhitespace ||| RegexOptions.ExplicitCapture)

    let replaceEvaluator (m : Match) =
        if m.Groups.Item("CloseMarker").Length > 0 then "</" + "lang>"
        else "<lang " + m.Groups.Item("Lang").Value + ">"

    printfn "%s" (regexForOldLangSyntax.Replace(Console.In.ReadToEnd(), replaceEvaluator))
    0


package main

import "fmt"
import "io/ioutil"
import "log"
import "os"
import "regexp"
import "strings"

func main() {
	err := fix()
	if err != nil {
		log.Fatalln(err)
	}
}

func fix() (err error) {
	buf, err := ioutil.ReadAll(os.Stdin)
	if err != nil {
		return err
	}
	out, err := Lang(string(buf))
	if err != nil {
		return err
	}
	fmt.Println(out)
	return nil
}

func Lang(in string) (out string, err error) {
	reg := regexp.MustCompile("<[^>]+>")
	out = reg.ReplaceAllStringFunc(in, repl)
	return out, nil
}

func repl(in string) (out string) {
	if in == "</code>" {
		// Change </code> to </ lang>
		return "</"+"lang>"
	}

	// mid is the content in between '<' and '>'.
	mid := in[1 : len(in)-1]

	// thanks, random lua guy
	var langs = []string{
		"abap", "actionscript", "actionscript3", "ada", "apache", "applescript",
		"apt_sources", "asm", "asp", "autoit", "avisynth", "bash", "basic4gl",
		"bf", "blitzbasic", "bnf", "boo", "c", "caddcl", "cadlisp", "cfdg", "cfm",
		"cil", "c_mac", "cobol", "cpp", "cpp-qt", "csharp", "css", "d", "delphi",
		"diff", "_div", "dos", "dot", "eiffel", "email", "fortran", "freebasic",
		"genero", "gettext", "glsl", "gml", "gnuplot", "go", "groovy", "haskell",
		"hq9plus", "html4strict", "idl", "ini", "inno", "intercal", "io", "java",
		"java5", "javascript", "kixtart", "klonec", "klonecpp", "latex", "lisp",
		"lolcode", "lotusformulas", "lotusscript", "lscript", "lua", "m68k",
		"make", "matlab", "mirc", "modula3", "mpasm", "mxml", "mysql", "nsis",
		"objc", "ocaml", "ocaml-brief", "oobas", "oracle11", "oracle8", "pascal",
		"per", "perl", "php", "php-brief", "pic16", "pixelbender", "plsql",
		"povray", "powershell", "progress", "prolog", "providex", "python",
		"qbasic", "rails", "reg", "robots", "ruby", "sas", "scala", "scheme",
		"scilab", "sdlbasic", "smalltalk", "smarty", "sql", "tcl", "teraterm",
		"text", "thinbasic", "tsql", "typoscript", "vb", "vbnet", "verilog",
		"vhdl", "vim", "visualfoxpro", "visualprolog", "whitespace", "winbatch",
		"xml", "xorg_conf", "xpp", "z80",
	}
	for _, lang := range langs {
		if mid == lang {
			// Change <%s> to <lang %s>
			return fmt.Sprintf("<lang %s>", lang)
		}

		if strings.HasPrefix(mid, "/") {
			if mid[len("/"):] == lang {
				// Change </%s> to </ lang>
				return "</"+"lang>"
			}
		}

		if strings.HasPrefix(mid, "code ") {
			if mid[len("code "):] == lang {
				// Change <code %s> to <lang %s>
				return fmt.Sprintf("<lang %s>", lang)
			}
		}
	}

	return in
}


require 'printf strings files'

langs=. <;._1 LF -.~ noun define   NB. replace with real lang strings
 foo bar
 baz
)


import java.io.BufferedReader;
import java.io.File;
import java.io.FileReader;
import java.io.FileWriter;

public class FixCodeTags
{
	public static void main(String[] args)
	{
		String sourcefile=args[0];
		String convertedfile=args[1];
		convert(sourcefile,convertedfile);
	}
		static String[] languages = {"abap", "actionscript", "actionscript3",
			"ada", "apache", "applescript", "apt_sources", "asm", "asp",
			"autoit", "avisynth", "bar", "bash", "basic4gl", "bf",
			"blitzbasic", "bnf", "boo", "c", "caddcl", "cadlisp", "cfdg",
			"cfm", "cil", "c_mac", "cobol", "cpp", "cpp-qt", "csharp", "css",
			"d", "delphi", "diff", "_div", "dos", "dot", "eiffel", "email",
			"foo", "fortran", "freebasic", "genero", "gettext", "glsl", "gml",
			"gnuplot", "go", "groovy", "haskell", "hq9plus", "html4strict",
			"idl", "ini", "inno", "intercal", "io", "java", "java5",
			"javascript", "kixtart", "klonec", "klonecpp", "latex", "lisp",
			"lolcode", "lotusformulas", "lotusscript", "lscript", "lua",
			"m68k", "make", "matlab", "mirc", "modula3", "mpasm", "mxml",
			"mysql", "nsis", "objc", "ocaml", "ocaml-brief", "oobas",
			"oracle11", "oracle8", "pascal", "per", "perl", "php", "php-brief",
			"pic16", "pixelbender", "plsql", "povray", "powershell",
			"progress", "prolog", "providex", "python", "qbasic", "rails",
			"reg", "robots", "ruby", "sas", "scala", "scheme", "scilab",
			"sdlbasic", "smalltalk", "smarty", "sql", "tcl", "teraterm",
			"text", "thinbasic", "tsql", "typoscript", "vb", "vbnet",
			"verilog", "vhdl", "vim", "visualfoxpro", "visualprolog",
			"whitespace", "winbatch", "xml", "xorg_conf", "xpp", "z80"};
	static void convert(String sourcefile,String convertedfile)
	{
		try
		{
			BufferedReader br=new BufferedReader(new FileReader(sourcefile));
			//String buffer to store contents of the file
			StringBuffer sb=new StringBuffer("");
			String line;
			while((line=br.readLine())!=null)
			{
				for(int i=0;i<languages.length;i++)
				{
					String lang=languages[i];
					line=line.replaceAll("<"+lang+">", "<lang "+lang+">");
					line=line.replaceAll("</"+lang+">", "</"+"lang>");
					line=line.replaceAll("<code "+lang+">", "<lang "+lang+">");
					line=line.replaceAll("</code>", "</"+"lang>");
				}
				sb.append(line);
			}
			br.close();

			FileWriter fw=new FileWriter(new File(convertedfile));
			//Write entire string buffer into the file
			fw.write(sb.toString());
			fw.close();
		}
		catch (Exception e)
		{
			System.out.println("Something went horribly wrong: "+e.getMessage());
		}
	}
}


var langs = ['foo', 'bar', 'baz']; // real list of langs goes here
var end_tag = '</'+'lang>';

var line;
while (line = readline()) {
    line = line.replace(new RegExp('</code>', 'gi'), end_tag);
    for (var i = 0; i < langs.length; i++)
        line = line.replace(new RegExp('<(?:code )?(' + langs[i] + ')>', 'gi'), '<lang $1>')
                   .replace(new RegExp('</' + langs[i] + '>', 'gi'), end_tag);
    print(line);
}


function fixtags(text::AbstractString)
    langs = ["ada", "cpp-qt", "pascal", "lscript", "z80", "visualprolog",
            "html4strict", "cil", "objc", "asm", "progress", "teraterm", "hq9plus",
            "genero", "tsql", "email", "pic16", "tcl", "apt_sources", "io", "apache",
            "vhdl", "avisynth", "winbatch", "vbnet", "ini", "scilab", "ocaml-brief",
            "sas", "actionscript3", "qbasic", "perl", "bnf", "cobol", "powershell",
            "php", "kixtart", "visualfoxpro", "mirc", "make", "javascript", "cpp",
            "sdlbasic", "cadlisp", "php-brief", "rails", "verilog", "xml", "csharp",
            "actionscript", "nsis", "bash", "typoscript", "freebasic", "dot",
            "applescript", "haskell", "dos", "oracle8", "cfdg", "glsl", "lotusscript",
            "mpasm", "latex", "sql", "klonec", "ruby", "ocaml", "smarty", "python",
            "oracle11", "caddcl", "robots", "groovy", "smalltalk", "diff", "fortran",
            "cfm", "lua", "modula3", "vb", "autoit", "java", "text", "scala",
            "lotusformulas", "pixelbender", "reg", "_div", "whitespace", "providex",
            "asp", "css", "lolcode", "lisp", "inno", "mysql", "plsql", "matlab",
            "oobas", "vim", "delphi", "xorg_conf", "gml", "prolog", "bf", "per",
            "scheme", "mxml", "d", "basic4gl", "m68k", "gnuplot", "idl", "abap",
            "intercal", "c_mac", "thinbasic", "java5", "xpp", "boo", "klonecpp",
            "blitzbasic", "eiffel", "povray", "c", "gettext"]

    slang = "/lang"
    code  = "code"

    for l in langs
            text = replace(text, "<$l>","<lang $l>")
            text = replace(text, "</$l>", "<$slang>")
    end

    text = replace(text, Regex("(?s)<$code (.+?)>(.*?)</$code>"), "<lang \\1>\\2<$slang>")
end

const txt = readstring(ARGS[1])
println(fixtags(txt))