Data commit

Task/Run-length-encoding/00-META.yaml

@@ -0,0 +1,5 @@
+---
+category:
+- Encodings
+from: http://rosettacode.org/wiki/Run-length_encoding
+note: Compression

Task/Run-length-encoding/00-TASK.txt

@@ -0,0 +1,14 @@
+;Task:
+Given a string containing uppercase characters (A-Z), compress repeated 'runs' of the same character by storing the length of that run, and provide a function to reverse the compression. 
+
+The output can be anything, as long as you can recreate the input with it.
+
+
+;Example:
+: Input:  <code>WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</code>
+: Output: <code>12W1B12W3B24W1B14W</code>
+
+
+Note: the encoding step in the above example is the same as a step of the [[Look-and-say sequence]].
+<br><br>
+

Task/Run-length-encoding/11l/run-length-encoding.11l

@@ -0,0 +1,24 @@
+F encode(input_string)
+   V count = 1
+   V prev = Char("\0")
+   [(Char, Int)] lst
+   L(character) input_string
+      I character != prev
+         I prev != Char("\0")
+            lst.append((prev, count))
+         count = 1
+         prev = character
+      E
+         count++
+   lst.append((input_string.last, count))
+   R lst
+
+F decode(lst)
+   V q = ‘’
+   L(character, count) lst
+      q ‘’= character * count
+   R q
+
+V value = encode(‘aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa’)
+print(‘Encoded value is ’value.map(v -> String(v[1])‘’v[0]))
+print(‘Decoded value is ’decode(value))

Task/Run-length-encoding/8086-Assembly/run-length-encoding.8086

@@ -0,0 +1,64 @@
+        .model small       ; 128k .exe file
+        .stack 1024        ; load SP with 0400h
+        .data              ; no data segment needed
+
+	.code
+	
+start:
+
+	mov ax,@code
+	mov ds,ax
+	mov es,ax
+	
+	mov si,offset TestString
+	mov di,offset OutputRam
+	
+	cld
+	
+compressRLE:
+	lodsb
+	cmp al,0                     ;null terminator?
+	jz finished_Compressing      ;if so, exit
+	push di
+	push si
+		mov cx,0FFFFh	;exit after 65536 reps or the run length ends.
+		xchg di,si      ;scasb only works with es:di so we need to exchange
+		repz scasb   	;repeat until [es:di] != AL
+		xchg di,si      ;exchange back
+	pop dx                  ;pop the old SI into DX instead!
+	pop di
+	
+	push si
+		sub si,dx
+		mov dx,si
+	pop si
+	;now the run length is in dx, store it into output ram.
+
+	push ax
+		mov al,dl
+		stosb
+	pop ax
+	stosb    ;store the letter that corresponds to the run
+
+	
+	dec si   ;we're off by one, so we need to correct for that.
+	jmp compressRLE   ;back to start
+	
+finished_Compressing:
+
+	
+	mov bp, offset OutputRam
+	mov bx, 32
+	call doMemDump        ;displays a hexdump of the contents of OutputRam
+
+
+	
+	mov ax,4C00h
+	int 21h		      ;exit DOS
+	
+	
+TestString byte "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",0
+
+OutputRam byte 256 dup (0)
+
+end start

Task/Run-length-encoding/ALGOL-68/run-length-encoding.alg

@@ -0,0 +1,72 @@
+STRING input := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+STRING output := "12W1B12W3B24W1B14W";
+
+MODE YIELDCHAR = PROC(CHAR)VOID;
+MODE GENCHAR = PROC(YIELDCHAR)VOID;
+
+PROC gen char string = (REF STRING s, YIELDCHAR yield)VOID:
+  FOR i FROM LWB s TO UPB s DO yield(s[i]) OD;
+
+CO
+# Note: The following 2 lines use currying. This not supported by ELLA ALGOL 68RS #
+GENCHAR input seq = gen char string(input,),
+        output seq = gen char string(output,);
+END CO
+
+GENCHAR
+  input seq = (YIELDCHAR yield)VOID: gen char string(input, yield),
+  output seq = (YIELDCHAR yield)VOID: gen char string(output, yield);
+
+PROC gen encode = (GENCHAR gen char, YIELDCHAR yield)VOID: (
+  INT count := 0;
+  CHAR prev;
+# FOR CHAR c IN # gen char( # ) DO ( #
+##   (CHAR c)VOID: (
+      IF count = 0 THEN
+        count := 1;
+        prev := c
+      ELIF c NE prev THEN
+        STRING str count := whole(count,0);
+        gen char string(str count, yield); count := 1;
+        yield(prev); prev := c
+      ELSE
+        count +:=1
+      FI
+# OD # ));
+  IF count NE 0 THEN
+    STRING str count := whole(count,0);
+    gen char string(str count,yield);
+    yield(prev)
+  FI
+);
+
+STRING zero2nine = "0123456789";
+
+PROC gen decode = (GENCHAR gen char, YIELDCHAR yield)VOID: (
+  INT repeat := 0;
+# FOR CHAR c IN # gen char( # ) DO ( #
+##   (CHAR c)VOID: (
+    IF char in string(c, LOC INT, zero2nine) THEN
+      repeat := repeat*10 + ABS c - ABS "0"
+    ELSE
+      FOR i TO repeat DO yield(c) OD;
+      repeat := 0
+    FI
+# OD #  ))
+);
+
+# iterate through input string #
+print("Encode input: ");
+# FOR CHAR c IN # gen encode(input seq, # ) DO ( #
+##   (CHAR c)VOID:
+    print(c)
+# OD # );
+print(new line);
+
+# iterate through output string #
+print("Decode output: ");
+# FOR CHAR c IN # gen decode(output seq, # ) DO ( #
+##   (CHAR c)VOID:
+    print(c)
+# OD # );
+print(new line)

Task/Run-length-encoding/APL/run-length-encoding.apl

@@ -0,0 +1,4 @@
+    ∇ ret←RLL rll;count
+[1]   count←∣2-/((1,(2≠/rll),1)×⍳1+⍴rll)~0
+[2]   ret←(⍕count,¨(1,2≠/rll)/rll)~' '
+    ∇

Task/Run-length-encoding/AWK/run-length-encoding-1.awk

@@ -0,0 +1,16 @@
+BEGIN {
+ FS=""
+}
+/^[^0-9]+$/ {
+  cp = $1; j = 0
+  for(i=1; i <= NF; i++) {
+    if ( $i == cp ) {
+      j++;
+    } else {
+      printf("%d%c", j, cp)
+      j = 1
+    }
+    cp = $i
+  }
+  printf("%d%c", j, cp)
+}

Task/Run-length-encoding/AWK/run-length-encoding-2.awk

@@ -0,0 +1,13 @@
+BEGIN {
+  RS="[0-9]+[^0-9]"
+  final = "";
+}
+{
+  match(RT, /([0-9]+)([^0-9])/, r)
+  for(i=0; i < int(r[1]); i++) {
+    final = final r[2]
+  }
+}
+END {
+  print final
+}

Task/Run-length-encoding/Action-/run-length-encoding.action

@@ -0,0 +1,100 @@
+BYTE FUNC GetLength(CHAR ARRAY s BYTE pos)
+  CHAR c
+  BYTE len
+
+  c=s(pos)
+  len=1
+  DO
+    pos==+1
+    IF pos<=s(0) AND s(pos)=c THEN
+      len==+1
+    ELSE
+      EXIT
+    FI
+  OD
+RETURN (len)
+
+BYTE FUNC GetNumber(CHAR ARRAY s BYTE POINTER pos)
+  BYTE num,len
+  CHAR ARRAY tmp(5)
+
+  len=0
+  DO
+    len==+1
+    tmp(len)=s(pos^)
+    pos^==+1
+    IF s(pos^)<'0 OR s(pos^)>'9 THEN
+      EXIT
+    FI
+  OD
+  tmp(0)=len
+  num=ValB(tmp)
+RETURN (num)
+
+PROC Append(CHAR ARRAY text,suffix)
+  BYTE POINTER srcPtr,dstPtr
+  BYTE len
+
+  len=suffix(0)
+  IF text(0)+len>255 THEN
+    len=255-text(0)
+  FI
+  IF len THEN
+    srcPtr=suffix+1
+    dstPtr=text+text(0)+1
+    MoveBlock(dstPtr,srcPtr,len)
+    text(0)==+suffix(0)
+  FI
+RETURN
+
+PROC Encode(CHAR ARRAY in,out)
+  BYTE pos,len
+  CHAR ARRAY tmp(5)
+
+  pos=1 len=0 out(0)=0
+  WHILE pos<=in(0)
+  DO
+    len=GetLength(in,pos)
+    StrB(len,tmp)
+    Append(out,tmp)
+    out(0)==+1
+    out(out(0))=in(pos)
+    pos==+len
+  OD
+RETURN
+
+PROC Decode(CHAR ARRAY in,out)
+  BYTE pos,num,i
+  CHAR c
+
+  pos=1 out(0)=0
+  WHILE pos<=in(0)
+  DO
+    num=GetNumber(in,@pos)
+    c=in(pos)
+    pos==+1
+    FOR i=1 TO num
+    DO
+      out(0)==+1
+      out(out(0))=c
+    OD
+  OD
+RETURN
+
+PROC Main()
+  CHAR ARRAY data="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+  CHAR ARRAY encoded(256),decoded(256)
+
+  PrintE("original:")
+  PrintE(data)
+  PutE()
+
+  Encode(data,encoded)
+  PrintE("encoded:")
+  PrintE(encoded)
+  PutE()
+
+  Decode(encoded,decoded)
+  PrintE("decoded:")
+  PrintE(decoded)
+RETURN

Task/Run-length-encoding/Ada/run-length-encoding.ada

@@ -0,0 +1,48 @@
+with Ada.Text_IO;        use Ada.Text_IO;
+with Ada.Strings.Fixed;  use Ada.Strings.Fixed;
+procedure Test_Run_Length_Encoding is
+   function Encode (Data : String) return String is
+   begin
+      if Data'Length = 0 then
+         return "";
+      else
+         declare
+            Code  : constant Character := Data (Data'First);
+            Index : Integer := Data'First + 1;
+         begin
+            while Index <= Data'Last and then Code = Data (Index) loop
+               Index := Index + 1;
+            end loop;
+            declare
+               Prefix : constant String := Integer'Image (Index - Data'First);
+            begin
+               return Prefix (2..Prefix'Last) & Code & Encode (Data (Index..Data'Last));
+            end;
+         end;
+      end if;
+   end Encode;
+   function Decode (Data : String) return String is
+   begin
+      if Data'Length = 0 then
+         return "";
+      else
+         declare
+            Index : Integer := Data'First;
+            Count : Natural := 0;
+         begin
+            while Index < Data'Last and then Data (Index) in '0'..'9' loop
+               Count := Count * 10 + Character'Pos (Data (Index)) - Character'Pos ('0');
+               Index := Index + 1;
+            end loop;
+            if Index > Data'First then
+               return Count * Data (Index) & Decode (Data (Index + 1..Data'Last));
+            else
+               return Data;
+            end if;
+         end;
+      end if;
+   end Decode;
+begin
+   Put_Line (Encode ("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"));
+   Put_Line (Decode ("12W1B12W3B24W1B14W"));
+end Test_Run_Length_Encoding;

Task/Run-length-encoding/AppleScript/run-length-encoding.applescript

@@ -0,0 +1,159 @@
+------------------ RUN-LENGTH ENCODING‎‎ -----------------
+
+-- encode :: String -> String
+on encode(s)
+    script go
+        on |λ|(cs)
+            if {} ≠ cs then
+                set c to text 1 of cs
+                set {chunk, residue} to span(eq(c), rest of cs)
+                (c & (1 + (length of chunk)) as string) & |λ|(residue)
+            else
+                ""
+            end if
+        end |λ|
+    end script
+    |λ|(characters of s) of go
+end encode
+
+
+-- decode :: String -> String
+on decode(s)
+    script go
+        on |λ|(cs)
+            if {} ≠ cs then
+                set {ds, residue} to span(my isDigit, rest of cs)
+                set n to (ds as string) as integer
+                replicate(n, item 1 of cs) & |λ|(residue)
+            else
+                ""
+            end if
+        end |λ|
+    end script
+    |λ|(characters of s) of go
+end decode
+
+
+--------------------------- TEST -------------------------
+on run
+    set src to ¬
+        "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+    set encoded to encode(src)
+    set decoded to decode(encoded)
+
+    unlines({encoded, decoded, src = decoded})
+end run
+
+
+-------------------- GENERIC FUNCTIONS -------------------
+
+-- eq :: a -> a -> Bool
+on eq(a)
+    -- True if a and b are equivalent in terms
+    -- of the AppleScript (=) operator.
+    script go
+        on |λ|(b)
+            a = b
+        end |λ|
+    end script
+end eq
+
+
+-- isDigit :: Char -> Bool
+on isDigit(c)
+    set n to (id of c)
+    48 ≤ n and 57 ≥ n
+end isDigit
+
+
+-- mReturn :: First-class m => (a -> b) -> m (a -> b)
+on mReturn(f)
+    -- 2nd class handler function lifted into 1st class script wrapper.
+    if script is class of f then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
+
+
+-- Egyptian multiplication - progressively doubling a list, appending
+-- stages of doubling to an accumulator where needed for binary
+-- assembly of a target length
+-- replicate :: Int -> String -> String
+on replicate(n, s)
+    -- Egyptian multiplication - progressively doubling a list,
+    -- appending stages of doubling to an accumulator where needed
+    -- for binary assembly of a target length
+    script p
+        on |λ|({n})
+            n ≤ 1
+        end |λ|
+    end script
+
+    script f
+        on |λ|({n, dbl, out})
+            if (n mod 2) > 0 then
+                set d to out & dbl
+            else
+                set d to out
+            end if
+            {n div 2, dbl & dbl, d}
+        end |λ|
+    end script
+
+    set xs to |until|(p, f, {n, s, ""})
+    item 2 of xs & item 3 of xs
+end replicate
+
+
+-- span :: (a -> Bool) -> [a] -> ([a], [a])
+on span(p, xs)
+    -- The longest (possibly empty) prefix of xs
+    -- that contains only elements satisfying p,
+    -- tupled with the remainder of xs.
+    -- span(p, xs) eq (takeWhile(p, xs), dropWhile(p, xs))
+    script go
+        property mp : mReturn(p)
+        on |λ|(vs)
+            if {} ≠ vs then
+                set x to item 1 of vs
+                if |λ|(x) of mp then
+                    set {ys, zs} to |λ|(rest of vs)
+                    {{x} & ys, zs}
+                else
+                    {{}, vs}
+                end if
+            else
+                {{}, {}}
+            end if
+        end |λ|
+    end script
+    |λ|(xs) of go
+end span
+
+
+-- unlines :: [String] -> String
+on unlines(xs)
+    -- A single string formed by the intercalation
+    -- of a list of strings with the newline character.
+    set {dlm, my text item delimiters} to ¬
+        {my text item delimiters, linefeed}
+    set s to xs as text
+    set my text item delimiters to dlm
+    s
+end unlines
+
+
+-- until :: (a -> Bool) -> (a -> a) -> a -> a
+on |until|(p, f, x)
+    set v to x
+    set mp to mReturn(p)
+    set mf to mReturn(f)
+    repeat until mp's |λ|(v)
+        set v to mf's |λ|(v)
+    end repeat
+    v
+end |until|

Task/Run-length-encoding/Arturo/run-length-encoding.arturo

@@ -0,0 +1,21 @@
+runlengthEncode: function [s][
+    join map chunk split s => [&] 'x ->
+        (to :string size x) ++ first x
+]
+
+runlengthDecode: function [s][
+    result: new ""
+    loop (chunk split s 'x -> positive? size match x {/\d+/}) [a,b] ->
+        'result ++ repeat first b to :integer join to [:string] a
+    return result
+]
+
+str: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+
+encoded: runlengthEncode str
+print ["encoded:" encoded]
+
+decoded: runlengthDecode encoded
+print ["decoded:" decoded]
+
+if decoded=str -> print "\nSuccess!"

Task/Run-length-encoding/AutoHotkey/run-length-encoding.ahk

@@ -0,0 +1,35 @@
+MsgBox % key := rle_encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
+MsgBox % rle_decode(key)
+
+rle_encode(message)
+{
+  StringLeft, previous, message, 1
+  StringRight, last, message, 1
+  message .= Asc(Chr(last)+1)
+  count = 0
+  Loop, Parse, message
+  {
+    If (previous == A_LoopField)
+      count +=1
+    Else
+    {
+      output .= previous . count
+      previous := A_LoopField
+      count = 1
+    }
+  }
+  Return output
+}
+
+rle_decode(message)
+{
+  pos = 1
+  While, item := RegExMatch(message, "\D", char, pos)
+  {
+    digpos := RegExMatch(message, "\d+", dig, item)
+    Loop, % dig
+      output .= char
+    pos := digpos
+  }
+  Return output
+}

Task/Run-length-encoding/BASIC/run-length-encoding.basic

@@ -0,0 +1,55 @@
+DECLARE FUNCTION RLDecode$ (i AS STRING)
+DECLARE FUNCTION RLEncode$ (i AS STRING)
+
+DIM initial AS STRING, encoded AS STRING, decoded AS STRING
+
+INPUT "Type something: ", initial
+encoded = RLEncode(initial)
+decoded = RLDecode(encoded)
+PRINT initial
+PRINT encoded
+PRINT decoded
+
+FUNCTION RLDecode$ (i 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
+    RLDecode$ = outP
+END FUNCTION
+
+FUNCTION RLEncode$ (i 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 + LTRIM$(RTRIM$(STR$(rCount))) + tmp2
+            tmp2 = tmp1
+            rCount = 1
+        ELSE
+            rCount = rCount + 1
+        END IF
+    NEXT
+
+    outP = outP + LTRIM$(RTRIM$(STR$(rCount)))
+    outP = outP + tmp2
+    RLEncode$ = outP
+END FUNCTION

Task/Run-length-encoding/BASIC256/run-length-encoding.basic

@@ -0,0 +1,77 @@
+function FBString(lon, cad$)
+	# Definimos la función String en BASIC256
+	cadena$ = ""
+	for a = 1 to lon
+		cadena$ += cad$
+	next a
+	return cadena$
+end function
+
+function RLDecode(i$)
+	rCount$ = "" : outP$ = ""
+
+	for Loop0 = 1 to length(i$)
+		m$ = mid(i$, Loop0, 1)
+		begin case
+			case m$ = "0"
+				rCount$ += m$
+			case m$ = "1"
+				rCount$ += m$
+			case m$ = "2"
+				rCount$ += m$
+			case m$ = "3"
+				rCount$ += m$
+			case m$ = "4"
+				rCount$ += m$
+			case m$ = "5"
+				rCount$ += m$
+			case m$ = "6"
+				rCount$ += m$
+			case m$ = "7"
+				rCount$ += m$
+			case m$ = "8"
+				rCount$ += m$
+			case m$ = "9"
+				rCount$ += m$
+			else
+				if length(rCount$) then
+					outP$ += FBString(int(rCount$), m$)
+					rCount$ = ""
+				else
+					outP$ += m$
+				end if
+		end case
+	next Loop0
+
+	RLDecode = outP$
+end function
+
+function RLEncode(i$)
+	outP$ = ""
+	tmp1 = mid(i$, 1, 1)
+	tmp2 = tmp1
+	rCount = 1
+
+	for Loop0 = 2 to length(i$)
+		tmp1 = mid(i$, Loop0, 1)
+		if tmp1 <> tmp2 then
+			outP$ += string(rCount) + tmp2
+			tmp2 = tmp1
+			rCount = 1
+		else
+			rCount += 1
+		end if
+	next Loop0
+
+	outP$ += replace(string(rCount)," ", "")
+	outP$ += tmp2
+	RLEncode = outP$
+end function
+
+input "Type something: ", initial
+encoded$ = RLEncode(initial)
+decoded$ = RLDecode(encoded$)
+print initial
+print encoded$
+print decoded$
+end

Task/Run-length-encoding/BBC-BASIC/run-length-encoding.basic

@@ -0,0 +1,36 @@
+      input$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+      PRINT "Input:  " input$
+      rle$ = FNencodeRLE(input$)
+      output$ = FNdecodeRLE(rle$)
+      PRINT "Output: " output$
+      END
+
+      DEF FNencodeRLE(text$)
+      LOCAL n%, r%, c$, o$
+      n% = 1
+      WHILE n% <= LEN(text$)
+        c$ = MID$(text$, n%, 1)
+        n% += 1
+        r% = 1
+        WHILE c$ = MID$(text$, n%, 1) AND r% < 127
+          r% += 1
+          n% += 1
+        ENDWHILE
+        IF r% < 3 o$ += STRING$(r%, c$) ELSE o$ += CHR$(128+r%) + c$
+      ENDWHILE
+      = o$
+
+      DEF FNdecodeRLE(rle$)
+      LOCAL n%, c$, o$
+      n% = 1
+      WHILE n% <= LEN(rle$)
+        c$ = MID$(rle$, n%, 1)
+        n% += 1
+        IF ASC(c$) > 128 THEN
+          o$ += STRING$(ASC(c$)-128, MID$(rle$, n%, 1))
+          n% += 1
+        ELSE
+          o$ += c$
+        ENDIF
+      ENDWHILE
+      = o$

Task/Run-length-encoding/BaCon/run-length-encoding.bacon

@@ -0,0 +1,42 @@
+FUNCTION Rle_Encode$(txt$)
+
+    LOCAL result$, c$ = LEFT$(txt$, 1)
+    LOCAL total = 1
+
+    FOR x = 2 TO LEN(txt$)
+        IF c$ = MID$(txt$, x, 1) THEN
+            INCR total
+        ELSE
+            result$ = result$ & STR$(total) & c$
+            c$ = MID$(txt$, x, 1)
+            total = 1
+        END IF
+    NEXT
+
+    RETURN result$ & STR$(total) & c$
+
+END FUNCTION
+
+FUNCTION Rle_Decode$(txt$)
+
+    LOCAL nr$, result$
+
+    FOR x = 1 TO LEN(txt$)
+        IF REGEX(MID$(txt$, x, 1), "[[:digit:]]") THEN
+            nr$ = nr$ & MID$(txt$, x, 1)
+        ELSE
+            result$ = result$ & FILL$(VAL(nr$), ASC(MID$(txt$, x, 1)))
+            nr$ = ""
+        END IF
+    NEXT
+
+    RETURN result$
+
+END FUNCTION
+
+rle_data$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+
+PRINT "RLEData: ", rle_data$
+encoded$ = Rle_Encode$(rle_data$)
+PRINT "Encoded: ", encoded$
+PRINT "Decoded: ", Rle_Decode$(encoded$)

Task/Run-length-encoding/Befunge/run-length-encoding.bf

@@ -0,0 +1,26 @@
+                    ~"y"- ~$         v
+  <temp var for when char changes
+format:
+first,'n' and a newline.             :
+a char then a                   v    _"n",v
+number then a space continuously          9
+example:                                  1
+n                               >    v  ,+<
+a5 b2
+decoded:aaaaabb
+the program is ended using   decoder
+Ctrl-C on linux,or alt-f4
+on windows.copy the output    >\v       encoder
+of the program somewhere      ^_ $ v
+to encode press y              :        > $11g:,  v
+to decode pipe file in      >1-^   ~       v  +1\<
+the output of the encoder   \  v<  $    ^     .\_^
+starts with n,this is so    ^,:<\&~< _~:,>1>\:v>^
+you can pipe it straight in              ^        <
+                                              ~
+the spaces seem to be a annoying thing        :
+thanks to CCBI...if a interpreter dosen't     1
+create them it's non-conforming and thus      1
+the validity of this program is NOT affected  p-
+                                              >^
+--written by Gamemanj,for Rosettacode

Task/Run-length-encoding/Bracmat/run-length-encoding.bracmat

@@ -0,0 +1,21 @@
+  ( run-length
+  = character otherCharacter acc begin end
+    .   :?acc
+      & 0:?begin
+      & @( !arg
+         :   ?
+             [!begin
+             %@?character
+             ?
+             [?end
+             (   (%@:~!character:?otherCharacter) ?
+               & !acc !end+-1*!begin !character:?acc
+               & !otherCharacter:?character
+               & !end:?begin
+               & ~`
+             | &!acc !end+-1*!begin !character:?acc
+             )
+         )
+      & str$!acc
+  )
+&   run-length$WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW

Task/Run-length-encoding/Burlesque/run-length-encoding.blq

@@ -0,0 +1,2 @@
+"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+=[{^^[~\/L[Sh}\m

Task/Run-length-encoding/C++/run-length-encoding-1.cpp

@@ -0,0 +1,162 @@
+#include <algorithm>
+#include <array>
+#include <iterator>
+#include <limits>
+#include <tuple>
+
+namespace detail_ {
+
+// For constexpr digit<->number conversions.
+constexpr auto digits = std::array{'0','1','2','3','4','5','6','7','8','9'};
+
+// Helper function to encode a run-length.
+template <typename OutputIterator>
+constexpr auto encode_run_length(std::size_t n, OutputIterator out)
+{
+    constexpr auto base = digits.size();
+
+    // Determine the number of digits needed.
+    auto const num_digits = [base](auto n)
+    {
+        auto d = std::size_t{1};
+        while ((n /= digits.size()))
+            ++d;
+        return d;
+    }(n);
+
+    // Helper lambda to raise the base to an integer power.
+    auto base_power = [base](auto n)
+    {
+        auto res = decltype(base){1};
+        for (auto i = decltype(n){1}; i < n; ++i)
+            res *= base;
+        return res;
+    };
+
+    // From the most significant digit to the least, output the digit.
+    for (auto i = decltype(num_digits){0}; i < num_digits; ++i)
+        *out++ = digits[(n / base_power(num_digits - i)) % base];
+
+    return out;
+}
+
+// Helper function to decode a run-length.
+// As of C++20, this can be constexpr, because std::find() is constexpr.
+// Before C++20, it can be constexpr by emulating std::find().
+template <typename InputIterator>
+auto decode_run_length(InputIterator first, InputIterator last)
+{
+    auto count = std::size_t{0};
+
+    while (first != last)
+    {
+        // If the next input character is not a digit, we're done.
+        auto const p = std::find(digits.begin(), digits.end(), *first);
+        if (p == digits.end())
+            break;
+
+        // Convert the digit to a number, and append it to the size.
+        count *= digits.size();
+        count += std::distance(digits.begin(), p);
+
+        // Move on to the next input character.
+        ++first;
+    }
+
+    return std::tuple{count, first};
+}
+
+} // namespace detail_
+
+template <typename InputIterator, typename OutputIterator>
+constexpr auto encode(InputIterator first, InputIterator last, OutputIterator out)
+{
+    while (first != last)
+    {
+        // Read the next value.
+        auto const value = *first++;
+
+        // Increase the count as long as the next value is the same.
+        auto count = std::size_t{1};
+        while (first != last && *first == value)
+        {
+            ++count;
+            ++first;
+        }
+
+        // Write the value and its run length.
+        out = detail_::encode_run_length(count, out);
+        *out++ = value;
+    }
+
+    return out;
+}
+
+// As of C++20, this can be constexpr, because std::find() and
+// std::fill_n() are constexpr (and decode_run_length() can be
+// constexpr, too).
+// Before C++20, it can be constexpr by emulating std::find() and
+// std::fill_n().
+template <typename InputIterator, typename OutputIterator>
+auto decode(InputIterator first, InputIterator last, OutputIterator out)
+{
+    while (first != last)
+    {
+        using detail_::digits;
+
+        // Assume a run-length of 1, then try to decode the actual
+        // run-length, if any.
+        auto count = std::size_t{1};
+        if (std::find(digits.begin(), digits.end(), *first) != digits.end())
+            std::tie(count, first) = detail_::decode_run_length(first, last);
+
+        // Write the run.
+        out = std::fill_n(out, count, *first++);
+    }
+
+    return out;
+}
+
+template <typename Range, typename OutputIterator>
+constexpr auto encode(Range&& range, OutputIterator out)
+{
+    using std::begin;
+    using std::end;
+
+    return encode(begin(range), end(range), out);
+}
+
+template <typename Range, typename OutputIterator>
+auto decode(Range&& range, OutputIterator out)
+{
+    using std::begin;
+    using std::end;
+
+    return decode(begin(range), end(range), out);
+}
+
+// Sample application and checking ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+#include <iostream>
+#include <string_view>
+
+int main()
+{
+    using namespace std::literals;
+
+    constexpr auto test_string = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"sv;
+
+    std::cout << "Input:  \"" << test_string << "\"\n";
+    std::cout << "Output: \"";
+    // No need for a temporary string - can encode directly to cout.
+    encode(test_string, std::ostreambuf_iterator<char>{std::cout});
+    std::cout << "\"\n";
+
+    auto encoded_str = std::string{};
+    auto decoded_str = std::string{};
+    encode(test_string, std::back_inserter(encoded_str));
+    decode(encoded_str, std::back_inserter(decoded_str));
+
+    std::cout.setf(std::cout.boolalpha);
+    std::cout << "Round trip works: " << (test_string == decoded_str) << '\n';
+}

Task/Run-length-encoding/C++/run-length-encoding-2.cpp

@@ -0,0 +1,53 @@
+#include <iostream>
+#include <string>
+#include <sstream>
+#include <boost/regex.hpp>
+#include <cstdlib>
+
+std::string encode ( const std::string & ) ;
+std::string decode ( const std::string & ) ;
+
+int main( ) {
+   std::string to_encode ( "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" ) ;
+   std::cout << to_encode << " encoded:" << std::endl ;
+   std::string encoded ( encode ( to_encode ) ) ;
+   std::cout << encoded << std::endl ;
+   std::string decoded ( decode( encoded ) ) ;
+   std::cout << "Decoded again:\n" ;
+   std::cout << decoded << std::endl ;
+   if ( to_encode == decoded )
+      std::cout << "It must have worked!\n" ;
+   return 0 ;
+}
+
+std::string encode( const std::string & to_encode ) {
+   std::string::size_type found = 0 , nextfound = 0 ;
+   std::ostringstream oss ;
+   nextfound = to_encode.find_first_not_of( to_encode[ found ] , found ) ;
+   while ( nextfound != std::string::npos ) {
+      oss << nextfound - found ;
+      oss << to_encode[ found ] ;
+      found = nextfound ;
+      nextfound = to_encode.find_first_not_of( to_encode[ found ] , found ) ;
+   }
+   //since we must not discard the last characters we add them at the end of the string
+   std::string rest ( to_encode.substr( found ) ) ;//last run of characters starts at position found
+   oss << rest.length( ) << to_encode[ found ] ;
+   return oss.str( ) ;
+}
+
+std::string decode ( const std::string & to_decode ) {
+   boost::regex e ( "(\\d+)(\\w)" ) ;
+   boost::match_results<std::string::const_iterator> matches ;
+   std::ostringstream oss ;
+   std::string::const_iterator start = to_decode.begin( ) , end = to_decode.end( ) ;
+   while ( boost::regex_search ( start , end , matches , e ) ) {
+      std::string numberstring ( matches[ 1 ].first , matches[ 1 ].second ) ;
+      int number = atoi( numberstring.c_str( ) ) ;
+      std::string character ( matches[ 2 ].first , matches[ 2 ].second ) ;
+      for ( int i = 0 ; i < number ; i++ )
+	 oss << character ;
+      start = matches[ 2 ].second ;
+   }
+   return oss.str( ) ;
+}

Task/Run-length-encoding/C-sharp/run-length-encoding-1.cs

@@ -0,0 +1,37 @@
+using System.Collections.Generic;
+using System.Linq;
+using static System.Console;
+using static System.Linq.Enumerable;
+
+namespace RunLengthEncoding
+{
+    static class Program
+    {
+          public static string Encode(string input) => input.Length ==0 ? "" : input.Skip(1)
+            .Aggregate((t:input[0].ToString(),o:Empty<string>()),
+               (a,c)=>a.t[0]==c ? (a.t+c,a.o) : (c.ToString(),a.o.Append(a.t)),
+               a=>a.o.Append(a.t).Select(p => (key: p.Length, chr: p[0])))
+            .Select(p=> $"{p.key}{p.chr}")
+            .StringConcat();
+
+        public static string Decode(string input) => input
+            .Aggregate((t: "", o: Empty<string>()), (a, c) => !char.IsDigit(c) ? ("", a.o.Append(a.t+c)) : (a.t + c,a.o)).o
+            .Select(p => new string(p.Last(), int.Parse(string.Concat(p.Where(char.IsDigit)))))
+            .StringConcat();
+
+        private static string StringConcat(this IEnumerable<string> seq) => string.Concat(seq);
+
+        public static void Main(string[] args)
+        {
+            const string  raw = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+            const string encoded = "12W1B12W3B24W1B14W";
+
+            WriteLine($"raw = {raw}");
+            WriteLine($"encoded = {encoded}");
+            WriteLine($"Encode(raw) = encoded = {Encode(raw)}");
+            WriteLine($"Decode(encode) = {Decode(encoded)}");
+            WriteLine($"Decode(Encode(raw)) = {Decode(Encode(raw)) == raw}");
+            ReadLine();
+        }
+    }
+}

Task/Run-length-encoding/C-sharp/run-length-encoding-2.cs

@@ -0,0 +1,30 @@
+using System.Collections.Generic;
+using System.Linq;
+using static System.Console;
+namespace RunLengthEncoding
+{
+    static class Program
+    {
+         public static string Encode(string input) => input.Length ==0 ? "" : input.Skip(1)
+            .Aggregate((t:input[0].ToString(),o:Empty<string>()),
+               (a,c)=>a.t[0]==c ? (a.t+c,a.o) : (c.ToString(),a.o.Append(a.t)),
+               a=>a.o.Append(a.t).Select(p => (key: p.Length, chr: p[0])));
+
+        public static string Decode(IEnumerable<(int i , char c)> input) =>
+            string.Concat(input.Select(t => new string(t.c, t.i)));
+
+        public static void Main(string[] args)
+        {
+            const string  raw = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+            var encoded = new[] { (12, 'W'), (1, 'B'), (12, 'W'), (3, 'B'), (24, 'W'), (1, 'B'), (14, 'W') };
+
+            WriteLine($"raw = {raw}");
+            WriteLine($"Encode(raw) = encoded = {Encode(raw).TupleListToString()}");
+            WriteLine($"Decode(encoded) = {Decode(encoded)}");
+            WriteLine($"Decode(Encode(raw)) = {Decode(Encode(raw)) == raw}");
+            ReadLine();
+        }
+        private static string TupleListToString(this IEnumerable<(int i, char c)> list) =>
+            string.Join(",", list.Select(t => $"[{t.i},{t.c}]"));
+    }
+}

Task/Run-length-encoding/C-sharp/run-length-encoding-3.cs

@@ -0,0 +1,36 @@
+using System.Collections.Generic;
+using System.Linq;
+using static System.Console;
+using static System.Text;
+
+namespace RunLengthEncoding
+{
+    static class Program
+    {
+         public static string Encode(string input) => input.Length == 0 ? "" : input.Skip(1)
+          .Aggregate((len: 1, chr: input[0], sb: new StringBuilder()),
+             (a, c) => a.chr == c ? (a.len + 1, a.chr, a.sb)
+                                  : (1, c, a.sb.Append(a.len).Append(a.chr))),
+             a => a.sb.Append(a.len).Append(a.chr)))
+          .ToString();
+
+         public static string Decode(string input) => input
+           .Aggregate((t: "", sb: new StringBuilder()),
+             (a, c) => !char.IsDigit(c) ? ("", a.sb.Append(new string(c, int.Parse(a.t))))
+                                        : (a.t + c, a.sb))
+           .sb.ToString();
+
+        public static void Main(string[] args)
+        {
+            const string  raw = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+            const string encoded = "12W1B12W3B24W1B14W";
+
+            WriteLine($"raw = {raw}");
+            WriteLine($"encoded = {encoded}");
+            WriteLine($"Encode(raw) = encoded = {Encode(raw)}");
+            WriteLine($"Decode(encode) = {Decode(encoded)}");
+            WriteLine($"Decode(Encode(raw)) = {Decode(Encode(raw)) == raw}");
+            ReadLine();
+        }
+    }
+}

Task/Run-length-encoding/C-sharp/run-length-encoding-4.cs

@@ -0,0 +1,49 @@
+       public static void Main(string[] args)
+       {
+           string input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+           Console.WriteLine(Encode(input));//Outputs: 12W1B12W3B24W1B14W
+           Console.WriteLine(Decode(Encode(input)));//Outputs: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
+           Console.ReadLine();
+       }
+       public static string Encode(string s)
+       {
+           StringBuilder sb = new StringBuilder();
+           int count = 1;
+           char current =s[0];
+           for(int i = 1; i < s.Length;i++)
+           {
+               if (current == s[i])
+               {
+                   count++;
+               }
+               else
+               {
+                   sb.AppendFormat("{0}{1}", count, current);
+                   count = 1;
+                   current = s[i];
+               }
+           }
+           sb.AppendFormat("{0}{1}", count, current);
+           return sb.ToString();
+       }
+       public static string Decode(string s)
+       {
+           string a = "";
+           int count = 0;
+           StringBuilder sb = new StringBuilder();
+           char current = char.MinValue;
+           for(int i = 0; i < s.Length; i++)
+           {
+               current = s[i];
+               if (char.IsDigit(current))
+                   a += current;
+               else
+               {
+                   count = int.Parse(a);
+                   a = "";
+                   for (int j = 0; j < count; j++)
+                       sb.Append(current);
+               }
+           }
+           return sb.ToString();
+       }

Task/Run-length-encoding/C-sharp/run-length-encoding-5.cs

@@ -0,0 +1,37 @@
+using System;
+using System.Text.RegularExpressions;
+
+public class Program
+{
+    private delegate void fOk(bool ok, string message);
+
+    public static int Main(string[] args)
+    {
+        const string raw = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+        const string code = "12W1B12W3B24W1B14W";
+
+        fOk Ok = delegate(bool ok, string message)
+        {
+            Console.WriteLine("{0}: {1}", ok ? "ok" : "not ok", message);
+        };
+        Ok(code.Equals(Encode(raw)), "Encode");
+        Ok(raw.Equals(Decode(code)), "Decode");
+        return 0;
+    }
+
+    public static string Encode(string input)
+    {
+        return Regex.Replace(input, @"(.)\1*", delegate(Match m)
+        {
+            return string.Concat(m.Value.Length, m.Groups[1].Value);
+        });
+    }
+
+    public static string Decode(string input)
+    {
+        return Regex.Replace(input, @"(\d+)(\D)", delegate(Match m)
+        {
+            return new string(m.Groups[2].Value[0], int.Parse(m.Groups[1].Value));
+        });
+    }
+}

Task/Run-length-encoding/C/run-length-encoding.c

@@ -0,0 +1,147 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+typedef struct stream_t stream_t, *stream;
+struct stream_t {
+	/* get function is supposed to return a byte value (0-255),
+		or -1 to signify end of input */
+	int (*get)(stream);
+	/* put function does output, one byte at a time */
+	int (*put)(stream, int);
+};
+
+/* next two structs inherit from stream_t */
+typedef struct {
+	int (*get)(stream);
+	int (*put)(stream, int);
+	char *string;
+	int pos;
+} string_stream;
+
+typedef struct {
+	int (*get)(stream);
+	int (*put)(stream, int);
+	FILE *fp;
+} file_stream;
+
+/* methods for above streams */
+int sget(stream in)
+{
+	int c;
+	string_stream* s = (string_stream*) in;
+	c = (unsigned char)(s->string[s->pos]);
+	if (c == '\0') return -1;
+	s->pos++;
+	return c;
+}
+
+int sput(stream out, int c)
+{
+	string_stream* s = (string_stream*) out;
+	s->string[s->pos++] = (c == -1) ? '\0' : c;
+	if (c == -1) s->pos = 0;
+	return 0;
+}
+
+int file_put(stream out, int c)
+{
+	file_stream *f = (file_stream*) out;
+	return fputc(c, f->fp);
+}
+
+/* helper function */
+void output(stream out, unsigned char* buf, int len)
+{
+	int i;
+	out->put(out, 128 + len);
+	for (i = 0; i < len; i++)
+		out->put(out, buf[i]);
+}
+
+/* Specification: encoded stream are unsigned bytes consisting of sequences.
+ * First byte of each sequence is the length, followed by a number of bytes.
+ * If length <=128, the next byte is to be repeated length times;
+ * If length > 128, the next (length - 128) bytes are not repeated.
+ * this is to improve efficiency for long non-repeating sequences.
+ * This scheme can encode arbitrary byte values efficiently.
+ * c.f. Adobe PDF spec RLE stream encoding (not exactly the same)
+ */
+void encode(stream in, stream out)
+{
+	unsigned char buf[256];
+	int len = 0, repeat = 0, end = 0, c;
+	int (*get)(stream) = in->get;
+	int (*put)(stream, int) = out->put;
+
+	while (!end) {
+		end = ((c = get(in)) == -1);
+		if (!end) {
+			buf[len++] = c;
+			if (len <= 1) continue;
+		}
+
+		if (repeat) {
+			if (buf[len - 1] != buf[len - 2])
+				repeat = 0;
+			if (!repeat || len == 129 || end) {
+				/* write out repeating bytes */
+				put(out, end ? len : len - 1);
+				put(out, buf[0]);
+				buf[0] = buf[len - 1];
+				len = 1;
+			}
+		} else {
+			if (buf[len - 1] == buf[len - 2]) {
+				repeat = 1;
+				if (len > 2) {
+					output(out, buf, len - 2);
+					buf[0] = buf[1] = buf[len - 1];
+					len = 2;
+				}
+				continue;
+			}
+			if (len == 128 || end) {
+				output(out, buf, len);
+				len = 0;
+				repeat = 0;
+			}
+		}
+	}
+	put(out, -1);
+}
+
+void decode(stream in, stream out)
+{
+	int c, i, cnt;
+	while (1) {
+		c = in->get(in);
+		if (c == -1) return;
+		if (c > 128) {
+			cnt = c - 128;
+			for (i = 0; i < cnt; i++)
+				out->put(out, in->get(in));
+		} else {
+			cnt = c;
+			c = in->get(in);
+			for (i = 0; i < cnt; i++)
+				out->put(out, c);
+		}
+	}
+}
+
+int main()
+{
+	char buf[256];
+	string_stream str_in = { sget, 0,
+		"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW", 0};
+	string_stream str_out = { sget, sput, buf, 0 };
+	file_stream file = { 0, file_put, stdout };
+
+	/* encode from str_in to str_out */
+	encode((stream)&str_in, (stream)&str_out);
+
+	/* decode from str_out to file (stdout) */
+	decode((stream)&str_out, (stream)&file);
+
+	return 0;
+}

Task/Run-length-encoding/COBOL/run-length-encoding.cobol

@@ -0,0 +1,124 @@
+       >>SOURCE FREE
+IDENTIFICATION DIVISION.
+PROGRAM-ID. run-length-encoding.
+
+ENVIRONMENT DIVISION.
+CONFIGURATION SECTION.
+REPOSITORY.
+    FUNCTION encode
+    FUNCTION decode
+    .
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01  input-str                           PIC A(100).
+01  encoded                             PIC X(200).
+01  decoded                             PIC X(200).
+
+PROCEDURE DIVISION.
+    ACCEPT input-str
+    MOVE encode(FUNCTION TRIM(input-str)) TO encoded
+    DISPLAY "Encoded: " FUNCTION TRIM(encoded)
+    DISPLAY "Decoded: " FUNCTION TRIM(decode(encoded))
+    .
+END PROGRAM run-length-encoding.
+
+
+IDENTIFICATION DIVISION.
+FUNCTION-ID. encode.
+
+DATA DIVISION.
+LOCAL-STORAGE SECTION.
+01  str-len                             PIC 9(3) COMP.
+
+01  i                                   PIC 9(3) COMP.
+
+01  current-char                        PIC A.
+
+01  num-chars                           PIC 9(3) COMP.
+01  num-chars-disp                      PIC Z(3).
+
+01  encoded-pos                         PIC 9(3) COMP VALUE 1.
+
+LINKAGE SECTION.
+01  str                                 PIC X ANY LENGTH.
+
+01  encoded                             PIC X(200).
+
+PROCEDURE DIVISION USING str RETURNING encoded.
+    MOVE FUNCTION LENGTH(str) TO str-len
+    MOVE str (1:1) TO current-char
+    MOVE 1 TO num-chars
+    PERFORM VARYING i FROM 2 BY 1 UNTIL i > str-len
+        IF str (i:1) <> current-char
+            CALL "add-num-chars" USING encoded, encoded-pos,
+                CONTENT current-char, num-chars
+
+            MOVE str (i:1) TO current-char
+            MOVE 1 TO num-chars
+        ELSE
+            ADD 1 TO num-chars
+        END-IF
+    END-PERFORM
+
+    CALL "add-num-chars" USING encoded, encoded-pos, CONTENT current-char,
+        num-chars
+    .
+END FUNCTION encode.
+
+IDENTIFICATION DIVISION.
+PROGRAM-ID. add-num-chars.
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01  num-chars-disp                      PIC Z(3).
+
+LINKAGE SECTION.
+01  str                                 PIC X(200).
+
+01  current-pos                         PIC 9(3) COMP.
+
+01  char-to-encode                      PIC X.
+
+01  num-chars                           PIC 9(3) COMP.
+
+PROCEDURE DIVISION USING str, current-pos, char-to-encode, num-chars.
+    MOVE num-chars TO num-chars-disp
+    MOVE FUNCTION TRIM(num-chars-disp) TO str (current-pos:3)
+    ADD FUNCTION LENGTH(FUNCTION TRIM(num-chars-disp)) TO current-pos
+    MOVE char-to-encode TO str (current-pos:1)
+    ADD 1 TO current-pos
+    .
+END PROGRAM add-num-chars.
+
+
+IDENTIFICATION DIVISION.
+FUNCTION-ID. decode.
+
+DATA DIVISION.
+LOCAL-STORAGE SECTION.
+01  encoded-pos                         PIC 9(3) COMP VALUE 1.
+01  decoded-pos                         PIC 9(3) COMP VALUE 1.
+
+01  num-of-char                         PIC 9(3) COMP VALUE 0.
+
+LINKAGE SECTION.
+01  encoded                             PIC X(200).
+
+01  decoded                             PIC X(100).
+
+PROCEDURE DIVISION USING encoded RETURNING decoded.
+    PERFORM VARYING encoded-pos FROM 1 BY 1
+            UNTIL encoded (encoded-pos:2) = SPACES OR encoded-pos > 200
+        IF encoded (encoded-pos:1) IS NUMERIC
+            COMPUTE num-of-char = num-of-char * 10
+                + FUNCTION NUMVAL(encoded (encoded-pos:1))
+        ELSE
+            PERFORM UNTIL num-of-char = 0
+                MOVE encoded (encoded-pos:1) TO decoded (decoded-pos:1)
+                ADD 1 TO decoded-pos
+                SUBTRACT 1 FROM num-of-char
+            END-PERFORM
+        END-IF
+    END-PERFORM
+    .
+END FUNCTION decode.

Task/Run-length-encoding/Ceylon/run-length-encoding.ceylon

@@ -0,0 +1,31 @@
+shared void run() {
+
+    "Takes a string such as aaaabbbbbbcc and returns 4a6b2c"
+    String compress(String string) {
+        if (exists firstChar = string.first) {
+            if (exists index = string.firstIndexWhere((char) => char != firstChar)) {
+                return "``index````firstChar````compress(string[index...])``";
+            }
+            else {
+                return "``string.size````firstChar``";
+            }
+        }
+        else {
+            return "";
+        }
+    }
+
+    "Takes a string such as 4a6b2c and returns aaaabbbbbbcc"
+    String decompress(String string) =>
+            let (runs = string.split(Character.letter, false).paired)
+    		"".join {
+        		for ([length, char] in runs)
+        		if (is Integer int = Integer.parse(length))
+        		char.repeat(int)
+        	};
+
+    assert (compress("aaaabbbbbaa") == "4a5b2a");
+    assert (decompress("4a6b2c") == "aaaabbbbbbcc");
+    assert (compress("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") == "12W1B12W3B24W1B14W");
+    assert (decompress("24a") == "aaaaaaaaaaaaaaaaaaaaaaaa");
+}

Task/Run-length-encoding/Clojure/run-length-encoding.clj

@@ -0,0 +1,7 @@
+(defn compress [s]
+  (->> (partition-by identity s) (mapcat (juxt count first)) (apply str)))
+
+(defn extract [s]
+  (->> (re-seq #"(\d+)([A-Z])" s)
+       (mapcat (fn [[_ n ch]] (repeat (Integer/parseInt n) ch)))
+       (apply str)))

Task/Run-length-encoding/CoffeeScript/run-length-encoding-1.coffee

@@ -0,0 +1,11 @@
+encode = (str) ->
+    str.replace /(.)\1*/g, (w) ->
+        w[0] + w.length
+
+decode = (str) ->
+    str.replace /(.)(\d+)/g, (m,w,n) ->
+        new Array(+n+1).join(w)
+
+console.log s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+console.log encode s
+console.log decode encode s

Task/Run-length-encoding/CoffeeScript/run-length-encoding-2.coffee

@@ -0,0 +1,8 @@
+encode = (str, offset = 75) ->
+    str.replace /(.)\1*/g, (w) ->
+        w[0] + String.fromCharCode(offset+w.length)
+
+decode = (str, offset = 75) ->
+    str.split('').map((w,i) ->
+        if not (i%2) then w else new Array(+w.charCodeAt(0)-offset).join(str[i-1])
+    ).join('')

Task/Run-length-encoding/Common-Lisp/run-length-encoding.lisp

@@ -0,0 +1,23 @@
+(defun group-similar (sequence &key (test 'eql))
+  (loop for x in (rest sequence)
+        with temp = (subseq sequence 0 1)
+        if (funcall test (first temp) x)
+          do (push x temp)
+        else
+          collect temp
+          and do (setf temp (list x))))
+
+(defun run-length-encode (sequence)
+  (mapcar (lambda (group) (list (first group) (length group)))
+          (group-similar (coerce sequence 'list))))
+
+(defun run-length-decode (sequence)
+  (reduce (lambda (s1 s2) (concatenate 'simple-string s1 s2))
+          (mapcar (lambda (elem)
+                    (make-string (second elem)
+                                 :initial-element
+                                 (first elem)))
+                  sequence)))
+
+(run-length-encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
+(run-length-decode '((#\W 12) (#\B 1) (#\W 12) (#\B 3) (#\W 24) (#\B 1)))

Task/Run-length-encoding/D/run-length-encoding-1.d

@@ -0,0 +1,13 @@
+import std.algorithm, std.array;
+
+alias encode = group;
+
+auto decode(Group!("a == b", string) enc) {
+    return enc.map!(t => [t[0]].replicate(t[1])).join;
+}
+
+void main() {
+    immutable s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWW" ~
+                  "WWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+    assert(s.encode.decode.equal(s));
+}

Task/Run-length-encoding/D/run-length-encoding-2.d

@@ -0,0 +1,53 @@
+import std.stdio, std.array, std.conv;
+
+// Similar to the 'look and say' function.
+string encode(in string input) pure nothrow @safe {
+    if (input.empty)
+        return input;
+    char last = input[$ - 1];
+    string output;
+    int count;
+
+    foreach_reverse (immutable c; input) {
+        if (c == last) {
+            count++;
+        } else {
+            output = count.text ~ last ~ output;
+            count = 1;
+            last = c;
+        }
+    }
+
+    return count.text ~ last ~ output;
+}
+
+string decode(in string input) pure /*@safe*/ {
+    string i, result;
+
+    foreach (immutable c; input)
+        switch (c) {
+            case '0': .. case '9':
+                i ~= c;
+                break;
+            case 'A': .. case 'Z':
+                if (i.empty)
+                    throw new Exception("Can not repeat a letter " ~
+                        "without a number of repetitions");
+                result ~= [c].replicate(i.to!int);
+                i.length = 0;
+                break;
+            default:
+                throw new Exception("'" ~ c ~ "' is not alphanumeric");
+        }
+
+    return result;
+}
+
+void main() {
+    immutable txt = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWW" ~
+                    "WWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+    writeln("Input: ", txt);
+    immutable encoded = txt.encode;
+    writeln("Encoded: ", encoded);
+    assert(txt == encoded.decode);
+}

Task/Run-length-encoding/D/run-length-encoding-3.d

@@ -0,0 +1,79 @@
+import std.stdio, std.conv, std.utf, std.array;
+import vlq;
+
+struct RLE { // for utf string
+    ubyte[] encoded;
+
+    RLE encode(const string s) {
+        validate(s); // check if s is well-formed utf, throw if not
+        encoded.length = 0; // reset
+        if (s.length == 0) return this; // empty string
+        string last;
+        VLQ count;
+        for (int i = 0; i < s.length; ) {
+            auto k = s.stride(i);
+            auto ucode = cast(string)s[i .. i + k];
+            if (i == 0) last = ucode;
+            if (ucode == last)
+                count++;
+            else {
+                encoded ~= count.toVLQ ~ cast(ubyte[])last;
+                last = ucode;
+                count = 1;
+            }
+            i += k;
+        }
+        encoded ~= VLQ(count).toVLQ ~ cast(ubyte[])last;
+        return this;
+    }
+
+    int opApply(int delegate(ref ulong c, ref string u) dg) {
+        VLQ count;
+        string ucode;
+
+        for (int i = 0; i < encoded.length; ) {
+            auto k = count.extract(encoded[i .. $]);
+            i += k;
+            if (i >= encoded.length)
+                throw new Exception("not valid encoded string");
+            k = stride(cast(string) encoded[i .. $], 0);
+            if (k == 0xff) // not valid utf code point
+                throw new Exception("not valid encoded string");
+            ucode = cast(string)encoded[i .. i + k].dup;
+            dg(count.value, ucode);
+            i += k;
+        }
+
+        return 0;
+    }
+
+    string toString() {
+        string res;
+        foreach (ref i, s ; this)
+            if (indexOf("0123456789#", s) == -1)
+                res ~= text(i) ~ s;
+            else
+                res ~= text(i) ~ '#' ~ s;
+        return res;
+    }
+
+    string decode() {
+        string res;
+        foreach (ref i, s; this)
+            res ~= replicate(s, cast(uint)i);
+        return res;
+    }
+}
+
+void main() {
+    RLE r;
+    auto s = "尋尋覓覓冷冷清清淒淒慘慘戚戚\nWWWWWWWWWWWWBWWWWWWWWWWW" ~
+             "WBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW\n" ~
+             "11#222##333";
+    auto f = File("display.txt", "w");
+    f.writeln(s);
+    r.encode(s);
+    f.writefln("-----\n%s\n-----\n%s", r, r.decode());
+    auto sEncoded = RLE.init.encode(s).encoded ;
+    assert(s == RLE(sEncoded).decode(), "Not work");
+}

Task/Run-length-encoding/D/run-length-encoding-4.d

@@ -0,0 +1,32 @@
+import std.stdio, std.conv, std.array, std.regex, std.utf,
+       std.algorithm;
+
+string reEncode(string s) {
+    validate(s); // Throw if it's not a well-formed UTF string
+    static string rep(Captures!string m) {
+        auto c = canFind("0123456789#", m[1]) ? "#" ~ m[1] : m[1];
+        return text(m.hit.length / m[1].length) ~ c;
+    }
+    return std.regex.replace!rep(s, regex(`(.|[\n\r\f])\1*`, "g"));
+}
+
+
+string reDecode(string s) {
+    validate(s); // Throw if it's not a well-formed UTF string
+    static string rep(Captures!string m) {
+        string c = m[2];
+        if (c.length > 1 && c[0] == '#')
+            c = c[1 .. $];
+        return replicate(c, to!int(m[1]));
+    }
+    auto r=regex(`(\d+)(#[0123456789#]|[\n\r\f]|[^0123456789#\n\r\f]+)`
+                 , "g");
+    return std.regex.replace!rep(s, r);
+}
+
+void main() {
+    auto s = "尋尋覓覓冷冷清清淒淒慘慘戚戚\nWWWWWWWWWWWWBWWWWWWWWWWW" ~
+             "WBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW\n" ~
+             "11#222##333";
+    assert(s == reDecode(reEncode(s)));
+}

Task/Run-length-encoding/Delphi/run-length-encoding.delphi

@@ -0,0 +1,96 @@
+program RunLengthTest;
+
+{$APPTYPE CONSOLE}
+
+uses
+  System.SysUtils;
+
+type
+  TRLEPair = record
+    count: Integer;
+    letter: Char;
+  end;
+
+  TRLEncoded = TArray<TRLEPair>;
+
+  TRLEncodedHelper = record helper for TRLEncoded
+  public
+    procedure Clear;
+    function Add(c: Char): Integer;
+    procedure Encode(Data: string);
+    function Decode: string;
+    function ToString: string;
+  end;
+
+{ TRLEncodedHelper }
+
+function TRLEncodedHelper.Add(c: Char): Integer;
+begin
+  SetLength(self, length(self) + 1);
+  Result := length(self) - 1;
+  with self[Result] do
+  begin
+    count := 1;
+    letter := c;
+  end;
+end;
+
+procedure TRLEncodedHelper.Clear;
+begin
+  SetLength(self, 0);
+end;
+
+function TRLEncodedHelper.Decode: string;
+var
+  p: TRLEPair;
+begin
+  Result := '';
+  for p in Self do
+    Result := Result + string.Create(p.letter, p.count);
+end;
+
+procedure TRLEncodedHelper.Encode(Data: string);
+var
+  pivot: Char;
+  i, index: Integer;
+begin
+  Clear;
+  if Data.Length = 0 then
+    exit;
+
+  pivot := Data[1];
+  index := Add(pivot);
+
+  for i := 2 to Data.Length do
+  begin
+    if pivot = Data[i] then
+      inc(self[index].count)
+    else
+    begin
+      pivot := Data[i];
+      index := Add(pivot);
+    end;
+  end;
+end;
+
+function TRLEncodedHelper.ToString: string;
+var
+  p: TRLEPair;
+begin
+  Result := '';
+  for p in Self do
+    Result := Result + p.count.ToString + p.letter;
+end;
+
+const
+  Input = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW';
+
+var
+  Data: TRLEncoded;
+
+begin
+  Data.Encode(Input);
+  Writeln(Data.ToString);
+  writeln(Data.Decode);
+  Readln;
+end.

Task/Run-length-encoding/E/run-length-encoding-1.e

@@ -0,0 +1,28 @@
+def rle(string) {
+  var seen := null
+  var count := 0
+  var result := []
+  def put() {
+    if (seen != null) {
+      result with= [count, seen]
+    }
+  }
+  for ch in string {
+    if (ch != seen) {
+      put()
+      seen := ch
+      count := 0
+    }
+    count += 1
+  }
+  put()
+  return result
+}
+
+def unrle(coded) {
+  var result := ""
+  for [count, ch] in coded {
+    result += E.toString(ch) * count
+  }
+  return result
+}

Task/Run-length-encoding/E/run-length-encoding-2.e

@@ -0,0 +1,5 @@
+? rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
+# value: [[12, 'W'], [1, 'B'], [12, 'W'], [3, 'B'], [24, 'W'], [1, 'B'], [14, 'W']]
+
+? unrle(rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"))
+# value: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"

Task/Run-length-encoding/EasyLang/run-length-encoding.easy

@@ -0,0 +1,33 @@
+proc enc in$ . out$ .
+   out$ = ""
+   for c$ in strchars in$
+      if c$ = c0$
+         cnt += 1
+      else
+         if cnt > 0
+            out$ &= cnt & c0$ & " "
+         .
+         c0$ = c$
+         cnt = 1
+      .
+   .
+   out$ &= cnt & c0$
+.
+proc dec in$ . out$ .
+   out$ = ""
+   for h$ in strsplit in$ " "
+      c$ = substr h$ len h$ 1
+      for i to number h$
+         out$ &= c$
+      .
+   .
+.
+s$ = input
+print s$
+call enc s$ s$
+print s$
+call dec s$ s$
+print s$
+#
+input_data
+WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW

Task/Run-length-encoding/Elena/run-length-encoding.elena

@@ -0,0 +1,66 @@
+import system'text;
+import system'routines;
+import extensions;
+import extensions'text;
+
+singleton compressor
+{
+    string compress(string s)
+    {
+        auto  tb := new TextBuilder();
+        int count := 0;
+        char current := s[0];
+        s.forEach:(ch)
+        {
+            if (ch == current)
+            {
+                count += 1
+            }
+            else
+            {
+                tb.writeFormatted("{0}{1}",count,current);
+                count := 1;
+                current := ch
+            }
+        };
+
+        tb.writeFormatted("{0}{1}",count,current);
+
+        ^ tb
+    }
+
+    string decompress(string s)
+    {
+        auto tb := new TextBuilder();
+        char current := $0;
+        var a := new StringWriter();
+        s.forEach:(ch)
+        {
+            current := ch;
+            if (current.isDigit())
+            {
+                a.append(ch)
+            }
+            else
+            {
+                int count := a.toInt();
+                a.clear();
+
+                tb.fill(current,count)
+            }
+        };
+
+        ^ tb
+    }
+}
+
+public program()
+{
+    var s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
+
+    s := compressor.compress(s);
+    console.printLine(s);
+
+    s := compressor.decompress(s);
+    console.printLine(s)
+}

Task/Run-length-encoding/Elixir/run-length-encoding.elixir

@@ -0,0 +1,27 @@
+defmodule Run_length do
+  def encode(str) when is_bitstring(str) do
+    to_char_list(str) |> encode |> to_string
+  end
+  def encode(list) when is_list(list) do
+    Enum.chunk_by(list, &(&1))
+    |> Enum.flat_map(fn chars -> to_char_list(length(chars)) ++ [hd(chars)] end)
+  end
+
+  def decode(str) when is_bitstring(str) do
+    Regex.scan(~r/(\d+)(.)/, str)
+    |> Enum.map_join(fn [_,n,c] -> String.duplicate(c, String.to_integer(n)) end)
+  end
+  def decode(list) when is_list(list) do
+    to_string(list) |> decode |> to_char_list
+  end
+end
+
+text = [ string:    "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
+         char_list: 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' ]
+
+Enum.each(text, fn {type, txt} ->
+  IO.puts type
+  txt                  |> IO.inspect
+  |> Run_length.encode |> IO.inspect
+  |> Run_length.decode |> IO.inspect
+end)

Task/Run-length-encoding/Emacs-Lisp/run-length-encoding-1.l

@@ -0,0 +1,10 @@
+(defun run-length-encode (str)
+  (let (output)
+    (with-temp-buffer
+      (insert str)
+      (goto-char (point-min))
+      (while (not (eobp))
+        (let* ((char (char-after (point)))
+               (count (skip-chars-forward (string char))))
+          (push (format "%d%c" count char) output))))
+    (mapconcat #'identity (nreverse output) "")))

Task/Run-length-encoding/Emacs-Lisp/run-length-encoding-2.l

@@ -0,0 +1,7 @@
+(require 'seq)
+
+(defun run-length-encode (str)
+  (let ((grouped (mapcar #'cdr (seq-group-by #'identity (string-to-list str)))))
+    (apply #'concat (mapcar (lambda (items)
+                              (format "%d%c" (length items) (car items)))
+                            grouped))))

Task/Run-length-encoding/Erlang/run-length-encoding-1.erl

@@ -0,0 +1,46 @@
+-module(rle).
+
+-export([encode/1,decode/1]).
+
+-include_lib("eunit/include/eunit.hrl").
+
+encode(S) ->
+    doEncode(string:substr(S, 2), string:substr(S, 1, 1), 1, []).
+
+doEncode([], CurrChar, Count, R) ->
+    R ++ integer_to_list(Count) ++ CurrChar;
+doEncode(S, CurrChar, Count, R) ->
+    NextChar = string:substr(S, 1, 1),
+    if
+        NextChar == CurrChar ->
+            doEncode(string:substr(S, 2), CurrChar, Count + 1, R);
+        true ->
+            doEncode(string:substr(S, 2), NextChar, 1,
+                R ++ integer_to_list(Count) ++ CurrChar)
+    end.
+
+decode(S) ->
+    doDecode(string:substr(S, 2), string:substr(S, 1, 1), []).
+
+doDecode([], _, R) ->
+    R;
+doDecode(S, CurrString, R) ->
+    NextChar = string:substr(S, 1, 1),
+    IsInt = erlang:is_integer(catch(erlang:list_to_integer(NextChar))),
+    if
+        IsInt ->
+            doDecode(string:substr(S, 2), CurrString ++ NextChar, R);
+        true ->
+            doDecode(string:substr(S, 2), [],
+                R ++ string:copies(NextChar, list_to_integer(CurrString)))
+    end.
+
+rle_test_() ->
+    PreEncoded =
+        "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
+    Expected = "12W1B12W3B24W1B14W",
+    [
+        ?_assert(encode(PreEncoded) =:= Expected),
+        ?_assert(decode(Expected) =:= PreEncoded),
+        ?_assert(decode(encode(PreEncoded)) =:= PreEncoded)
+    ].

Task/Run-length-encoding/Erlang/run-length-encoding-2.erl

@@ -0,0 +1,20 @@
+-module(rle).
+
+-export([encode/1, decode/1]).
+
+encode(L) -> encode(L, []).
+encode([], Acc) -> {rle, lists:reverse(Acc)};
+encode([H|T], []) ->
+    encode(T, [{1, H}]);
+encode([H|T], [{Count, Char}|AT]) ->
+    if
+        H =:= Char ->
+            encode(T, [{Count + 1, Char}|AT]);
+        true ->
+            encode(T, [{1, H}|[{Count, Char}|AT]])
+    end.
+
+decode({rle, L}) -> lists:append(lists:reverse(decode(L, []))).
+decode([], Acc) -> Acc;
+decode([{Count, Char}|T], Acc) ->
+    decode(T, [[Char || _ <- lists:seq(1, Count)]|Acc]).

Task/Run-length-encoding/Euphoria/run-length-encoding.euphoria

@@ -0,0 +1,38 @@
+include misc.e
+
+function encode(sequence s)
+    sequence out
+    integer prev_char,count
+    if length(s) = 0 then
+        return {}
+    end if
+    out = {}
+    prev_char = s[1]
+    count = 1
+    for i = 2 to length(s) do
+        if s[i] != prev_char then
+            out &= {count,prev_char}
+            prev_char = s[i]
+            count = 1
+        else
+            count += 1
+        end if
+    end for
+    out &= {count,prev_char}
+    return out
+end function
+
+function decode(sequence s)
+    sequence out
+    out = {}
+    for i = 1 to length(s) by 2 do
+        out &= repeat(s[i+1],s[i])
+    end for
+    return out
+end function
+
+sequence s
+s = encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
+pretty_print(1,s,{3})
+puts(1,'\n')
+puts(1,decode(s))

Task/Run-length-encoding/F-Sharp/run-length-encoding.fs

@@ -0,0 +1,18 @@
+open System
+open System.Text.RegularExpressions
+
+let encode data =
+    // encodeData : seq<'T> -> seq<int * 'T> i.e. Takes a sequence of 'T types and return a sequence of tuples containing the run length and an instance of 'T.
+    let rec encodeData input =
+        seq { if not (Seq.isEmpty input) then
+                 let head = Seq.head input
+                 let runLength = Seq.length (Seq.takeWhile ((=) head) input)
+                 yield runLength, head
+                 yield! encodeData (Seq.skip runLength input) }
+
+    encodeData data |> Seq.fold(fun acc (len, d) -> acc + len.ToString() + d.ToString()) ""
+
+let decode str =
+    [ for m in Regex.Matches(str, "(\d+)(.)") -> m ]
+    |> List.map (fun m -> Int32.Parse(m.Groups.[1].Value), m.Groups.[2].Value)
+    |> List.fold (fun acc (len, s) -> acc + String.replicate len s) ""

Task/Run-length-encoding/FALSE/run-length-encoding-1.false

@@ -0,0 +1 @@
+1^[^$~][$@$@=$[%%\1+\$0~]?~[@.,1\$]?%]#%\.,  {encode}

Task/Run-length-encoding/FALSE/run-length-encoding-2.false

@@ -0,0 +1,2 @@
+[0[^$$'9>'0@>|~]['0-\10*+]#]n:
+[n;!$~][[\$][1-\$,]#%%]#%%                   {decode}

Task/Run-length-encoding/Factor/run-length-encoding.factor

@@ -0,0 +1,18 @@
+USING: io kernel literals math.parser math.ranges sequences
+sequences.extras sequences.repeating splitting.extras
+splitting.monotonic strings ;
+IN: rosetta-code.run-length-encoding
+
+CONSTANT: alpha $[ CHAR: A CHAR: Z [a,b] >string ]
+
+: encode ( str -- str )
+    [ = ] monotonic-split [ [ length number>string ] [ first ]
+    bi suffix ] map concat ;
+
+: decode ( str -- str )
+    alpha split* [ odd-indices ] [ even-indices
+    [ string>number ] map ] bi [ repeat ] 2map concat ;
+
+"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+"12W1B12W3B24W1B14W"
+[ encode ] [ decode ] bi* [ print ] bi@

Task/Run-length-encoding/Fan/run-length-encoding.fan

@@ -0,0 +1,47 @@
+**
+** 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}" }
+}

Task/Run-length-encoding/Forth/run-length-encoding-1.fth

@@ -0,0 +1,15 @@
+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 c@ 1 2swap 1 /string bounds ?do
+    over i c@ = if 1+
+    else n>a >a i c@ 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 c@ digit? if 10 * i c@ [char] 0 - + else
+    a @ over i c@ fill a +! 0 then
+  loop drop a @ over - ;

Task/Run-length-encoding/Forth/run-length-encoding-2.fth

@@ -0,0 +1,3 @@
+s" WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+here 1000 + encode here 2000 + decode cr 3 spaces type
+   WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW

Task/Run-length-encoding/Fortran/run-length-encoding.f

@@ -0,0 +1,59 @@
+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

Task/Run-length-encoding/FreeBASIC/run-length-encoding.basic

@@ -0,0 +1,54 @@
+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

Task/Run-length-encoding/Gambas/run-length-encoding.gambas

@@ -0,0 +1,23 @@
+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

Task/Run-length-encoding/Go/run-length-encoding.go

@@ -0,0 +1,71 @@
+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)
+}

Task/Run-length-encoding/Groovy/run-length-encoding-1.groovy

@@ -0,0 +1,15 @@
+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()
+}

Task/Run-length-encoding/Groovy/run-length-encoding-2.groovy

@@ -0,0 +1,7 @@
+def text = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
+def rleEncoded = rleEncode(text)
+assert rleEncoded == '12W1B12W3B24W1B14W'
+assert text == rleDecode(rleEncoded)
+
+println "Original Text: $text"
+println "Encoded Text: $rleEncoded"

Task/Run-length-encoding/Haskell/run-length-encoding-1.hs

@@ -0,0 +1,22 @@
+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

Task/Run-length-encoding/Haskell/run-length-encoding-2.hs

@@ -0,0 +1,26 @@
+import Data.Char (isDigit)
+import Data.List (group, groupBy)
+
+runLengthEncode :: String -> String
+runLengthEncode =
+  concatMap
+    ( \xs@(x : _) ->
+        ( show . length $ xs
+        )
+          <> [x]
+    )
+    . group
+
+runLengthDecode :: String -> String
+runLengthDecode =
+  concat . uncurry (zipWith (\[x] ns -> replicate (read ns) x))
+    . foldr (\z (x, y) -> (y, z : x)) ([], [])
+    . groupBy (\x y -> all isDigit [x, y])
+
+main :: IO ()
+main = do
+  let text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+      encode = runLengthEncode text
+      decode = runLengthDecode encode
+  mapM_ putStrLn [text, encode, decode]
+  putStrLn $ "test: text == decode => " <> show (text == decode)

Task/Run-length-encoding/Haskell/run-length-encoding-3.hs

@@ -0,0 +1,25 @@
+import Data.Char (isDigit)
+import Data.List (span)
+
+encode :: String -> String
+encode [] = []
+encode (x : xs) =
+  let (run, rest) = span (x ==) xs
+   in x : (show . succ . length) run <> encode rest
+
+decode :: String -> String
+decode [] = []
+decode (x : xs) =
+  let (ds, rest) = span isDigit xs
+      n = read ds :: Int
+   in replicate n x <> decode rest
+
+main :: IO ()
+main =
+  putStrLn encoded
+    >> putStrLn decoded
+    >> print (src == decoded)
+  where
+    src = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+    encoded = encode src
+    decoded = decode encoded

Task/Run-length-encoding/Haskell/run-length-encoding-4.hs

@@ -0,0 +1,26 @@
+----------------------- RUN LENGTHS ----------------------
+
+runLengths :: String -> [(Int, Char)]
+runLengths "" = []
+runLengths s = uncurry (:) (foldr go ((0, ' '), []) s)
+  where
+    go c ((0, _), xs) = ((1, c), xs)
+    go c ((n, x), xs)
+      | c == x = ((succ n, x), xs)
+      | otherwise = ((1, c), (n, x) : xs)
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = do
+  let testString =
+        "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWW"
+          <> "WWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+      encoded = runLengths testString
+  putStrLn $ showLengths encoded
+  print $
+    concatMap (uncurry replicate) encoded == testString
+
+------------------------- DISPLAY ------------------------
+showLengths :: [(Int, Char)] -> String
+showLengths [] = []
+showLengths ((n, c) : xs) = show n <> [c] <> showLengths xs

Task/Run-length-encoding/Icon/run-length-encoding.icon

@@ -0,0 +1,27 @@
+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

Task/Run-length-encoding/J/run-length-encoding-1.j

@@ -0,0 +1,2 @@
+rle=: ;@(<@(":@(#-.1:),{.);.1~ 1, 2 ~:/\ ])
+rld=: ;@(-.@e.&'0123456789' <@({:#~1{.@,~".@}:);.2 ])

Task/Run-length-encoding/J/run-length-encoding-2.j

@@ -0,0 +1,5 @@
+   rle 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
+12W1B12W3B24W1B14W
+
+   rld '12W1B12W3B24W1B14W'
+WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW

Task/Run-length-encoding/J/run-length-encoding-3.j

@@ -0,0 +1 @@
+rle=: ;@(<@(":@#,{.);.1~ 2 ~:/\ (a.{.@-.{.),])

Task/Run-length-encoding/J/run-length-encoding-4.j

@@ -0,0 +1,2 @@
+   torle=: (#, {.);.1~ 1,2 ~:/\ ]
+   frle=: #/@|:

Task/Run-length-encoding/J/run-length-encoding-5.j

@@ -0,0 +1,10 @@
+   torle a.i.'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
+12 87
+ 1 66
+12 87
+ 3 66
+24 87
+ 1 66
+14 87
+   u: frle torle a.i.'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
+WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW

Task/Run-length-encoding/Java/run-length-encoding-1.java

@@ -0,0 +1,2 @@
+import java.util.regex.Matcher;
+import java.util.regex.Pattern;

Task/Run-length-encoding/Java/run-length-encoding-2.java

@@ -0,0 +1,10 @@
+String encode(String string) {
+    Pattern pattern = Pattern.compile("(.)\\1*");
+    Matcher matcher = pattern.matcher(string);
+    StringBuilder encoded = new StringBuilder();
+    while (matcher.find()) {
+        encoded.append(matcher.group().length());
+        encoded.append(matcher.group().charAt(0));
+    }
+    return encoded.toString();
+}

Task/Run-length-encoding/Java/run-length-encoding-3.java

@@ -0,0 +1,11 @@
+String decode(String string) {
+    Pattern pattern = Pattern.compile("(\\d+)(.)");
+    Matcher matcher = pattern.matcher(string);
+    StringBuilder decoded = new StringBuilder();
+    int count;
+    while (matcher.find()) {
+        count = Integer.parseInt(matcher.group(1));
+        decoded.append(matcher.group(2).repeat(count));
+    }
+    return decoded.toString();
+}

Task/Run-length-encoding/Java/run-length-encoding-4.java

@@ -0,0 +1,38 @@
+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"));
+    }
+}

Task/Run-length-encoding/Java/run-length-encoding-5.java

@@ -0,0 +1,32 @@
+import static org.junit.Assert.assertEquals;
+
+import org.junit.Test;
+
+public class RunLengthEncodingTest {
+	private RLE = new RunLengthEncoding();
+
+	@Test
+	public void encodingTest() {
+		assertEquals("1W", RLE.encode("W"));
+		assertEquals("4W", RLE.encode("WWWW"));
+		assertEquals("5w4i7k3i6p5e4d2i1a",
+				RLE.encode("wwwwwiiiikkkkkkkiiippppppeeeeeddddiia"));
+		assertEquals("12B1N12B3N24B1N14B",
+				RLE.encode("BBBBBBBBBBBBNBBBBBBBBBBBBNNNBBBBBBBBBBBBBBBBBBBBBBBBNBBBBBBBBBBBBBB"));
+		assertEquals("12W1B12W3B24W1B14W",
+				RLE.encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"));
+		assertEquals("1W1B1W1B1W1B1W1B1W1B1W1B1W1B", RLE.encode("WBWBWBWBWBWBWB"));
+
+	}
+
+	@Test
+	public void decodingTest() {
+		assertEquals("W", RLE.decode("1W"));
+		assertEquals("WWWW", RLE.decode("4W"));
+		assertEquals("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
+				RLE.decode("12W1B12W3B24W1B14W"));
+		assertEquals("WBWBWBWBWBWBWB", RLE.decode("1W1B1W1B1W1B1W1B1W1B1W1B1W1B"));
+		assertEquals("WBWBWBWBWBWBWB", RLE.decode("1W1B1W1B1W1B1W1B1W1B1W1B1W1B"));
+
+	}
+}

Task/Run-length-encoding/JavaScript/run-length-encoding-1.js

@@ -0,0 +1,15 @@
+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;
+}

Task/Run-length-encoding/JavaScript/run-length-encoding-2.js

@@ -0,0 +1,5 @@
+function encode_re(input) {
+    var encoding = [];
+    input.match(/(.)\1*/g).forEach(function(substr){ encoding.push([substr.length, substr[0]]) });
+    return encoding;
+}

Task/Run-length-encoding/JavaScript/run-length-encoding-3.js

@@ -0,0 +1,5 @@
+function decode(encoded) {
+    var output = "";
+    encoded.forEach(function(pair){ output += new Array(1+pair[0]).join(pair[1]) })
+    return output;
+}

Task/Run-length-encoding/JavaScript/run-length-encoding-4.js

@@ -0,0 +1,51 @@
+(() => {
+    'use strict';
+
+    // runLengthEncode :: String -> [(Int, Char)]
+    const runLengthEncoded = s =>
+        group(s.split('')).map(
+            cs => [cs.length, cs[0]]
+        );
+
+    // runLengthDecoded :: [(Int, Char)] -> String
+    const runLengthDecoded = pairs =>
+        pairs.map(([n, c]) => c.repeat(n)).join('');
+
+
+    // ------------------------TEST------------------------
+    const main = () => {
+        const
+            xs = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWW' +
+            'WWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW',
+            ys = runLengthEncoded(xs);
+
+        console.log('From: ', show(xs));
+        [ys, runLengthDecoded(ys)].forEach(
+            x => console.log('  ->  ', show(x))
+        )
+    };
+
+    // ----------------------GENERIC-----------------------
+
+    // group :: [a] -> [[a]]
+    const group = xs => {
+        // A list of lists, each containing only equal elements,
+        // such that the concatenation of these lists is xs.
+        const go = xs =>
+            0 < xs.length ? (() => {
+                const
+                    h = xs[0],
+                    i = xs.findIndex(x => h !== x);
+                return i !== -1 ? (
+                    [xs.slice(0, i)].concat(go(xs.slice(i)))
+                ) : [xs];
+            })() : [];
+        return go(xs);
+    };
+
+    // show :: a -> String
+    const show = JSON.stringify;
+
+    // MAIN ---
+    return main();
+})();

Task/Run-length-encoding/JavaScript/run-length-encoding-5.js

@@ -0,0 +1,3 @@
+const rlEncode = (s: string) => s.match(/(.)\1*/g).reduce((result,char) => result+char.length+char[0],"")
+const rlValidate = (s: string) => /^(\d+\D)+$/.test(s)
+const rlDecode = (s: string) => rlValidate(s) ? s.match(/(\d[a-z\s])\1*/ig).reduce((res,p) => res+p[p.length-1].repeat(parseInt(p)),"") : Error("Invalid rl")

Task/Run-length-encoding/Jq/run-length-encoding-1.jq

@@ -0,0 +1,9 @@
+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 ) ;

Task/Run-length-encoding/Jq/run-length-encoding-2.jq

@@ -0,0 +1,9 @@
+def run_length_encode:
+  explode | runs | reduce .[] as $x (""; . + "\($x[1])\([$x[0]]|implode)");
+
+def run_length_decode:
+  reduce (scan( "[0-9]+[A-Z]" )) as $pair
+    ( "";
+      ($pair[0:-1] | tonumber) as $n
+      | $pair[-1:] as $letter
+      | . + ($n * $letter)) ;

Task/Run-length-encoding/Jq/run-length-encoding-3.jq

@@ -0,0 +1 @@
+"ABBCCC" | run_length_encode | run_length_decode

Task/Run-length-encoding/Jq/run-length-encoding-4.jq

@@ -0,0 +1,2 @@
+$ jq -n -f Run_length_encoding.jq
+"ABBCCC"

Task/Run-length-encoding/Julia/run-length-encoding.julia

@@ -0,0 +1,10 @@
+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

Task/Run-length-encoding/K/run-length-encoding-1.k

@@ -0,0 +1 @@
+rle: {,/($-':i,#x),'x@i:&1,~=':x}

Task/Run-length-encoding/K/run-length-encoding-2.k

@@ -0,0 +1 @@
+rld: {d:"0123456789"; ,/(.(d," ")@d?/:x)#'x _dvl d}

Task/Run-length-encoding/K/run-length-encoding-3.k

@@ -0,0 +1,4 @@
+  rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
+"12W1B12W3B24W1B14W"
+  rld "12W1B12W3B24W1B14W"
+"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"

Task/Run-length-encoding/Kotlin/run-length-encoding.kotlin

@@ -0,0 +1,14 @@
+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")
+}

Task/Run-length-encoding/Lasso/run-length-encoding.lasso

@@ -0,0 +1,47 @@
+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')

Task/Run-length-encoding/Liberty-BASIC/run-length-encoding.basic

@@ -0,0 +1,48 @@
+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

Task/Run-length-encoding/LiveCode/run-length-encoding.livecode

@@ -0,0 +1,43 @@
+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

Task/Run-length-encoding/Logo/run-length-encoding.logo

@@ -0,0 +1,18 @@
+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

Task/Run-length-encoding/Lua/run-length-encoding.lua

@@ -0,0 +1,31 @@
+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

Task/Run-length-encoding/M2000-Interpreter/run-length-encoding.m2000

@@ -0,0 +1,33 @@
+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

Task/Run-length-encoding/MMIX/run-length-encoding.mmix

@@ -0,0 +1,110 @@
+	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

Task/Run-length-encoding/Mathematica/run-length-encoding-1.math

@@ -0,0 +1 @@
+RunLengthEncode[input_String]:= (l |-> {First@l, Length@l}) /@ (Split@Characters@input)

Task/Run-length-encoding/Mathematica/run-length-encoding-2.math

@@ -0,0 +1 @@
+RunLengthDecode[input_List]:= ConstantArray @@@ input // Flatten // StringJoin