Run-length encoding: Difference between revisions
(added Ceylon) |
m (→{{header|Wren}}: Minor tidy) |
||
(95 intermediate revisions by 47 users not shown) | |||
Line 1: | Line 1: | ||
{{Wikipedia|Run-length_encoding}} |
{{Wikipedia|Run-length_encoding}} |
||
{{task|Compression}} |
{{task|Compression}} |
||
[[Category: Encodings]] |
[[Category: Encodings]] |
||
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. |
|||
;Task: |
|||
Example: |
|||
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> |
: Input: <code>WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</code> |
||
: Output: <code>12W1B12W3B24W1B14W</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]]. |
Note: the encoding step in the above example is the same as a step of the [[Look-and-say sequence]]. |
||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">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))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Encoded value is [5a, 6h, 7m, 1u, 7i, 6a] |
|||
Decoded value is aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa |
|||
</pre> |
|||
=={{header|8086 Assembly}}== |
|||
Output is in hexadecimal but is otherwise correct. |
|||
<syntaxhighlight lang="asm"> .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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
0C 57 01 42 0C 57 03 42 .W.B.W.B |
|||
18 57 01 42 0E 57 00 00 .W.B.W.. |
|||
00 00 00 00 00 00 00 00 ........ |
|||
00 00 00 00 00 00 00 00 ........ |
|||
</pre> |
|||
The hexdump above converts to: <code>12W 1B 12W 3B 24W 1B 14W</code> |
|||
=={{header|Action!}}== |
|||
<syntaxhighlight lang="action!">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</syntaxhighlight> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Run-length_encoding.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
original: |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
encoded: |
|||
12W1B12W3B24W1B14W |
|||
decoded: |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
< |
<syntaxhighlight lang="ada">with Ada.Text_IO; use Ada.Text_IO; |
||
with Ada.Strings.Fixed; use Ada.Strings.Fixed; |
with Ada.Strings.Fixed; use Ada.Strings.Fixed; |
||
procedure Test_Run_Length_Encoding is |
procedure Test_Run_Length_Encoding is |
||
Line 62: | Line 292: | ||
Put_Line (Encode ("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")); |
Put_Line (Encode ("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")); |
||
Put_Line (Decode ("12W1B12W3B24W1B14W")); |
Put_Line (Decode ("12W1B12W3B24W1B14W")); |
||
end Test_Run_Length_Encoding;</ |
end Test_Run_Length_Encoding;</syntaxhighlight> |
||
Sample output: |
Sample output: |
||
<pre> |
<pre> |
||
Line 77: | Line 307: | ||
Note: The following uses iterators, eliminating the need of declaring arbitrarily large CHAR arrays for caching. |
Note: The following uses iterators, eliminating the need of declaring arbitrarily large CHAR arrays for caching. |
||
< |
<syntaxhighlight lang="algol68">STRING input := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
||
STRING output := "12W1B12W3B24W1B14W"; |
STRING output := "12W1B12W3B24W1B14W"; |
||
Line 148: | Line 378: | ||
print(c) |
print(c) |
||
# OD # ); |
# OD # ); |
||
print(new line)</ |
print(new line)</syntaxhighlight> |
||
Output: |
Output: |
||
<pre> |
<pre> |
||
Encode input: 12W1B12W3B24W1B14W |
Encode input: 12W1B12W3B24W1B14W |
||
Decode output: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
Decode output: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
</pre> |
|||
=={{header|Amazing Hopper}}== |
|||
<syntaxhighlight lang="c"> |
|||
/* |
|||
TASK BASIC-EMBEBIDO de HOPPER |
|||
onechar("WB",objetivo) |
|||
deja un único carcater de todos los que encuentre consecutivamente, |
|||
de la lista de caracteres "WB". |
|||
índice:=() |
|||
copia el valor de la función entre paréntesis en "índice", pero |
|||
deja ese valor en el stack de trabajo, para ser asignado a "largo". |
|||
poschar(INICIO, v, objetivo) |
|||
entrega la posición donde el caracter dado "v" deja de repetirse |
|||
(por eso se resta 1 al resultado). |
|||
objetivo+=sublargo |
|||
borra los primeros sublargo-ésimo caracteres. |
|||
#basic{...} / #(...) |
|||
BASIC embebido de Hopper. |
|||
*/ |
|||
#include <basico.h> |
|||
#define INICIO 1 |
|||
#proto codificar(_X_,_Y_,_Z_) |
|||
#proto decodificar(_X_,_Y_) |
|||
principal { |
|||
índice="", largo=0, codificado="", decodificado="" |
|||
objetivo = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
decimales '0', fijar separador 'NULO' |
|||
#basic{ |
|||
largo = len(índice:=( onechar("WB",objetivo) ) ) |
|||
print ("Original =",objetivo,NL) |
|||
codificado = codificar(objetivo, índice, largo) |
|||
decodificado = decodificar(codificado, índice) |
|||
print ("Codificado =",codificado,"\nDecodificado =",decodificado,NL) |
|||
} |
|||
terminar |
|||
} |
|||
subrutinas |
|||
codificar( o, i, l) |
|||
v="", sublargo=0 |
|||
para cada caracter ( v, i, l ) |
|||
/* deja ésto en el stack de trabajo: */ |
|||
#( sublargo := (poschar(INICIO, v, o) - 1 ) ), 'v' |
|||
o+=sublargo |
|||
siguiente |
|||
unir esto |
|||
retornar |
|||
decodificar(c, i) |
|||
v="", posición=0, l=0 |
|||
#( l=len(i) ) |
|||
para cada caracter ( v, i, l ) |
|||
#basic{ |
|||
posición = find(v, c)-1 |
|||
/* deja ésto en el stack de trabajo: */ |
|||
replicate(v, number(copy(posición,1,c)) ) |
|||
} |
|||
++posición,c+=posición |
|||
siguiente |
|||
unir esto |
|||
retornar |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Original =WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Codificado =12W1B12W3B24W1B14W |
|||
Decodificado =WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
</pre> |
||
=={{header|APL}}== |
=={{header|APL}}== |
||
< |
<syntaxhighlight lang="apl"> ∇ ret←RLL rll;count |
||
[1] count←∣2-/((1,(2≠/rll),1)×⍳1+⍴rll)~0 |
[1] count←∣2-/((1,(2≠/rll),1)×⍳1+⍴rll)~0 |
||
[2] ret←(⍕count,¨(1,2≠/rll)/rll)~' ' |
[2] ret←(⍕count,¨(1,2≠/rll)/rll)~' ' |
||
∇ |
∇ |
||
</syntaxhighlight> |
|||
</lang> |
|||
Sample Output: |
Sample Output: |
||
<pre> |
<pre> |
||
Line 166: | Line 480: | ||
12W1B12W3B24W1B14W |
12W1B12W3B24W1B14W |
||
</pre> |
</pre> |
||
=={{header|AppleScript}}== |
|||
<syntaxhighlight lang="applescript">------------------ 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|</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>W12B1W12B3W24B1W14 |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
true</pre> |
|||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">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!"</syntaxhighlight> |
|||
{{out}} |
|||
<pre>encoded: 12W1B12W3B24W1B14W |
|||
decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Success!</pre> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |
||
< |
<syntaxhighlight lang="autohotkey">MsgBox % key := rle_encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
||
MsgBox % rle_decode(key) |
MsgBox % rle_decode(key) |
||
Line 202: | Line 712: | ||
} |
} |
||
Return output |
Return output |
||
}</ |
}</syntaxhighlight> |
||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
Line 211: | Line 721: | ||
'''Encoding''' |
'''Encoding''' |
||
< |
<syntaxhighlight lang="awk">BEGIN { |
||
FS="" |
FS="" |
||
} |
} |
||
Line 226: | Line 736: | ||
} |
} |
||
printf("%d%c", j, cp) |
printf("%d%c", j, cp) |
||
}</ |
}</syntaxhighlight> |
||
'''Decoding''' |
'''Decoding''' |
||
< |
<syntaxhighlight lang="awk">BEGIN { |
||
RS="[0-9]+[^0-9]" |
RS="[0-9]+[^0-9]" |
||
final = ""; |
final = ""; |
||
Line 242: | Line 752: | ||
END { |
END { |
||
print final |
print final |
||
}</ |
}</syntaxhighlight> |
||
=={{header|BaCon}}== |
=={{header|BaCon}}== |
||
< |
<syntaxhighlight lang="qbasic">FUNCTION Rle_Encode$(txt$) |
||
LOCAL result$, c$ = LEFT$(txt$, 1) |
LOCAL result$, c$ = LEFT$(txt$, 1) |
||
Line 286: | Line 796: | ||
encoded$ = Rle_Encode$(rle_data$) |
encoded$ = Rle_Encode$(rle_data$) |
||
PRINT "Encoded: ", encoded$ |
PRINT "Encoded: ", encoded$ |
||
PRINT "Decoded: ", Rle_Decode$(encoded$)</ |
PRINT "Decoded: ", Rle_Decode$(encoded$)</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>RLEData: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>RLEData: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 299: | Line 809: | ||
{{trans|PowerBASIC}} |
{{trans|PowerBASIC}} |
||
< |
<syntaxhighlight lang="qbasic">DECLARE FUNCTION RLDecode$ (i AS STRING) |
||
DECLARE FUNCTION RLEncode$ (i AS STRING) |
DECLARE FUNCTION RLEncode$ (i AS STRING) |
||
Line 353: | Line 863: | ||
outP = outP + tmp2 |
outP = outP + tmp2 |
||
RLEncode$ = outP |
RLEncode$ = outP |
||
END FUNCTION</ |
END FUNCTION</syntaxhighlight> |
||
Sample output (last one shows errors from using numbers in input string): |
Sample output (last one shows errors from using numbers in input string): |
||
Line 371: | Line 881: | ||
111r |
111r |
||
rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr |
rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr |
||
==={{header|Applesoft BASIC}}=== |
|||
<syntaxhighlight lang="basic"> 10 I$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
20 GOSUB 100ENCODE |
|||
30 GOSUB 200DECODE |
|||
40 PRINT "INPUT: ";I$ |
|||
50 PRINT "OUTPUT: "; |
|||
60 GOSUB 250 PRINT |
|||
70 END |
|||
100 O$ = MID$ (I$,1,1):N$ = MID$ ( CHR$ (0),1, LEN (O$)): IF LEN (I$) < 2 THEN RETURN |
|||
110 FOR I = 2 TO LEN (I$):C$ = MID$ (I$,I,1): IF C$ < > RIGHT$ (O$,1) THEN O$ = O$ + C$:N$ = N$ + CHR$ (0): NEXT I: RETURN |
|||
120 N$ = MID$ (N$,1, LEN (O$) - 1) + CHR$ ( ASC ( MID$ (N$, LEN (O$))) + 1): NEXT I: RETURN |
|||
200 I$ = "": IF LEN (O$) THEN FOR I = 1 TO LEN (O$): FOR J = 0 TO ASC ( MID$ (N$,I)):I$ = I$ + MID$ (O$,I,1): NEXT J,I |
|||
210 RETURN |
|||
250 IF LEN (O$) THEN FOR I = 1 TO LEN (O$): PRINT ASC ( MID$ (N$,I)) + 1; MID$ (O$,I,1);: NEXT I |
|||
260 RETURN |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>INPUT: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
OUTPUT: 12W1B12W3B24W1B14W</pre> |
|||
=={{header|BASIC256}}== |
|||
<syntaxhighlight lang="basic256"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
La salida es similar a la de [[#BASIC|BASIC]], mostrada arriba. |
|||
=={{header|BBC BASIC}}== |
=={{header|BBC BASIC}}== |
||
The run counts are indicated by means of character codes in the range 131 to 255. |
The run counts are indicated by means of character codes in the range 131 to 255. |
||
< |
<syntaxhighlight lang="bbcbasic"> input$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
PRINT "Input: " input$ |
PRINT "Input: " input$ |
||
rle$ = FNencodeRLE(input$) |
rle$ = FNencodeRLE(input$) |
||
Line 409: | Line 1,022: | ||
ENDIF |
ENDIF |
||
ENDWHILE |
ENDWHILE |
||
= o$</ |
= o$</syntaxhighlight> |
||
=={{header|Befunge}}== |
=={{header|Befunge}}== |
||
Line 415: | Line 1,028: | ||
Pipe the output of the program-it's more reliable. |
Pipe the output of the program-it's more reliable. |
||
{{works with|CCBI|2.1}} |
{{works with|CCBI|2.1}} |
||
< |
<syntaxhighlight lang="befunge"> ~"y"- ~$ v |
||
<temp var for when char changes |
<temp var for when char changes |
||
format: |
format: |
||
Line 440: | Line 1,053: | ||
the validity of this program is NOT affected p- |
the validity of this program is NOT affected p- |
||
>^ |
>^ |
||
--written by Gamemanj,for Rosettacode</ |
--written by Gamemanj,for Rosettacode</syntaxhighlight> |
||
=={{header|Bracmat}}== |
=={{header|Bracmat}}== |
||
< |
<syntaxhighlight lang="bracmat"> ( run-length |
||
= character otherCharacter acc begin end |
= character otherCharacter acc begin end |
||
. :?acc |
. :?acc |
||
Line 464: | Line 1,077: | ||
) |
) |
||
& run-length$WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
& run-length$WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
</syntaxhighlight> |
|||
</lang> |
|||
<pre> 12W1B12W3B24W1B14W</pre> |
<pre> 12W1B12W3B24W1B14W</pre> |
||
=={{header|Burlesque}}== |
=={{header|Burlesque}}== |
||
< |
<syntaxhighlight lang="burlesque"> |
||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
=[{^^[~\/L[Sh}\m |
=[{^^[~\/L[Sh}\m |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
Encoder that can deal with byte streams. Can encode/decode any byte values and any length with reasonable efficiency. Also showing OO and polymophism with structs. |
Encoder that can deal with byte streams. Can encode/decode any byte values and any length with reasonable efficiency. Also showing OO and polymophism with structs. |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
#include <stdlib.h> |
#include <stdlib.h> |
||
typedef struct stream_t stream_t, *stream; |
typedef struct stream_t stream_t, *stream; |
||
struct stream_t { |
struct stream_t { |
||
/* get |
/* get function is supposed to return a byte value (0-255), |
||
or -1 to signify end of input */ |
or -1 to signify end of input */ |
||
int (*get)(stream); |
int (*get)(stream); |
||
Line 621: | Line 1,234: | ||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
See [[Run-length encoding/C]] |
See [[Run-length encoding/C]] |
||
=={{header|C++}}== |
|||
{{libheader|boost}} |
|||
<lang cpp>#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( ) ; |
|||
}</lang> |
|||
=={{header|C sharp|C#}}== |
=={{header|C sharp|C#}}== |
||
=== Linq === |
=== Linq === |
||
<!--Martin Freedman 22/02/2018--> |
<!--Martin Freedman 22/02/2018--> |
||
< |
<syntaxhighlight lang="csharp">using System.Collections.Generic; |
||
using System.Linq; |
using System.Linq; |
||
using static System.Console; |
using static System.Console; |
||
Line 720: | Line 1,277: | ||
} |
} |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 730: | Line 1,287: | ||
Many solutions do not follow the suggested output guideline in the challenge (not helped by its wording), instead producing a list of tuples or equivalent. This is much simpler (especially for decode) and the following provides an equivalent of those (IMHO deficient) solutions, to make comparisons easier. |
Many solutions do not follow the suggested output guideline in the challenge (not helped by its wording), instead producing a list of tuples or equivalent. This is much simpler (especially for decode) and the following provides an equivalent of those (IMHO deficient) solutions, to make comparisons easier. |
||
< |
<syntaxhighlight lang="csharp">using System.Collections.Generic; |
||
using System.Linq; |
using System.Linq; |
||
using static System.Console; |
using static System.Console; |
||
Line 759: | Line 1,316: | ||
string.Join(",", list.Select(t => $"[{t.i},{t.c}]")); |
string.Join(",", list.Select(t => $"[{t.i},{t.c}]")); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 768: | Line 1,325: | ||
Stringbuilder version. Might be more performant but mixes output formatting with encoding/decoding logic. |
Stringbuilder version. Might be more performant but mixes output formatting with encoding/decoding logic. |
||
<!--Martin Freedman 22/02/2018--> |
<!--Martin Freedman 22/02/2018--> |
||
< |
<syntaxhighlight lang="csharp">using System.Collections.Generic; |
||
using System.Linq; |
using System.Linq; |
||
using static System.Console; |
using static System.Console; |
||
Line 803: | Line 1,360: | ||
} |
} |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 815: | Line 1,372: | ||
This example only works if there are no digits in the string to be encoded and then decoded. |
This example only works if there are no digits in the string to be encoded and then decoded. |
||
< |
<syntaxhighlight lang="csharp"> public static void Main(string[] args) |
||
{ |
{ |
||
string input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
string input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
||
Line 863: | Line 1,420: | ||
} |
} |
||
return sb.ToString(); |
return sb.ToString(); |
||
}</ |
}</syntaxhighlight> |
||
=== RegEx === |
=== RegEx === |
||
Somewhat shorter, using Regex.Replace with MatchEvaluator (using C#2 syntax only): |
Somewhat shorter, using Regex.Replace with MatchEvaluator (using C#2 syntax only): |
||
< |
<syntaxhighlight lang="csharp">using System; |
||
using System.Text.RegularExpressions; |
using System.Text.RegularExpressions; |
||
Line 903: | Line 1,460: | ||
}); |
}); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
=={{header|C++}}== |
|||
<syntaxhighlight lang="cpp">#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'; |
|||
}</syntaxhighlight> |
|||
{{libheader|boost}} |
|||
<syntaxhighlight lang="cpp">#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( ) ; |
|||
}</syntaxhighlight> |
|||
=={{header|Ceylon}}== |
=={{header|Ceylon}}== |
||
< |
<syntaxhighlight lang="ceylon">shared void run() { |
||
" |
"Takes a string such as aaaabbbbbbcc and returns 4a6b2c" |
||
String compress(String string) { |
String compress(String string) { |
||
if (exists firstChar = string.first) { |
if (exists firstChar = string.first) { |
||
Line 923: | Line 1,699: | ||
} |
} |
||
" |
"Takes a string such as 4a6b2c and returns aaaabbbbbbcc" |
||
String decompress(String string) => |
String decompress(String string) => |
||
let (runs = string.split(Character.letter, false).paired) |
let (runs = string.split(Character.letter, false).paired) |
||
Line 936: | Line 1,712: | ||
assert (compress("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") == "12W1B12W3B24W1B14W"); |
assert (compress("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") == "12W1B12W3B24W1B14W"); |
||
assert (decompress("24a") == "aaaaaaaaaaaaaaaaaaaaaaaa"); |
assert (decompress("24a") == "aaaaaaaaaaaaaaaaaaaaaaaa"); |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Clojure}}== |
=={{header|Clojure}}== |
||
< |
<syntaxhighlight lang="clojure">(defn compress [s] |
||
(->> (partition-by identity s) (mapcat (juxt count first)) (apply str))) |
(->> (partition-by identity s) (mapcat (juxt count first)) (apply str))) |
||
Line 945: | Line 1,721: | ||
(->> (re-seq #"(\d+)([A-Z])" s) |
(->> (re-seq #"(\d+)([A-Z])" s) |
||
(mapcat (fn [[_ n ch]] (repeat (Integer/parseInt n) ch))) |
(mapcat (fn [[_ n ch]] (repeat (Integer/parseInt n) ch))) |
||
(apply str)))</ |
(apply str)))</syntaxhighlight> |
||
=={{header|COBOL}}== |
=={{header|COBOL}}== |
||
{{works with|GNU Cobol|2.0}} |
{{works with|GNU Cobol|2.0}} |
||
< |
<syntaxhighlight lang="cobol"> >>SOURCE FREE |
||
IDENTIFICATION DIVISION. |
IDENTIFICATION DIVISION. |
||
PROGRAM-ID. run-length-encoding. |
PROGRAM-ID. run-length-encoding. |
||
Line 1,072: | Line 1,848: | ||
END-PERFORM |
END-PERFORM |
||
. |
. |
||
END FUNCTION decode.</ |
END FUNCTION decode.</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,083: | Line 1,859: | ||
=={{header|CoffeeScript}}== |
=={{header|CoffeeScript}}== |
||
< |
<syntaxhighlight lang="coffeescript">encode = (str) -> |
||
str.replace /(.)\1*/g, (w) -> |
str.replace /(.)\1*/g, (w) -> |
||
w[0] + w.length |
w[0] + w.length |
||
Line 1,093: | Line 1,869: | ||
console.log s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
console.log s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
console.log encode s |
console.log encode s |
||
console.log decode encode s</ |
console.log decode encode s</syntaxhighlight> |
||
<pre> |
<pre> |
||
Line 1,103: | Line 1,879: | ||
The following version encodes the number of ocurrences as an unicode character. You can change the way it looks by rotating the offset. |
The following version encodes the number of ocurrences as an unicode character. You can change the way it looks by rotating the offset. |
||
< |
<syntaxhighlight lang="coffeescript">encode = (str, offset = 75) -> |
||
str.replace /(.)\1*/g, (w) -> |
str.replace /(.)\1*/g, (w) -> |
||
w[0] + String.fromCharCode(offset+w.length) |
w[0] + String.fromCharCode(offset+w.length) |
||
Line 1,110: | Line 1,886: | ||
str.split('').map((w,i) -> |
str.split('').map((w,i) -> |
||
if not (i%2) then w else new Array(+w.charCodeAt(0)-offset).join(str[i-1]) |
if not (i%2) then w else new Array(+w.charCodeAt(0)-offset).join(str[i-1]) |
||
).join('')</ |
).join('')</syntaxhighlight> |
||
<pre> |
<pre> |
||
Line 1,122: | Line 1,898: | ||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
< |
<syntaxhighlight lang="lisp">(defun group-similar (sequence &key (test 'eql)) |
||
(loop for x in (rest sequence) |
(loop for x in (rest sequence) |
||
with temp = (subseq sequence 0 1) |
with temp = (subseq sequence 0 1) |
||
Line 1,144: | Line 1,920: | ||
(run-length-encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
(run-length-encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
||
(run-length-decode '((#\W 12) (#\B 1) (#\W 12) (#\B 3) (#\W 24) (#\B 1)))</ |
(run-length-decode '((#\W 12) (#\B 1) (#\W 12) (#\B 3) (#\W 24) (#\B 1)))</syntaxhighlight> |
||
=={{header|D}}== |
=={{header|D}}== |
||
===Short Functional Version=== |
===Short Functional Version=== |
||
< |
<syntaxhighlight lang="d">import std.algorithm, std.array; |
||
alias encode = group; |
alias encode = group; |
||
Line 1,160: | Line 1,936: | ||
"WWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
"WWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
||
assert(s.encode.decode.equal(s)); |
assert(s.encode.decode.equal(s)); |
||
}</ |
}</syntaxhighlight> |
||
===Basic Imperative Version=== |
===Basic Imperative Version=== |
||
< |
<syntaxhighlight lang="d">import std.stdio, std.array, std.conv; |
||
// Similar to the 'look and say' function. |
// Similar to the 'look and say' function. |
||
Line 1,215: | Line 1,991: | ||
writeln("Encoded: ", encoded); |
writeln("Encoded: ", encoded); |
||
assert(txt == encoded.decode); |
assert(txt == encoded.decode); |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 1,223: | Line 1,999: | ||
D's native string is utf-encoded. This version works for utf string, and uses a [[Variable-length_quantity|Variable-length Quantity]] [[Variable-length_quantity#D|module]]. |
D's native string is utf-encoded. This version works for utf string, and uses a [[Variable-length_quantity|Variable-length Quantity]] [[Variable-length_quantity#D|module]]. |
||
< |
<syntaxhighlight lang="d">import std.stdio, std.conv, std.utf, std.array; |
||
import vlq; |
import vlq; |
||
Line 1,301: | Line 2,077: | ||
auto sEncoded = RLE.init.encode(s).encoded ; |
auto sEncoded = RLE.init.encode(s).encoded ; |
||
assert(s == RLE(sEncoded).decode(), "Not work"); |
assert(s == RLE(sEncoded).decode(), "Not work"); |
||
}</ |
}</syntaxhighlight> |
||
output from "display.txt": |
output from "display.txt": |
||
Line 1,322: | Line 2,098: | ||
The code looks more complex than the third Python version because this also handles digits by escaping them with #. |
The code looks more complex than the third Python version because this also handles digits by escaping them with #. |
||
< |
<syntaxhighlight lang="d">import std.stdio, std.conv, std.array, std.regex, std.utf, |
||
std.algorithm; |
std.algorithm; |
||
Line 1,353: | Line 2,129: | ||
"11#222##333"; |
"11#222##333"; |
||
assert(s == reDecode(reEncode(s))); |
assert(s == reDecode(reEncode(s))); |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Déjà Vu}}== |
=={{header|Déjà Vu}}== |
||
< |
<syntaxhighlight lang="dejavu">rle: |
||
if not dup: |
if not dup: |
||
drop |
drop |
||
Line 1,384: | Line 2,160: | ||
rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
!. dup |
!. dup |
||
!. rld</ |
!. rld</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>[ & 12 "W" & 1 "B" & 12 "W" & 3 "B" & 24 "W" & 1 "B" & 14 "W" ] |
<pre>[ & 12 "W" & 1 "B" & 12 "W" & 3 "B" & 24 "W" & 1 "B" & 14 "W" ] |
||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</pre> |
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</pre> |
||
=={{header|Delphi}}== |
|||
{{libheader| System.SysUtils}} |
|||
<syntaxhighlight lang="delphi"> |
|||
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.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|E}}== |
=={{header|E}}== |
||
< |
<syntaxhighlight lang="e">def rle(string) { |
||
var seen := null |
var seen := null |
||
var count := 0 |
var count := 0 |
||
Line 1,418: | Line 2,298: | ||
} |
} |
||
return result |
return result |
||
}</ |
}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="e">? rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
||
# value: [[12, 'W'], [1, 'B'], [12, 'W'], [3, 'B'], [24, 'W'], [1, 'B'], [14, 'W']] |
# value: [[12, 'W'], [1, 'B'], [12, 'W'], [3, 'B'], [24, 'W'], [1, 'B'], [14, 'W']] |
||
? unrle(rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")) |
? unrle(rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")) |
||
# value: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</ |
# value: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</syntaxhighlight> |
||
=={{header|Elena}}== |
|||
ELENA 3.3 : |
|||
<lang elena>import system'text. |
|||
import system'routines. |
|||
import extensions. |
|||
=={{header|EasyLang}}== |
|||
<syntaxhighlight lang="easylang"> |
|||
func$ rlenc in$ . |
|||
for c$ in strchars in$ |
|||
if c$ = c0$ |
|||
cnt += 1 |
|||
else |
|||
if cnt > 0 |
|||
out$ &= cnt & c0$ & " " |
|||
. |
|||
c0$ = c$ |
|||
cnt = 1 |
|||
. |
|||
. |
|||
out$ &= cnt & c0$ |
|||
return out$ |
|||
. |
|||
func$ rldec in$ . |
|||
for h$ in strsplit in$ " " |
|||
c$ = substr h$ len h$ 1 |
|||
for i to number h$ |
|||
out$ &= c$ |
|||
. |
|||
. |
|||
return out$ |
|||
. |
|||
s$ = input |
|||
print s$ |
|||
s$ = rlenc s$ |
|||
print s$ |
|||
s$ = rldec s$ |
|||
print s$ |
|||
# |
|||
input_data |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</syntaxhighlight> |
|||
=={{header|Elena}}== |
|||
ELENA 6.x : |
|||
<syntaxhighlight lang="elena">import system'text; |
|||
import system'routines; |
|||
import extensions; |
|||
import extensions'text; |
|||
singleton compressor |
singleton compressor |
||
{ |
{ |
||
string compress(string s) |
|||
{ |
|||
auto tb := new TextBuilder(); |
|||
int count := 0 |
int count := 0; |
||
char current := s[0] |
char current := s[0]; |
||
s |
s.forEach::(ch) |
||
{ |
|||
if (ch == current) |
if (ch == current) |
||
{ |
|||
count += 1 |
count += 1 |
||
} |
|||
else |
|||
{ |
|||
tb.writeFormatted("{0}{1}",count,current); |
|||
count := 1; |
|||
current := ch |
current := ch |
||
} |
|||
}; |
|||
tb |
tb.writeFormatted("{0}{1}",count,current); |
||
^ tb |
^ tb |
||
} |
|||
string decompress(string s) |
|||
{ |
|||
auto tb := new TextBuilder(); |
|||
char current := $0 |
char current := $0; |
||
var a := |
var a := new StringWriter(); |
||
s |
s.forEach::(ch) |
||
{ |
|||
current := ch |
current := ch; |
||
if (current |
if (current.isDigit()) |
||
{ |
|||
a |
a.append(ch) |
||
} |
|||
else |
|||
{ |
|||
int count := a.toInt(); |
|||
a.clear(); |
|||
tb fill(current,count). |
|||
tb.fill(current,count) |
|||
} |
|||
}; |
|||
^ tb |
^ tb |
||
} |
|||
} |
} |
||
public program() |
|||
program = |
|||
{ |
|||
[ |
|||
var s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
var s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
||
s := compressor |
s := compressor.compress(s); |
||
console |
console.printLine(s); |
||
s := compressor |
s := compressor.decompress(s); |
||
console |
console.printLine(s) |
||
}</syntaxhighlight> |
|||
].</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,497: | Line 2,420: | ||
=={{header|Elixir}}== |
=={{header|Elixir}}== |
||
< |
<syntaxhighlight lang="elixir">defmodule Run_length do |
||
def encode(str) when is_bitstring(str) do |
def encode(str) when is_bitstring(str) do |
||
to_char_list(str) |> encode |> to_string |
to_char_list(str) |> encode |> to_string |
||
Line 1,523: | Line 2,446: | ||
|> Run_length.encode |> IO.inspect |
|> Run_length.encode |> IO.inspect |
||
|> Run_length.decode |> IO.inspect |
|> Run_length.decode |> IO.inspect |
||
end)</ |
end)</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,535: | Line 2,458: | ||
'12W1B12W3B24W1B14W' |
'12W1B12W3B24W1B14W' |
||
'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'</pre> |
'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'</pre> |
||
=={{header|Emacs Lisp}}== |
|||
<syntaxhighlight lang="lisp">(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) "")))</syntaxhighlight> |
|||
{{libheader|seq.el}} |
|||
<syntaxhighlight lang="lisp">(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))))</syntaxhighlight> |
|||
=={{header|Erlang}}== |
=={{header|Erlang}}== |
||
Line 1,540: | Line 2,484: | ||
A single-threaded/process version with a simple set of unit test. |
A single-threaded/process version with a simple set of unit test. |
||
< |
<syntaxhighlight lang="erlang">-module(rle). |
||
-export([encode/1,decode/1]). |
-export([encode/1,decode/1]). |
||
Line 1,585: | Line 2,529: | ||
?_assert(decode(Expected) =:= PreEncoded), |
?_assert(decode(Expected) =:= PreEncoded), |
||
?_assert(decode(encode(PreEncoded)) =:= PreEncoded) |
?_assert(decode(encode(PreEncoded)) =:= PreEncoded) |
||
].</ |
].</syntaxhighlight> |
||
A version that works on character lists: |
A version that works on character lists: |
||
< |
<syntaxhighlight lang="erlang"> |
||
-module(rle). |
-module(rle). |
||
Line 1,610: | Line 2,554: | ||
decode([{Count, Char}|T], Acc) -> |
decode([{Count, Char}|T], Acc) -> |
||
decode(T, [[Char || _ <- lists:seq(1, Count)]|Acc]). |
decode(T, [[Char || _ <- lists:seq(1, Count)]|Acc]). |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Euphoria}}== |
=={{header|Euphoria}}== |
||
< |
<syntaxhighlight lang="euphoria">include misc.e |
||
function encode(sequence s) |
function encode(sequence s) |
||
Line 1,650: | Line 2,594: | ||
pretty_print(1,s,{3}) |
pretty_print(1,s,{3}) |
||
puts(1,'\n') |
puts(1,'\n') |
||
puts(1,decode(s))</ |
puts(1,decode(s))</syntaxhighlight> |
||
Output: |
Output: |
||
Line 1,657: | Line 2,601: | ||
=={{header|F Sharp|F#}}== |
=={{header|F Sharp|F#}}== |
||
< |
<syntaxhighlight lang="fsharp"> |
||
open System |
open System |
||
open System.Text.RegularExpressions |
open System.Text.RegularExpressions |
||
Line 1,676: | Line 2,620: | ||
|> List.map (fun m -> Int32.Parse(m.Groups.[1].Value), m.Groups.[2].Value) |
|> 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) "" |
|> List.fold (fun acc (len, s) -> acc + String.replicate len s) "" |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Factor}}== |
|||
<syntaxhighlight lang="factor">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@</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|FALSE}}== |
=={{header|FALSE}}== |
||
< |
<syntaxhighlight lang="false">1^[^$~][$@$@=$[%%\1+\$0~]?~[@.,1\$]?%]#%\., {encode}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="false">[0[^$$'9>'0@>|~]['0-\10*+]#]n: |
||
[n;!$~][[\$][1-\$,]#%%]#%% {decode}</ |
[n;!$~][[\$][1-\$,]#%%]#%% {decode}</syntaxhighlight> |
||
=={{header|Fan}}== |
=={{header|Fan}}== |
||
<syntaxhighlight lang="fan">** |
|||
<lang Fan>** |
|||
** Generates a run-length encoding for a string |
** Generates a run-length encoding for a string |
||
** |
** |
||
Line 1,730: | Line 2,699: | ||
override Str toStr() { return "${count}${char.toChar}" } |
override Str toStr() { return "${count}${char.toChar}" } |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
< |
<syntaxhighlight lang="forth">variable a |
||
: n>a (.) tuck a @ swap move a +! ; |
: n>a (.) tuck a @ swap move a +! ; |
||
: >a a @ c! 1 a +! ; |
: >a a @ c! 1 a +! ; |
||
Line 1,747: | Line 2,716: | ||
i c@ digit? if 10 * i c@ [char] 0 - + else |
i c@ digit? if 10 * i c@ [char] 0 - + else |
||
a @ over i c@ fill a +! 0 then |
a @ over i c@ fill a +! 0 then |
||
loop drop a @ over - ;</ |
loop drop a @ over - ;</syntaxhighlight> |
||
Example: |
Example: |
||
< |
<syntaxhighlight lang="forth">s" WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
here 1000 + encode here 2000 + decode cr 3 spaces type |
here 1000 + encode here 2000 + decode cr 3 spaces type |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</ |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</syntaxhighlight> |
||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
{{works with|Fortran|95 and later}} |
{{works with|Fortran|95 and later}} |
||
< |
<syntaxhighlight lang="fortran">program RLE |
||
implicit none |
implicit none |
||
integer, parameter :: bufsize = 100 ! Sets maximum size of coded and decoded strings, adjust as necessary |
integer, parameter :: bufsize = 100 ! Sets maximum size of coded and decoded strings, adjust as necessary |
||
character(bufsize) :: teststr = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
character(bufsize) :: teststr = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
character(bufsize) :: codedstr = "" |
character(bufsize) :: codedstr = "", decodedstr = "" |
||
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 , decodedstr = "" |
|||
call Encode(teststr, codedstr) |
call Encode(teststr, codedstr) |
||
Line 1,829: | Line 2,784: | ||
end do |
end do |
||
end subroutine |
end subroutine |
||
end program</ |
end program</syntaxhighlight> |
||
Output: |
|||
<pre> |
|||
12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|FreeBASIC}}== |
|||
<syntaxhighlight lang="freebasic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
La salida es similar a la de [[#BASIC|BASIC]], mostrada arriba. |
|||
=={{header|FutureBasic}}== |
|||
This gives RLE encoding for strings and RLE decoding for strings and arrays, e.g., for [[Conway's_Game_of_Life|Conway's Game of Life]] |
|||
<syntaxhighlight lang=FutureBasic> |
|||
local fn encode( string as CFStringRef) as CFStringRef |
|||
CFStringRef ch, s, t |
|||
Short i, rl |
|||
s = @"" // Initalize the output string |
|||
for i = 0 to len( string ) - 1 // Encode string char by char |
|||
ch = mid( string, i, 1) // Read character at index |
|||
rl = 1 // Start run-length counter |
|||
while fn StringIsEqual( mid( string, i + rl, 1), ch ) |
|||
rl ++ // Same char, so increase counter |
|||
wend |
|||
if rl == 1 then t = @"" else t = fn StringWithFormat( @"%d", rl ) // Counter as string, don't encode 1's |
|||
t = fn StringByAppendingString( t, ch ) // Add character |
|||
s = fn StringByAppendingString( s, t ) // Add to already encoded string |
|||
i += rl - 1 // Move index |
|||
next |
|||
print s |
|||
end fn |
|||
local fn decode( string as CFStringRef ) |
|||
CFStringRef ch, s, t // character, outputstring, temporary string |
|||
Short i, rl // index, run length |
|||
s = @"" // Initalize the output string |
|||
for i = 0 to len( string ) - 1 // Decode input string char by char |
|||
ch = mid( string, i, 1 ) // Read character at index |
|||
if intval( ch ) == 0 // Not a digit |
|||
rl = 1 |
|||
else |
|||
rl = intval( mid( string, i ) ) // Read run-length |
|||
i += fix( log10( rl ) + 1 ) // Move index past digits |
|||
ch = mid( string, i, 1 ) // Read character after run length |
|||
end if |
|||
t = fn StringByPaddingToLength( ch, rl, ch, 0 ) // Assemble temp string |
|||
s = fn StringByAppendingString( s, t ) // Add to decoded string |
|||
next |
|||
print s |
|||
end fn |
|||
local fn decode2D( string as CFStringRef ) // For Conway's Game of Life objects |
|||
Boolean a(500, 500) // Or larger to hold bigger life forms |
|||
CFStringRef ch |
|||
Short i, j, rl, f // Decoded char |
|||
Short v = 0, w = 0, x = 0, y = 0 // Temp width, max width, array coordinates |
|||
for i = 0 to len( string ) - 2 // Final char is always ! |
|||
ch = mid( string, i, 1 ) |
|||
if intval( ch ) == 0 |
|||
rl = 1 |
|||
else |
|||
rl = intval( mid( string, i ) ) |
|||
i += fix( log10( rl ) + 1 ) |
|||
ch = mid( string, i, 1 ) |
|||
end if |
|||
select ch // Decode character as: |
|||
case @"$" : f = -1 // - new line |
|||
case @"b" : f = 0 // - dead |
|||
case @"o" : f = 1 // - live |
|||
case else : // Ignore |
|||
end select |
|||
for j = 1 to rl // Fill array with run of chars |
|||
if f = -1 |
|||
x = 0 : y ++ : v = 0 // New line |
|||
else |
|||
a(x, y) = f |
|||
x ++ : v ++ : if v > w then w = v |
|||
end if |
|||
next |
|||
next |
|||
for j = 0 to y : for i = 0 to w - 1 |
|||
print a(i, j); |
|||
next : print : next |
|||
end fn |
|||
fn decode( @"12W1B12W3B24W1B14W" ) // Assignment |
|||
fn encode( @"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" ) |
|||
fn decode2D( @"bo$2bo$3o!" ) // Glider |
|||
handleevents // Join Mac event loop |
|||
</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
12WB12W3B24WB14W |
|||
011 |
|||
001 |
|||
111 |
|||
</pre> |
|||
=={{header|Gambas}}== |
=={{header|Gambas}}== |
||
'''[https://gambas-playground.proko.eu/?gist=b30707043cb64effba91a2edc4d4be94 Click this link to run this code]''' |
'''[https://gambas-playground.proko.eu/?gist=b30707043cb64effba91a2edc4d4be94 Click this link to run this code]''' |
||
< |
<syntaxhighlight lang="gambas">Public Sub Main() |
||
Dim sString As String = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
Dim sString As String = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
Dim siCount As Short = 1 |
Dim siCount As Short = 1 |
||
Line 1,855: | Line 2,971: | ||
Print sString & gb.NewLine & sHold.Join(", ") |
Print sString & gb.NewLine & sHold.Join(", ") |
||
End</ |
End</syntaxhighlight> |
||
Output: |
Output: |
||
<pre> |
<pre> |
||
Line 1,864: | Line 2,980: | ||
=={{header|Go}}== |
=={{header|Go}}== |
||
Decoder kind of necessary to demonstrate task requirement that I can recreate the input. |
Decoder kind of necessary to demonstrate task requirement that I can recreate the input. |
||
< |
<syntaxhighlight lang="go">package main |
||
import "fmt" |
import "fmt" |
||
Line 1,934: | Line 3,050: | ||
} |
} |
||
return string(d) |
return string(d) |
||
}</ |
}</syntaxhighlight> |
||
Output: |
Output: |
||
<pre> |
<pre> |
||
Line 1,944: | Line 3,060: | ||
=={{header|Groovy}}== |
=={{header|Groovy}}== |
||
< |
<syntaxhighlight lang="groovy">def rleEncode(text) { |
||
def encoded = new StringBuilder() |
def encoded = new StringBuilder() |
||
(text =~ /(([A-Z])\2*)/).each { matcher -> |
(text =~ /(([A-Z])\2*)/).each { matcher -> |
||
Line 1,958: | Line 3,074: | ||
} |
} |
||
decoded.toString() |
decoded.toString() |
||
}</ |
}</syntaxhighlight> |
||
Test code |
Test code |
||
< |
<syntaxhighlight lang="groovy">def text = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
||
def rleEncoded = rleEncode(text) |
def rleEncoded = rleEncode(text) |
||
assert rleEncoded == '12W1B12W3B24W1B14W' |
assert rleEncoded == '12W1B12W3B24W1B14W' |
||
Line 1,966: | Line 3,082: | ||
println "Original Text: $text" |
println "Original Text: $text" |
||
println "Encoded Text: $rleEncoded"</ |
println "Encoded Text: $rleEncoded"</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>Original Text: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>Original Text: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 1,972: | Line 3,088: | ||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
=== |
===In terms of group=== |
||
< |
<syntaxhighlight lang="haskell">import Data.List (group) |
||
import Control.Arrow ((&&&)) |
|||
-- Datatypes |
-- Datatypes |
||
type Encoded = [(Int, Char)] |
type Encoded = [(Int, Char)] -- An encoded String with form [(times, char), ...] |
||
type Decoded = String |
type Decoded = String |
||
-- Takes a decoded string and returns an encoded list of tuples |
-- Takes a decoded string and returns an encoded list of tuples |
||
rlencode :: Decoded -> Encoded |
rlencode :: Decoded -> Encoded |
||
rlencode = |
rlencode = fmap ((,) <$> length <*> head) . group |
||
-- Takes an encoded list of tuples and returns the associated decoded String |
-- Takes an encoded list of tuples and returns the associated decoded String |
||
Line 1,990: | Line 3,106: | ||
main :: IO () |
main :: IO () |
||
main = do |
main = do |
||
let input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
-- Get input |
|||
-- Output encoded and decoded versions of input |
|||
putStr "String to encode: " |
|||
encoded = rlencode input |
|||
input <- getLine |
|||
-- Output encoded and decoded versions of input |
|||
let encoded = rlencode input |
|||
decoded = rldecode encoded |
decoded = rldecode encoded |
||
putStrLn $ "Encoded: " |
putStrLn $ "Encoded: " <> show encoded <> "\nDecoded: " <> show decoded</syntaxhighlight> |
||
{{Out}} |
|||
===Version 2=== |
|||
<pre>Encoded: [(12,'W'),(1,'B'),(12,'W'),(3,'B'),(24,'W'),(1,'B'),(14,'W')] |
|||
<lang Haskell> |
|||
Decoded: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</pre> |
|||
import Data.List |
|||
import Data.Char |
|||
Or: |
|||
runLengthEncode = concatMap (\xs@(x:_) -> (show.length $ xs) ++ [x]).group |
|||
<syntaxhighlight lang="haskell">import Data.Char (isDigit) |
|||
runLengthDecode = concat.uncurry (zipWith (\[x] ns -> replicate (read ns) x)) |
|||
import Data.List (group, groupBy) |
|||
.foldr (\z (x,y) -> (y,z:x)) ([],[]).groupBy (\x y -> all isDigit [x,y]) |
|||
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 |
main = do |
||
let text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
encode = runLengthEncode text |
|||
decode = runLengthDecode encode |
|||
mapM_ putStrLn [text, encode, decode] |
|||
putStrLn $ "test: text == decode => " <> show (text == decode)</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre>WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
<pre> |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
12W1B12W3B24W1B14W |
12W1B12W3B24W1B14W |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
test: text == decode => True |
test: text == decode => True</pre> |
||
</pre> |
|||
===In terms of span=== |
|||
<syntaxhighlight lang="haskell">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</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>W12B1W12B3W24B1W14 |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
True</pre> |
|||
===As a fold=== |
|||
<syntaxhighlight lang="haskell">----------------------- 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</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>12W1B12W3B24W1B14W |
|||
True</pre> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
=={{header|Icon}} and {{header|Unicon}}== |
||
< |
<syntaxhighlight lang="icon">procedure main(arglist) |
||
s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
s := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
Line 2,048: | Line 3,237: | ||
procedure Repl(n, c) |
procedure Repl(n, c) |
||
return repl(c,n) |
return repl(c,n) |
||
end</ |
end</syntaxhighlight> |
||
Sample output: |
Sample output: |
||
Line 2,058: | Line 3,247: | ||
=={{header|J}}== |
=={{header|J}}== |
||
'''Solution:''' |
'''Solution:''' |
||
< |
<syntaxhighlight lang="j">rle=: ;@(<@(":@(#-.1:),{.);.1~ 1, 2 ~:/\ ]) |
||
rld=: ;@(-.@e.&'0123456789' <@({:#~1{.@,~".@}:);.2 ])</ |
rld=: ;@(-.@e.&'0123456789' <@({:#~1{.@,~".@}:);.2 ])</syntaxhighlight> |
||
'''Example:''' |
'''Example:''' |
||
< |
<syntaxhighlight lang="j"> rle 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
||
12W1B12W3B24W1B14W |
12W1B12W3B24W1B14W |
||
rld '12W1B12W3B24W1B14W' |
rld '12W1B12W3B24W1B14W' |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</ |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</syntaxhighlight> |
||
Note that this implementation fails for the empty case. Here's a version that fixes that: |
Note that this implementation fails for the empty case. Here's a version that fixes that: |
||
< |
<syntaxhighlight lang="j">rle=: ;@(<@(":@#,{.);.1~ 2 ~:/\ (a.{.@-.{.),])</syntaxhighlight> |
||
Other approaches include using <nowiki>rle ::(''"_)</nowiki> or <nowiki>rle^:(*@#)</nowiki> or equivalent variations on the original sentence. |
Other approaches include using <nowiki>rle ::(''"_)</nowiki> or <nowiki>rle^:(*@#)</nowiki> or equivalent variations on the original sentence. |
||
Line 2,078: | Line 3,267: | ||
A numeric approach, based on a discussion in the J forums (primarily [http://jsoftware.com/pipermail/programming/2015-June/042139.html Pascal Jasmin] and [http://jsoftware.com/pipermail/programming/2015-June/042141.html Marshall Lochbaum]): |
A numeric approach, based on a discussion in the J forums (primarily [http://jsoftware.com/pipermail/programming/2015-June/042139.html Pascal Jasmin] and [http://jsoftware.com/pipermail/programming/2015-June/042141.html Marshall Lochbaum]): |
||
< |
<syntaxhighlight lang="j"> torle=: (#, {.);.1~ 1,2 ~:/\ ] |
||
frle=: #/@|:</ |
frle=: #/@|:</syntaxhighlight> |
||
Task example: |
Task example: |
||
< |
<syntaxhighlight lang="j"> torle a.i.'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
||
12 87 |
12 87 |
||
1 66 |
1 66 |
||
Line 2,092: | Line 3,281: | ||
14 87 |
14 87 |
||
u: frle torle a.i.'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
u: frle torle a.i.'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</ |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</syntaxhighlight> |
||
Note that this approach also fails on the empty case. |
Note that this approach also fails on the empty case. |
||
=={{header|Java}}== |
=={{header|Java}}== |
||
This can be achieved using regular expression capturing |
|||
<lang java>import java.util.regex.Matcher; |
|||
<syntaxhighlight lang="java"> |
|||
import java.util.regex.Matcher; |
|||
import java.util.regex.Pattern; |
|||
</syntaxhighlight> |
|||
<syntaxhighlight lang="java"> |
|||
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(); |
|||
} |
|||
</syntaxhighlight> |
|||
<syntaxhighlight lang="java"> |
|||
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(); |
|||
} |
|||
</syntaxhighlight> |
|||
<pre> |
|||
string = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
encoded = 12W1B12W3B24W1B14W |
|||
decoded = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
string.equals(decoded) = true |
|||
string = https://www.rosettacode.org/ |
|||
encoded = 1h2t1p1s1:2/3w1.1r1o1s1e2t1a1c1o1d1e1.1o1r1g1/ |
|||
decoded = https://www.rosettacode.org/ |
|||
string.equals(decoded) = true |
|||
</pre> |
|||
<br /> |
|||
An alternate demonstration |
|||
<syntaxhighlight lang="java">import java.util.regex.Matcher; |
|||
import java.util.regex.Pattern; |
import java.util.regex.Pattern; |
||
public class RunLengthEncoding { |
public class RunLengthEncoding { |
||
Line 2,134: | Line 3,366: | ||
System.out.println(decode("1W1B1W1B1W1B1W1B1W1B1W1B1W1B")); |
System.out.println(decode("1W1B1W1B1W1B1W1B1W1B1W1B1W1B")); |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
Tests: |
Tests: |
||
{{libheader|JUnit}} |
{{libheader|JUnit}} |
||
< |
<syntaxhighlight lang="java">import static org.junit.Assert.assertEquals; |
||
import org.junit.Test; |
import org.junit.Test; |
||
Line 2,169: | Line 3,401: | ||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
=={{header|JavaScript}}== |
=={{header|JavaScript}}== |
||
===ES5=== |
|||
Here's an encoding method that walks the input string character by character |
Here's an encoding method that walks the input string character by character |
||
< |
<syntaxhighlight lang="javascript">function encode(input) { |
||
var encoding = []; |
var encoding = []; |
||
var prev, count, i; |
var prev, count, i; |
||
Line 2,187: | Line 3,420: | ||
encoding.push([count, prev]); |
encoding.push([count, prev]); |
||
return encoding; |
return encoding; |
||
}</ |
}</syntaxhighlight> |
||
Here's an encoding method that uses a regular expression to grab the character runs ({{works with|JavaScript|1.6}} for the <code>forEach</code> method) |
Here's an encoding method that uses a regular expression to grab the character runs ({{works with|JavaScript|1.6}} for the <code>forEach</code> method) |
||
< |
<syntaxhighlight lang="javascript">function encode_re(input) { |
||
var encoding = []; |
var encoding = []; |
||
input.match(/(.)\1*/g).forEach(function(substr){ encoding.push([substr.length, substr[0]]) }); |
input.match(/(.)\1*/g).forEach(function(substr){ encoding.push([substr.length, substr[0]]) }); |
||
return encoding; |
return encoding; |
||
}</ |
}</syntaxhighlight> |
||
And to decode (see [[Repeating a string#JavaScript|Repeating a string]]) |
And to decode (see [[Repeating a string#JavaScript|Repeating a string]]) |
||
< |
<syntaxhighlight lang="javascript">function decode(encoded) { |
||
var output = ""; |
var output = ""; |
||
encoded.forEach(function(pair){ output += new Array(1+pair[0]).join(pair[1]) }) |
encoded.forEach(function(pair){ output += new Array(1+pair[0]).join(pair[1]) }) |
||
return output; |
return output; |
||
}</ |
}</syntaxhighlight> |
||
===ES6=== |
|||
By defining a generic ''group'' function: |
|||
<syntaxhighlight lang="javascript">(() => { |
|||
'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(); |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>From: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
-> [[12,"W"],[1,"B"],[12,"W"],[3,"B"],[24,"W"],[1,"B"],[14,"W"]] |
|||
-> "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</pre> |
|||
A <code>.reduce()</code> based one-liner |
|||
<syntaxhighlight lang="javascript"> |
|||
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") |
|||
</syntaxhighlight> |
|||
=={{header|jq}}== |
=={{header|jq}}== |
||
Line 2,207: | Line 3,505: | ||
'''Utility function:''' |
'''Utility function:''' |
||
< |
<syntaxhighlight lang="jq">def runs: |
||
reduce .[] as $item |
reduce .[] as $item |
||
( []; |
( []; |
||
Line 2,215: | Line 3,513: | ||
else . + [[$item, 1]] |
else . + [[$item, 1]] |
||
end |
end |
||
end ) ;</ |
end ) ;</syntaxhighlight> |
||
'''Run-length encoding and decoding''': |
'''Run-length encoding and decoding''': |
||
< |
<syntaxhighlight lang="jq">def run_length_encode: |
||
explode | runs | reduce .[] as $x (""; . + "\($x[1])\([$x[0]]|implode)"); |
explode | runs | reduce .[] as $x (""; . + "\($x[1])\([$x[0]]|implode)"); |
||
Line 2,225: | Line 3,523: | ||
($pair[0:-1] | tonumber) as $n |
($pair[0:-1] | tonumber) as $n |
||
| $pair[-1:] as $letter |
| $pair[-1:] as $letter |
||
| . + ($n * $letter)) ;</ |
| . + ($n * $letter)) ;</syntaxhighlight> |
||
'''Example''': |
'''Example''': |
||
< |
<syntaxhighlight lang="jq">"ABBCCC" | run_length_encode | run_length_decode</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
< |
<syntaxhighlight lang="sh">$ jq -n -f Run_length_encoding.jq |
||
"ABBCCC"</ |
"ABBCCC"</syntaxhighlight> |
||
=={{header|Julia}}== |
=={{header|Julia}}== |
||
{{works with|Julia|0.6}} |
{{works with|Julia|0.6}} |
||
< |
<syntaxhighlight lang="julia">using IterTools |
||
encode(str::String) = collect((length(g), first(g)) for g in groupby(first, str)) |
encode(str::String) = collect((length(g), first(g)) for g in groupby(first, str)) |
||
Line 2,244: | Line 3,542: | ||
decoded = decode(encoded) |
decoded = decode(encoded) |
||
println("Original: $original\n -> encoded: $encoded\n -> decoded: $decoded") |
println("Original: $original\n -> encoded: $encoded\n -> decoded: $decoded") |
||
end</ |
end</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 2,256: | Line 3,554: | ||
=={{header|K}}== |
=={{header|K}}== |
||
< |
<syntaxhighlight lang="k">rle: {,/($-':i,#x),'x@i:&1,~=':x}</syntaxhighlight> |
||
{{trans|J}} |
{{trans|J}} |
||
< |
<syntaxhighlight lang="k">rld: {d:"0123456789"; ,/(.(d," ")@d?/:x)#'x _dvl d}</syntaxhighlight> |
||
'''Example:''' |
'''Example:''' |
||
< |
<syntaxhighlight lang="k"> rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
"12W1B12W3B24W1B14W" |
"12W1B12W3B24W1B14W" |
||
rld "12W1B12W3B24W1B14W" |
rld "12W1B12W3B24W1B14W" |
||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</ |
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</syntaxhighlight> |
||
=={{header|Kotlin}}== |
=={{header|Kotlin}}== |
||
Tail recursive implementation of Run Length Encoding |
Tail recursive implementation of Run Length Encoding |
||
< |
<syntaxhighlight lang="scala">tailrec fun runLengthEncoding(text:String,prev:String=""):String { |
||
if (text.isEmpty()){ |
if (text.isEmpty()){ |
||
return prev |
return prev |
||
Line 2,284: | Line 3,582: | ||
assert(runLengthEncoding("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
assert(runLengthEncoding("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
||
== "12W1B12W3B24W1B14W") |
== "12W1B12W3B24W1B14W") |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Lasso}}== |
=={{header|Lasso}}== |
||
< |
<syntaxhighlight lang="lasso">define rle(str::string)::string => { |
||
local(orig = #str->values->asCopy,newi=array, newc=array, compiled=string) |
local(orig = #str->values->asCopy,newi=array, newc=array, compiled=string) |
||
while(#orig->size) => { |
while(#orig->size) => { |
||
Line 2,333: | Line 3,631: | ||
rlde('12W1B12W3B24W1B14W') |
rlde('12W1B12W3B24W1B14W') |
||
rlde('1d1s1f1k1j2h1k1d1s1j1f1h1d1s1k1h1s1h1d2j1f2h1d1l1s2l1w')</ |
rlde('1d1s1f1k1j2h1k1d1s1j1f1h1d1s1k1h1s1h1d2j1f2h1d1l1s2l1w')</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 2,344: | Line 3,642: | ||
=={{header|Liberty BASIC}}== |
=={{header|Liberty BASIC}}== |
||
< |
<syntaxhighlight lang="lb">mainwin 100 20 |
||
'In$ ="aaaaaaaaaaaaaaaaaccbbbbbbbbbbbbbbba" ' testing... |
'In$ ="aaaaaaaaaaaaaaaaaccbbbbbbbbbbbbbbba" ' testing... |
||
Line 2,391: | Line 3,689: | ||
next i |
next i |
||
Decoded$ =r$ |
Decoded$ =r$ |
||
end function</ |
end function</syntaxhighlight> |
||
=={{header|LiveCode}}== |
=={{header|LiveCode}}== |
||
< |
<syntaxhighlight lang="livecode">function rlEncode str |
||
local charCount |
local charCount |
||
put 1 into charCount |
put 1 into charCount |
||
Line 2,436: | Line 3,734: | ||
end repeat |
end repeat |
||
return repStr |
return repStr |
||
end repeatString</ |
end repeatString</syntaxhighlight> |
||
=={{header|Logo}}== |
=={{header|Logo}}== |
||
< |
<syntaxhighlight lang="logo">to encode :str [:out "||] [:count 0] [:last first :str] |
||
if empty? :str [output (word :out :count :last)] |
if empty? :str [output (word :out :count :last)] |
||
if equal? first :str :last [output (encode bf :str :out :count+1 :last)] |
if equal? first :str :last [output (encode bf :str :out :count+1 :last)] |
||
Line 2,457: | Line 3,754: | ||
make "foo "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
make "foo "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
make "rle encode :foo |
make "rle encode :foo |
||
show equal? :foo decode :rle</ |
show equal? :foo decode :rle</syntaxhighlight> |
||
=={{header|Lua}}== |
=={{header|Lua}}== |
||
< |
<syntaxhighlight lang="lua">local C, Ct, R, Cf, Cc = lpeg.C, lpeg.Ct, lpeg.R, lpeg.Cf, lpeg.Cc |
||
astable = Ct(C(1)^0) |
astable = Ct(C(1)^0) |
||
Line 2,491: | Line 3,788: | ||
end |
end |
||
return ret |
return ret |
||
end</ |
end</syntaxhighlight> |
||
=={{header| |
=={{header|M2000 Interpreter}}== |
||
<syntaxhighlight lang="m2000 interpreter"> |
|||
Custom functions using Map, Apply, pure functions, replacing using pattern matching, delayed rules and other functions: |
|||
Module RLE_example { |
|||
<lang Mathematica>RunLengthEncode[input_String]:=StringJoin@@Sequence@@@({ToString @Length[#],First[#]}&/@Split[Characters[input]]) |
|||
inp$="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
RunLengthDecode[input_String]:=StringJoin@@ConstantArray@@@Reverse/@Partition[(Characters[input]/.(ToString[#]->#&/@Range[0,9]))//.{x___,i_Integer,j_Integer,y___}:>{x,10i+j,y},2]</lang> |
|||
Print "Input: ";inp$ |
|||
Example: |
|||
Function RLE$(r$){ |
|||
<lang Mathematica>mystring="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
|||
Function rle_run$(&r$) { |
|||
RunLengthEncode[mystring] |
|||
if len(r$)=0 then exit |
|||
RunLengthDecode[%] |
|||
p=1 |
|||
%==mystring</lang> |
|||
c$=left$(r$,1) |
|||
gives back: |
|||
while c$=mid$(r$, p, 1) {p++} |
|||
<lang Mathematica>12W1B12W3B24W1B14W |
|||
=format$("{0}{1}",p-1, c$) |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
r$=mid$(r$, p) |
|||
True</lang> |
|||
} |
|||
An alternate solution: |
|||
def repl$ |
|||
<lang Mathematica>RunLengthEncode[s_String] := StringJoin[ |
|||
while len(r$)>0 {repl$+=rle_run$(&r$)} |
|||
{ToString[Length[#]] <> First[#]} & /@ Split[StringSplit[s, ""]] |
|||
=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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
RunLengthDecode[s_String] := StringJoin[ |
|||
<pre style="height:30ex;overflow:scroll"> |
|||
Table[#[[2]], {ToExpression[#[[1]]]}] & /@ |
|||
Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Partition[StringSplit[s, x : _?LetterQ :> x], 2] |
|||
RLE Encoded: 12W1B12W3B24W1B14W |
|||
]</lang> |
|||
RLE Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
This second encode function is adapted from the MathWorld example. |
|||
Checked: True |
|||
</pre > |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
The function |
|||
<syntaxhighlight lang="mathematica">RunLengthEncode[input_String]:= (l |-> {First@l, Length@l}) /@ (Split@Characters@input)</syntaxhighlight> |
|||
takes as input an arbitrary string of characters and returns a list of {c, n} pairs, where c is the character and n is the number of repeats. The function |
|||
<syntaxhighlight lang="mathematica">RunLengthDecode[input_List]:= ConstantArray @@@ input // Flatten // StringJoin</syntaxhighlight> |
|||
recreates the string. |
|||
Example: For the string |
|||
<syntaxhighlight lang="mathematica">mystring="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";</syntaxhighlight> |
|||
here is the run-length encoding: |
|||
<syntaxhighlight lang="mathematica">rle = RunLengthEncode[mystring] |
|||
{{"W", 12}, {"B", 1}, {"W", 12}, {"B", 3}, {"W", 24}, {"B", 1}, {"W", 14}}</syntaxhighlight> |
|||
Check that the input string is recreated: |
|||
<syntaxhighlight lang="mathematica">mystring == RunLengthDecode[rle] |
|||
True</syntaxhighlight> |
|||
=={{header|Maxima}}== |
=={{header|Maxima}}== |
||
To encode |
|||
<lang maxima>rle(a) := block( |
|||
<syntaxhighlight lang="maxima">rle(a) := block( |
|||
[n: slength(a), b: "", c: charat(a, 1), k: 1], |
[n: slength(a), b: "", c: charat(a, 1), k: 1], |
||
for i from 2 thru n do |
for i from 2 thru n do |
||
Line 2,524: | Line 3,870: | ||
sconcat(b, k, c) |
sconcat(b, k, c) |
||
)$ |
)$ |
||
</syntaxhighlight> |
|||
To decode |
|||
<syntaxhighlight lang="maxima"> |
|||
/* Function to return a list where all but the last entries are integers */ |
|||
intbucket(lst):=block(bucket:[],while integerp(first(lst)) do (push(first(lst),bucket),lst:rest(lst)),lst:append(reverse(bucket),[first(lst)])); |
|||
/* Run-length decoding */ |
|||
rld(string_list):=block( |
|||
coref:map(eval_string,charlist(string_list)), |
|||
listcharact:sublist(coref,lambda([x],integerp(x)=false)), |
|||
map(intbucket,append([coref],makelist(coref:rest(coref,length(intbucket(coref))),length(listcharact)-1))), |
|||
makelist(sublist(%%[i],integerp),i,1,length(%%)), |
|||
map(eval_string,makelist(apply(concat,%%[i]),i,1,length(%%))), |
|||
makelist(smake(%%[i],string(listcharact[i])),i,1,length(listcharact)), |
|||
apply(concat,%%)); |
|||
</syntaxhighlight> |
|||
Output |
|||
<syntaxhighlight lang="maxima"> |
|||
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"); |
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"); |
||
"12W1B12W3B24W1B14W" |
"12W1B12W3B24W1B14W" |
||
rld(%); |
|||
/* "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" */ |
|||
</syntaxhighlight> |
|||
=={{header|MMIX}}== |
=={{header|MMIX}}== |
||
< |
<syntaxhighlight lang="mmix"> LOC Data_Segment |
||
GREG @ |
GREG @ |
||
Buf OCTA 0,0,0,0 integer print buffer |
Buf OCTA 0,0,0,0 integer print buffer |
||
Line 2,638: | Line 4,006: | ||
2H SET $4,#a print NL |
2H SET $4,#a print NL |
||
GO $127,PChar |
GO $127,PChar |
||
TRAP 0,Halt,0 EXIT</ |
TRAP 0,Halt,0 EXIT</syntaxhighlight> |
||
Example run encode --> decode: |
Example run encode --> decode: |
||
<pre>~/MIX/MMIX/Rosetta> mmix rle |
<pre>~/MIX/MMIX/Rosetta> mmix rle |
||
Line 2,646: | Line 4,014: | ||
=={{header|Nim}}== |
=={{header|Nim}}== |
||
{{trans|Python}} |
{{trans|Python}} |
||
< |
<syntaxhighlight lang="nim">import parseutils, strutils |
||
proc compress(input: string): string = |
|||
type RunLength = tuple[c: char, n: int] |
|||
var |
|||
count = 1 |
|||
prev = '\0' |
|||
for ch in input: |
|||
proc encode(inp): seq[RunLength] = |
|||
if ch != prev: |
|||
if prev != '\0': |
|||
var count = 1 |
|||
result.add $count & prev |
|||
var prev: char |
|||
for c in inp: |
|||
if c != prev: |
|||
if prev != chr(0): |
|||
result.add((prev,count)) |
|||
count = 1 |
count = 1 |
||
prev = |
prev = ch |
||
else: |
else: |
||
inc |
inc count |
||
result.add |
result.add $count & prev |
||
proc |
proc uncompress(text: string): string = |
||
var start = 0 |
|||
var count: int |
|||
for x in lst: |
|||
while true: |
|||
result.add(repeatChar(x.n, x.c)) |
|||
let n = text.parseInt(count, start) |
|||
if n == 0 or start + n >= text.len: |
|||
raise newException(ValueError, "corrupted data.") |
|||
inc start, n |
|||
result.add repeat(text[start], count) |
|||
inc start |
|||
if start == text.len: break |
|||
echo encode("aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa") |
|||
const Text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
echo decode([('a', 5), ('h', 6), ('m', 7), ('u', 1), ('i', 7), ('a', 6)])</lang> |
|||
echo "Text: ", Text |
|||
let compressed = Text.compress() |
|||
echo "Compressed: ", compressed |
|||
echo "Uncompressed: ", compressed.uncompress()</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Text: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Compressed: 12W1B12W3B24W1B14W |
|||
Uncompressed: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
|||
=={{header|Objeck}}== |
=={{header|Objeck}}== |
||
< |
<syntaxhighlight lang="objeck">use RegEx; |
||
class RunLengthEncoding { |
class RunLengthEncoding { |
||
Line 2,725: | Line 4,108: | ||
return output; |
return output; |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
<pre>encoding: 12W1B12W3B24W1B14W |
<pre>encoding: 12W1B12W3B24W1B14W |
||
Line 2,735: | Line 4,118: | ||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
< |
<syntaxhighlight lang="ocaml">let encode str = |
||
let len = String.length str in |
let len = String.length str in |
||
let rec aux i acc = |
let rec aux i acc = |
||
Line 2,757: | Line 4,140: | ||
let decode lst = |
let decode lst = |
||
let l = List.map (fun (c,n) -> String.make n c) lst in |
let l = List.map (fun (c,n) -> String.make n c) lst in |
||
(String.concat "" l)</ |
(String.concat "" l)</syntaxhighlight> |
||
< |
<syntaxhighlight lang="ocaml">let () = |
||
let e = encode "aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa" in |
let e = encode "aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa" in |
||
List.iter (fun (c,n) -> |
List.iter (fun (c,n) -> |
||
Line 2,765: | Line 4,148: | ||
) e; |
) e; |
||
print_endline (decode [('a', 5); ('h', 6); ('m', 7); ('u', 1); ('i', 7); ('a', 6)]); |
print_endline (decode [('a', 5); ('h', 6); ('m', 7); ('u', 1); ('i', 7); ('a', 6)]); |
||
;;</ |
;;</syntaxhighlight> |
||
;Using regular expressions |
;Using regular expressions |
||
< |
<syntaxhighlight lang="ocaml">#load "str.cma";; |
||
open Str |
open Str |
||
Line 2,784: | Line 4,167: | ||
let () = |
let () = |
||
print_endline (encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"); |
print_endline (encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"); |
||
print_endline (decode "12W1B12W3B24W1B14W");</ |
print_endline (decode "12W1B12W3B24W1B14W");</syntaxhighlight> |
||
=={{header|Oforth}}== |
=={{header|Oforth}}== |
||
< |
<syntaxhighlight lang="oforth">: encode(s) |
||
StringBuffer new |
StringBuffer new |
||
s group apply(#[ tuck size asString << swap first <<c ]) ; |
s group apply(#[ tuck size asString << swap first <<c ]) ; |
||
Line 2,799: | Line 4,182: | ||
loop: i [ c <<c ] 0 |
loop: i [ c <<c ] 0 |
||
] |
] |
||
drop ;</ |
drop ;</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 2,811: | Line 4,194: | ||
</pre> |
</pre> |
||
=={{header|Ol}}== |
|||
<syntaxhighlight lang="scheme"> |
|||
(define (RLE str) |
|||
(define iter (string->list str)) |
|||
(let loop ((iter iter) (chr (car iter)) (n 0) (rle '())) |
|||
(cond |
|||
((null? iter) |
|||
(reverse (cons (cons n chr) rle))) |
|||
((char=? chr (car iter)) |
|||
(loop (cdr iter) chr (+ n 1) rle)) |
|||
(else |
|||
(loop (cdr iter) (car iter) 1 (cons (cons n chr) rle)))))) |
|||
(define (decode rle) |
|||
(apply string-append (map (lambda (p) |
|||
(make-string (car p) (cdr p))) rle))) |
|||
</syntaxhighlight> |
|||
Test: |
|||
<syntaxhighlight lang="scheme"> |
|||
(define str "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
|||
(print str) |
|||
(define rle (RLE str)) |
|||
(for-each (lambda (pair) |
|||
(print (car pair) " : " (string (cdr pair)))) |
|||
rle) |
|||
(print (decode rle)) |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
12 : W |
|||
1 : B |
|||
12 : W |
|||
3 : B |
|||
24 : W |
|||
1 : B |
|||
14 : W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|Oz}}== |
=={{header|Oz}}== |
||
< |
<syntaxhighlight lang="oz">declare |
||
fun {RLEncode Xs} |
fun {RLEncode Xs} |
||
for G in {Group Xs} collect:C do |
for G in {Group Xs} collect:C do |
||
Line 2,848: | Line 4,271: | ||
{System.showInfo Data} |
{System.showInfo Data} |
||
{Show Enc} |
{Show Enc} |
||
{System.showInfo {RLDecode Enc}}</ |
{System.showInfo {RLDecode Enc}}</syntaxhighlight> |
||
=={{header|PARI/GP}}== |
=={{header|PARI/GP}}== |
||
< |
<syntaxhighlight lang="parigp">rle(s)={ |
||
if(s=="", return(s)); |
if(s=="", return(s)); |
||
my(v=Vec(s),cur=v[1],ct=1,out=""); |
my(v=Vec(s),cur=v[1],ct=1,out=""); |
||
Line 2,880: | Line 4,304: | ||
}; |
}; |
||
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
||
elr(%)</ |
elr(%)</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>%1 = "12W1B12W3B24W1B14W" |
<pre>%1 = "12W1B12W3B24W1B14W" |
||
Line 2,887: | Line 4,311: | ||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
< |
<syntaxhighlight lang="pascal">Program RunLengthEncoding(output); |
||
procedure encode(s: string; var counts: array of integer; var letters: string); |
procedure encode(s: string; var counts: array of integer; var letters: string); |
||
Line 2,937: | Line 4,361: | ||
decode(s, counts, letters); |
decode(s, counts, letters); |
||
writeln(s); |
writeln(s); |
||
end.</ |
end.</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>:> ./RunLengthEncoding |
<pre>:> ./RunLengthEncoding |
||
Line 2,949: | Line 4,373: | ||
Simple version using ASCII numerals as length markers, like the example in the task description (won't work correctly on input strings that already contain digits): |
Simple version using ASCII numerals as length markers, like the example in the task description (won't work correctly on input strings that already contain digits): |
||
< |
<syntaxhighlight lang="perl">sub encode { |
||
shift =~ s/(.)\1*/length($&).$1/grse; |
shift =~ s/(.)\1*/length($&).$1/grse; |
||
} |
} |
||
Line 2,955: | Line 4,379: | ||
sub decode { |
sub decode { |
||
shift =~ s/(\d+)(.)/$2 x $1/grse; |
shift =~ s/(\d+)(.)/$2 x $1/grse; |
||
}</ |
}</syntaxhighlight> |
||
Modified version that can take arbitrary byte strings as input (produces encoded byte strings that are compatible with the [[#C|C solution]]): |
Modified version that can take arbitrary byte strings as input (produces encoded byte strings that are compatible with the [[#C|C solution]]): |
||
< |
<syntaxhighlight lang="perl">sub encode { |
||
shift =~ s/(.)\1{0,254}/pack("C", length($&)).$1/grse; |
shift =~ s/(.)\1{0,254}/pack("C", length($&)).$1/grse; |
||
} |
} |
||
Line 2,965: | Line 4,389: | ||
sub decode { |
sub decode { |
||
shift =~ s/(.)(.)/$2 x unpack("C", $1)/grse; |
shift =~ s/(.)(.)/$2 x unpack("C", $1)/grse; |
||
}</ |
}</syntaxhighlight> |
||
Further modified version that supports compact representation of longer non-repeating substrings, just like the [[#C|C solution]] (so should be fully compatible with that solution for both encoding and decoding): |
Further modified version that supports compact representation of longer non-repeating substrings, just like the [[#C|C solution]] (so should be fully compatible with that solution for both encoding and decoding): |
||
< |
<syntaxhighlight lang="perl">sub encode { |
||
my $str = shift; |
my $str = shift; |
||
my $ret = ""; |
my $ret = ""; |
||
Line 3,000: | Line 4,424: | ||
} |
} |
||
return $ret; |
return $ret; |
||
}</ |
}</syntaxhighlight> |
||
Demonstration of the third version: |
Demonstration of the third version: |
||
< |
<syntaxhighlight lang="perl">use Data::Dump qw(dd); |
||
dd my $str = "XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA"; |
dd my $str = "XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA"; |
||
dd my $enc = encode($str); |
dd my $enc = encode($str); |
||
dd decode($enc);</ |
dd decode($enc);</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 3,015: | Line 4,439: | ||
"XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA" |
"XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA" |
||
</pre> |
</pre> |
||
=={{header|Perl 6}}== |
|||
Note that Perl 6 regexes don't care about unquoted whitespace, and that backrefs |
|||
count from 0, not from 1. |
|||
<lang perl6>sub encode($str) { $str.subst(/(.) $0*/, { $/.chars ~ $0 }, :g) } |
|||
sub decode($str) { $str.subst(/(\d+) (.)/, { $1 x $0 }, :g) } |
|||
my $e = encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'); |
|||
say $e; |
|||
say decode($e);</lang> |
|||
Output: |
|||
<pre>12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
|||
=={{header|Phix}}== |
=={{header|Phix}}== |
||
Based on [[Run-length_encoding#Euphoria|Euphoria]], but uses a few string in place of sequence. |
|||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
<lang Phix>function encode(sequence s) |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
sequence out = {} |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">encode</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
integer prev_char,count = 1 |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> |
|||
if length(s) then |
|||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> |
|||
prev_char = s[1] |
|||
<span style="color: #004080;">integer</span> <span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">],</span> |
|||
for i=2 to length(s) do |
|||
<span style="color: #000000;">count</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> |
|||
if s[i]!=prev_char then |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> |
|||
out &= {count,prev_char} |
|||
<span style="color: #008080;">if</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">ch</span> <span style="color: #008080;">then</span> |
|||
prev_char = s[i] |
|||
<span style="color: #000000;">r</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">count</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">}</span> |
|||
count = 1 |
|||
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> |
|||
else |
|||
<span style="color: #000000;">count</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> |
|||
count += 1 |
|||
<span style="color: #008080;">else</span> |
|||
<span style="color: #000000;">count</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> |
|||
end for |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
out &= {count,prev_char} |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
end if |
|||
<span style="color: #000000;">r</span> <span style="color: #0000FF;">&=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">count</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">}</span> |
|||
return out |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
end function |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">r</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
function decode(sequence s) |
|||
sequence out = {} |
|||
<span style="color: #008080;">function</span> <span style="color: #000000;">decode</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
for i=1 to length(s) by 2 do |
|||
<span style="color: #004080;">string</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span> |
|||
out &= repeat(s[i+1],s[i]) |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">by</span> <span style="color: #000000;">2</span> <span style="color: #008080;">do</span> |
|||
end for |
|||
<span style="color: #000000;">r</span> <span style="color: #0000FF;">&=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span> |
|||
return out |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
end function |
|||
<span style="color: #008080;">return</span> <span style="color: #000000;">r</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span> |
|||
sequence s = encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
|||
pp(s) |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">encode</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</span><span style="color: #0000FF;">)</span> |
|||
?decode(s)</lang> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">s</span> |
|||
<span style="color: #0000FF;">?</span><span style="color: #000000;">decode</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
{{out}} |
||
Note the character hints are desktop/Phix only and don't appear under p2js. |
|||
<pre> |
<pre> |
||
{12,87'W',1,66'B',12,87'W',3,66'B',24,87'W',1,66'B',14,87'W'} |
{12,87'W',1,66'B',12,87'W',3,66'B',24,87'W',1,66'B',14,87'W'} |
||
Line 3,072: | Line 4,483: | ||
=={{header|PHP}}== |
=={{header|PHP}}== |
||
< |
<syntaxhighlight lang="php"><?php |
||
function encode($str) |
function encode($str) |
||
{ |
|||
return preg_replace('/(.)\1*/e', 'strlen($0) . $1', $str); |
|||
return preg_replace_callback('/(.)\1*/', function ($match) { |
|||
return strlen($match[0]) . $match[1]; |
|||
}, $str); |
|||
} |
} |
||
function decode($str) |
function decode($str) |
||
{ |
|||
return preg_replace('/(\d+)(\D)/e', 'str_repeat($2, $1)', $str); |
|||
return preg_replace_callback('/(\d+)(\D)/', function($match) { |
|||
return str_repeat($match[2], $match[1]); |
|||
}, $str); |
|||
} |
} |
||
echo encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'), |
echo encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'), PHP_EOL; |
||
echo decode('12W1B12W3B24W1B14W'), |
echo decode('12W1B12W3B24W1B14W'), PHP_EOL; |
||
?></ |
?></syntaxhighlight> |
||
=={{header|Picat}}== |
|||
===While loop=== |
|||
Quite slow. |
|||
<syntaxhighlight lang="picat">rle(S) = RLE => |
|||
RLE = "", |
|||
Char = S[1], |
|||
I = 2, |
|||
Count = 1, |
|||
while (I <= S.len) |
|||
if Char == S[I] then |
|||
Count := Count + 1 |
|||
else |
|||
RLE := RLE ++ Count.to_string() ++ Char.to_string(), |
|||
Count := 1, |
|||
Char := S[I] |
|||
end, |
|||
I := I + 1 |
|||
end, |
|||
RLE := RLE ++ Count.to_string() ++ Char.to_string().</syntaxhighlight> |
|||
===Using positions of different chars=== |
|||
Much faster than <code>rle/1</code>. |
|||
<syntaxhighlight lang="picat">rle2(S) = RLE => |
|||
Ix = [1] ++ [I : I in 2..S.len, S[I] != S[I-1]] ++ [S.len+1], |
|||
Diffs = diff(Ix), |
|||
RLE = [Diffs[I].to_string() ++ S[Ix[I]].to_string() : I in 1..Diffs.len].join('').</syntaxhighlight> |
|||
===Recursive approach=== |
|||
The fastest version. |
|||
<syntaxhighlight lang="picat">rle3(S) = RLE => |
|||
rle3(S.tail(),S[1],1,[],RLE). |
|||
rle3([],LastChar,Count,RLE1,RLE) => |
|||
RLE = (RLE1 ++ [Count.to_string(),LastChar.to_string()]).join(''). |
|||
rle3([C|T],LastChar,Count,RLE1,RLE) => |
|||
C == LastChar -> |
|||
rle3(T,C,Count+1,RLE1,RLE) |
|||
; |
|||
rle3(T,C,1,RLE1++[Count.to_string()++LastChar.to_string()],RLE).</syntaxhighlight> |
|||
===Test=== |
|||
Encode and decode (only using <code>rle3/1</code>): |
|||
<syntaxhighlight lang="picat">go => |
|||
S = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWWA", |
|||
println(S), |
|||
RLE = rle3(S), |
|||
println(rle=RLE), |
|||
D = rl_decode(RLE), |
|||
println(D), |
|||
if D == S then |
|||
println(ok) |
|||
else |
|||
println(not_ok) |
|||
end, |
|||
nl.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWWA |
|||
rle = 12W1B12W3B24W1B14W1A |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWWA |
|||
ok</pre> |
|||
===Benchmark on larger string=== |
|||
A benchmark on a larger string (30_000) clearly shows that rle3/1 is the fastest. |
|||
<syntaxhighlight lang="picat">go2 => |
|||
_ = random2(), |
|||
Alpha = "AB", |
|||
Len2 = Alpha.len, |
|||
_ = random2(), |
|||
S = [Alpha[random(1,Len2)] : _ in 1..30_000], |
|||
if S.len < 200 then println(s=S) end , |
|||
println("rle/1:"), |
|||
time(_=rle(S)), |
|||
println("rle2/1:"), |
|||
time(_=rle2(S)), |
|||
println("rle3/1:"), |
|||
time(_=rle3(S)), |
|||
nl.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>rle/1: |
|||
CPU time 4.02 seconds. |
|||
rle3/1: |
|||
CPU time 2.422 seconds. |
|||
rle3/1: |
|||
CPU time 0.812 seconds.</pre> |
|||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||
< |
<syntaxhighlight lang="picolisp">(de encode (Str) |
||
(pack |
(pack |
||
(make |
(make |
||
Line 3,108: | Line 4,618: | ||
(prinl "Data: " "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
(prinl "Data: " "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") |
||
(prinl "Encoded: " (encode @)) |
(prinl "Encoded: " (encode @)) |
||
(prinl "Decoded: " (decode @)) )</ |
(prinl "Decoded: " (decode @)) )</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>Data: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre>Data: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 3,115: | Line 4,625: | ||
=={{header|PL/I}}== |
=={{header|PL/I}}== |
||
< |
<syntaxhighlight lang="pli">declare (c1, c2) character (1); |
||
declare run_length fixed binary; |
declare run_length fixed binary; |
||
declare input file; |
declare input file; |
||
Line 3,152: | Line 4,662: | ||
end; |
end; |
||
put edit ((c do i = 1 to run_length)) (a); |
put edit ((c do i = 1 to run_length)) (a); |
||
end;</ |
end;</syntaxhighlight> |
||
=={{header|PowerBASIC}}== |
=={{header|PowerBASIC}}== |
||
Line 3,158: | Line 4,668: | ||
This version can handle any arbitrary string that doesn't contain numbers (not just letters). (A flag value could be added which would allow the inclusion of ''any'' character, but such a flag isn't in this example.) |
This version can handle any arbitrary string that doesn't contain numbers (not just letters). (A flag value could be added which would allow the inclusion of ''any'' character, but such a flag isn't in this example.) |
||
< |
<syntaxhighlight lang="powerbasic">FUNCTION RLDecode (i AS STRING) AS STRING |
||
DIM Loop0 AS LONG, rCount AS STRING, outP AS STRING, m AS STRING |
DIM Loop0 AS LONG, rCount AS STRING, outP AS STRING, m AS STRING |
||
Line 3,209: | Line 4,719: | ||
'in PB/Win, "?" = MSGBOX; in PB/DOS & PB/CC. "?" = PRINT |
'in PB/Win, "?" = MSGBOX; in PB/DOS & PB/CC. "?" = PRINT |
||
? initial & $CRLF & encoded & $CRLF & decoded |
? initial & $CRLF & encoded & $CRLF & decoded |
||
END FUNCTION</ |
END FUNCTION</syntaxhighlight> |
||
Outputs are similar to those in [[#BASIC|BASIC]], above. |
Outputs are similar to those in [[#BASIC|BASIC]], above. |
||
=={{header|PowerShell}}== |
=={{header|PowerShell}}== |
||
< |
<syntaxhighlight lang="powershell">function Compress-RLE ($s) { |
||
$re = [regex] '(.)\1*' |
$re = [regex] '(.)\1*' |
||
$ret = "" |
$ret = "" |
||
Line 3,231: | Line 4,741: | ||
} |
} |
||
return $ret |
return $ret |
||
}</ |
}</syntaxhighlight> |
||
Output: |
Output: |
||
<pre>PS> Compress-RLE "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
<pre>PS> Compress-RLE "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
Line 3,237: | Line 4,747: | ||
PS> Expand-RLE "12W1B12W3B24W1B14W" |
PS> Expand-RLE "12W1B12W3B24W1B14W" |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
||
Works with SWI-Prolog.<br> |
Works with SWI-Prolog.<br> |
||
This code is inspired from a code found here : http://groups.google.com/group/comp.lang.prolog/browse_thread/thread/b053ea2512e8b350 (author : Pascal J. Bourguignon). |
This code is inspired from a code found here : http://groups.google.com/group/comp.lang.prolog/browse_thread/thread/b053ea2512e8b350 (author : Pascal J. Bourguignon). |
||
< |
<syntaxhighlight lang="prolog">% the test |
||
run_length :- |
run_length :- |
||
L = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW", |
L = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW", |
||
Line 3,347: | Line 4,858: | ||
run(Var,[Other|RRest], [1,Var],[Other|RRest]):- |
run(Var,[Other|RRest], [1,Var],[Other|RRest]):- |
||
dif(Var,Other).</ |
dif(Var,Other).</syntaxhighlight> |
||
Output : |
Output : |
||
<pre> ?- run_length. |
<pre> ?- run_length. |
||
Line 3,359: | Line 4,870: | ||
=={{header|Pure}}== |
=={{header|Pure}}== |
||
< |
<syntaxhighlight lang="pure">using system; |
||
encode s = strcat $ map (sprintf "%d%s") $ encode $ chars s with |
encode s = strcat $ map (sprintf "%d%s") $ encode $ chars s with |
||
Line 3,373: | Line 4,884: | ||
let s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
let s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
||
let r = encode s; // "12W1B12W3B24W1B14W" |
let r = encode s; // "12W1B12W3B24W1B14W" |
||
decode r;</ |
decode r;</syntaxhighlight> |
||
=={{header|PureBasic}}== |
=={{header|PureBasic}}== |
||
{{trans|PowerBasic}} with some optimations to use pointers instead of string functions. According to the task description it works with uppercase A - Z. In this implementation it also functions with all characters that are non-digits and whose value is non-zero. |
{{trans|PowerBasic}} with some optimations to use pointers instead of string functions. According to the task description it works with uppercase A - Z. In this implementation it also functions with all characters that are non-digits and whose value is non-zero. |
||
< |
<syntaxhighlight lang="purebasic">Procedure.s RLDecode(toDecode.s) |
||
Protected.s repCount, output, currChar, tmp |
Protected.s repCount, output, currChar, tmp |
||
Protected *c.Character = @toDecode |
Protected *c.Character = @toDecode |
||
Line 3,442: | Line 4,953: | ||
Input() |
Input() |
||
CloseConsole() |
CloseConsole() |
||
EndIf</ |
EndIf</syntaxhighlight> |
||
Sample output: |
Sample output: |
||
<pre>Type something: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWW |
<pre>Type something: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWW |
||
Line 3,451: | Line 4,962: | ||
=={{header|Python}}== |
=={{header|Python}}== |
||
< |
<syntaxhighlight lang="python">def encode(input_string): |
||
count = 1 |
count = 1 |
||
prev = |
prev = None |
||
lst = [] |
lst = [] |
||
for character in input_string: |
for character in input_string: |
||
if character != prev: |
if character != prev: |
||
if prev: |
if prev: |
||
entry = (prev,count) |
entry = (prev, count) |
||
lst.append(entry) |
lst.append(entry) |
||
#print lst |
|||
count = 1 |
count = 1 |
||
prev = character |
prev = character |
||
Line 3,467: | Line 4,977: | ||
else: |
else: |
||
try: |
try: |
||
entry = (character,count) |
entry = (character, count) |
||
lst.append(entry) |
lst.append(entry) |
||
return (lst, 0) |
return (lst, 0) |
||
Line 3,475: | Line 4,985: | ||
def decode(lst): |
def decode(lst): |
||
q = |
q = [] |
||
for character, count in lst: |
for character, count in lst: |
||
q |
q.append(character * count) |
||
return q |
return ''.join(q) |
||
#Method call |
#Method call |
||
Line 3,484: | Line 4,994: | ||
if value[1] == 0: |
if value[1] == 0: |
||
print("Encoded value is {}".format(value[0])) |
print("Encoded value is {}".format(value[0])) |
||
decode(value[0])</ |
decode(value[0])</syntaxhighlight> |
||
Functional |
Functional |
||
{{works with|Python|2.4}} |
{{works with|Python|2.4}} |
||
< |
<syntaxhighlight lang="python">from itertools import groupby |
||
def encode(input_string): |
def encode(input_string): |
||
return [(len(list(g)), k) for k,g in groupby(input_string)] |
return [(len(list(g)), k) for k,g in groupby(input_string)] |
||
Line 3,496: | Line 5,006: | ||
encode("aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa") |
encode("aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa") |
||
decode([(5, 'a'), (6, 'h'), (7, 'm'), (1, 'u'), (7, 'i'), (6, 'a')])</ |
decode([(5, 'a'), (6, 'h'), (7, 'm'), (1, 'u'), (7, 'i'), (6, 'a')])</syntaxhighlight> |
||
<br>'''By regular expression'''<br> |
<br>'''By regular expression'''<br> |
||
The simplified input range of only uppercase characters allows a simple regular expression to be applied repeatedly for encoding, and another for decoding: |
The simplified input range of only uppercase characters allows a simple regular expression to be applied repeatedly for encoding, and another for decoding: |
||
< |
<syntaxhighlight lang="python">from re import sub |
||
def encode(text): |
def encode(text): |
||
Line 3,521: | Line 5,031: | ||
textin = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
textin = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
assert decode(encode(textin)) == textin</ |
assert decode(encode(textin)) == textin</syntaxhighlight> |
||
=={{header|Quackery}}== |
|||
<code>lookandsay</code> is defined at [[Look-and-say sequence#Quackery]]. |
|||
<syntaxhighlight lang="quackery"> [ lookandsay ] is encode ( $ --> $ ) |
|||
[ $ "" 0 rot |
|||
witheach |
|||
[ dup |
|||
char 0 char 9 1+ |
|||
within iff |
|||
[ char 0 - |
|||
swap 10 * + ] |
|||
else |
|||
[ swap of join |
|||
0 ] ] |
|||
drop ] is decode ( $ --> $ ) |
|||
$ "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
dup echo$ cr |
|||
encode |
|||
dup echo$ cr |
|||
decode |
|||
echo$ cr</syntaxhighlight> |
|||
{{out}} |
|||
<pre>WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
R has a built-in function, rle, for run length encoding. This modification allows input and output in the forms specified above. |
R has a built-in function, rle, for run length encoding. This modification allows input and output in the forms specified above. |
||
< |
<syntaxhighlight lang="rsplus">runlengthencoding <- function(x) |
||
{ |
{ |
||
splitx <- unlist(strsplit(input, "")) |
splitx <- unlist(strsplit(input, "")) |
||
Line 3,533: | Line 5,075: | ||
input <- "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
input <- "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
runlengthencoding(input)</ |
runlengthencoding(input)</syntaxhighlight> |
||
Similarly, inverse.rle provides decompression after a run length encoding. |
Similarly, inverse.rle provides decompression after a run length encoding. |
||
< |
<syntaxhighlight lang="rsplus">inverserunlengthencoding <- function(x) |
||
{ |
{ |
||
lengths <- as.numeric(unlist(strsplit(output, "[[:alpha:]]"))) |
lengths <- as.numeric(unlist(strsplit(output, "[[:alpha:]]"))) |
||
Line 3,545: | Line 5,087: | ||
output <- "12W1B12W3B24W1B14W" |
output <- "12W1B12W3B24W1B14W" |
||
inverserunlengthencoding(output)</ |
inverserunlengthencoding(output)</syntaxhighlight> |
||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
<syntaxhighlight lang="racket"> |
|||
<lang Racket> |
|||
#lang racket |
#lang racket |
||
(define (encode str) |
(define (encode str) |
||
Line 3,555: | Line 5,097: | ||
(define (decode str) |
(define (decode str) |
||
(regexp-replace* #px"([0-9]+)(.)" str (λ (m n c) (make-string (string->number n) (string-ref c 0))))) |
(regexp-replace* #px"([0-9]+)(.)" str (λ (m n c) (make-string (string->number n) (string-ref c 0))))) |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
Note that Raku regexes don't care about unquoted whitespace, and that backrefs |
|||
count from 0, not from 1. |
|||
<syntaxhighlight lang="raku" line>sub encode($str) { $str.subst(/(.) $0*/, { $/.chars ~ $0 }, :g) } |
|||
sub decode($str) { $str.subst(/(\d+) (.)/, { $1 x $0 }, :g) } |
|||
my $e = encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'); |
|||
say $e; |
|||
say decode($e);</syntaxhighlight> |
|||
Output: |
|||
<pre>12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
|||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
===version 1=== |
===version 1=== |
||
The task (input) rule was relaxed a bit as this program accepts upper─ and lowercase input. |
The task (input) rule was relaxed a bit as this program accepts upper─ and lowercase input. |
||
An error message is generated if the input text is invalid. |
|||
In addition, a ''yay'' or ''nay'' message is also displayed if the decoding of the encoding was successful. |
|||
Note that this REXX version (for encoding and decoding) uses a ''replication'' count, not the ''count'' of characters, |
Note that this REXX version (for encoding and decoding) uses a ''replication'' count, not the ''count'' of characters, |
||
<br>so a replication count of '''11''' represents a count of '''12''' characters. |
<br>so a replication count of '''11''' represents a count of '''12''' characters. |
||
<syntaxhighlight lang="rexx">/*REXX program encodes and displays a string by using a run─length encoding scheme. */ |
|||
====encoding==== |
|||
parse arg input . /*normally, input would be in a file. */ |
|||
<lang rexx>/*REXX program encodes a string by using a run─length encoding scheme. */ |
|||
default= 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
parse arg x . /*normally, input would be in a file. */ |
|||
if input=='' | input=="," then input= default /*Not specified? Then use the default.*/ |
|||
def= 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
encode= RLE(input) ; say ' input=' input /*encode input string; display input. */ |
|||
if x='' then x=def /*Input not specified? Then use default*/ |
|||
say 'encoded=' encode /* display run─len*/ |
|||
decode= RLD(encode); say 'decoded=' decode /*decode the run─len; display decode.*/ |
|||
if decode==input then say 'OK'; else say "¬ OK" /*display yay or nay (success/failure).*/ |
|||
do j=1 by 0 to Lx /*J: is incremented within the loop. */ |
|||
exit 0 /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
if \datatype(c,'M') then do; say "error!: data isn't alphabetic:" c; exit 13; end |
|||
err: say; say "***error*** input data isn't alphabetic:" c; say; exit 13 |
|||
r=0 /*R: is NOT the number of characters. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
do k=j+1 to Lx while substr(x,k,1)==c; r=r+1 |
|||
RLE: procedure; parse arg x; $= /*$: is the output string (so far). */ |
|||
Lx= length(x) /*get length of the plain text string. */ |
|||
do j=1 by 0 to Lx; c= substr(x, j, 1) /*obtain a character from plain text. */ |
|||
if \datatype(c, 'M') then call err /*Character not a letter? Issue error.*/ |
|||
r= 0 /*R: is NOT the number of characters. */ |
|||
end /*j*/ |
|||
do k=j+1 to Lx while substr(x, k, 1)==c /*while characters ≡ C */ |
|||
r= r + 1 /*bump the replication count for a char*/ |
|||
say ' input=' x |
|||
end /*k*/ |
|||
j= j + r + 1 /*increment (add to) the DO loop index.*/ |
|||
'''output''' when using the default input: |
|||
if r==0 then $= $ || c /*don't use R if it is equal to zero.*/ |
|||
else $= $ || r || c /*add character to the encoded string. */ |
|||
end /*j*/; return $ /*return the encoded string to caller. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
RLD: procedure; parse arg x; $= /*$: is the output string (so far). */ |
|||
Lx= length(x) /*get the length of the encoded string.*/ |
|||
do j=1 by 0 to Lx; c= substr(x, j, 1) /*obtain a character from run encoding.*/ |
|||
if \datatype(c, 'W') then do; $= $ || c; j= j + 1; iterate /*j*/ |
|||
end /* [↑] a loner char, add it to output.*/ |
|||
#= 1 /* [↓] W: use a Whole number*/ |
|||
do k=j+1 to Lx while datatype(substr(x,k,1), 'w') /*while numeric*/ |
|||
#= # + 1 /*bump the count of the numeric chars. */ |
|||
end /*k*/ |
|||
n= substr(x, j, #) + 1 /*#: the length of encoded character. */ |
|||
$= $ || copies( substr(x, k, 1), n) /*N: is now the number of characters. */ |
|||
j= j + # + 1 /*increment the DO loop index by D+1. */ |
|||
end /*j*/; return $ /*return the decoded string to caller. */</syntaxhighlight> |
|||
{{out|output|text= when using the default input:}} |
|||
<pre> |
<pre> |
||
input= WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
encoded= 11WB11W2B23WB13W |
|||
</pre> |
|||
====decoding==== |
|||
<lang rexx>/*REXX program decodes a string by using a run─length decoding scheme. */ |
|||
parse arg x . /*normally, input would be in a file. */ |
|||
if x=='' then x=11WB11W2B23WB13W /*X not specified? Then use default.*/ |
|||
Lx=length(x) /*get the length of the input string. */ |
|||
y= /*Y: is the output string (so far). */ |
|||
do j=1 by 0 to Lx /*warning! J is modified within loop.*/ |
|||
c=substr(x,j,1) |
|||
if \datatype(c,'W') then do /*a loner char, simply add to output. */ |
|||
y=y || c; j=j+1; iterate /*j*/ |
|||
end |
|||
d=1 /* [↓] W: a Whole number.*/ |
|||
do k=j+1 to Lx while datatype(substr(x,k,1),'w'); d=d+1 /*end of #?*/ |
|||
end /*k*/ /*D: is the number of characters so far*/ |
|||
n=substr(x,j,d)+1 /*D: is length of the encoded number. */ |
|||
y=y || copies(substr(x,k,1), n) /*N: is now the number of characters. */ |
|||
j=j+1+d /*increment the DO loop index by D+1. */ |
|||
end /*j*/ |
|||
say ' input=' x |
|||
say 'decoded=' y /*stick a fork in it, we're all done. */</lang> |
|||
'''output''' when using the default input: |
|||
<pre> |
|||
input= 11WB11W2B23WB13W |
|||
decoded= WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
decoded= WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
</pre> |
</pre> |
||
===version 2=== |
===version 2=== |
||
<syntaxhighlight lang="rexx"> |
|||
<lang rexx>s='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
/*REXX*/ |
|||
s='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
Say ' s='s |
Say ' s='s |
||
enc=encode(s) |
enc=encode(s) |
||
Line 3,656: | Line 5,213: | ||
o: ol=ol||arg(1) |
o: ol=ol||arg(1) |
||
Return</ |
Return</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> s=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre> s=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 3,665: | Line 5,222: | ||
===version 3=== |
===version 3=== |
||
No need to output counts that are 1 |
No need to output counts that are 1 |
||
<syntaxhighlight lang="rexx"> |
|||
<lang rexx>s='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
/*REXX*/ |
|||
s='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
Say ' s='s |
Say ' s='s |
||
enc=encode(s) |
enc=encode(s) |
||
Line 3,712: | Line 5,271: | ||
o: ol=ol||arg(1) |
o: ol=ol||arg(1) |
||
Return</ |
Return</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> s=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
<pre> s=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
Line 3,720: | Line 5,279: | ||
=={{header|Ring}}== |
=={{header|Ring}}== |
||
< |
<syntaxhighlight lang="ring"> |
||
# Project : Run-length encoding |
# Project : Run-length encoding |
||
# Date : 2017/12/04 |
|||
# Author : Gal Zsolt (~ CalmoSoft ~) |
|||
# Email : <calmosoft@gmail.com> |
|||
load "stdlib.ring" |
load "stdlib.ring" |
||
Line 3,751: | Line 5,307: | ||
see dec |
see dec |
||
next |
next |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output: |
Output: |
||
<pre> |
<pre> |
||
12W1B12W3B24W1B14W |
12W1B12W3B24W1B14W |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
</pre> |
|||
=={{header|RPL}}== |
|||
≪ DUP 1 DUP SUB → in c |
|||
≪ "" 1 |
|||
2 in SIZE '''FOR''' j |
|||
in j DUP SUB |
|||
'''IF''' DUP c == '''THEN''' DROP 1 + |
|||
'''ELSE''' |
|||
ROT ROT |
|||
→STR + c + |
|||
SWAP 'c' STO 1 |
|||
'''END''' |
|||
'''NEXT''' |
|||
→STR + c + |
|||
≫ ≫ ‘<span style="color:blue">RLENC</span>’ STO |
|||
≪ → in |
|||
≪ "" 0 |
|||
1 in SIZE '''FOR''' j |
|||
in j DUP SUB |
|||
'''IF''' DUP "A" ≥ '''THEN''' |
|||
ROT 1 4 ROLL '''START''' OVER + '''NEXT''' |
|||
SWAP DROP 0 |
|||
'''ELSE''' STR→ SWAP 10 * + '''END''' |
|||
'''NEXT''' DROP |
|||
≫ ≫ ‘<span style="color:blue">RLDEC</span>’ STO |
|||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" <span style="color:blue">RLENC</span> DUP <span style="color:blue">RLDEC</span> |
|||
{{out}} |
|||
<pre> |
|||
2: "12W1B12W3B24W1B14W" |
|||
1: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
</pre> |
</pre> |
||
Line 3,764: | Line 5,353: | ||
Ruby has built-in run-length encoding in the form of <code>chunk</code>, here I provide a thin wrapper around it: |
Ruby has built-in run-length encoding in the form of <code>chunk</code>, here I provide a thin wrapper around it: |
||
< |
<syntaxhighlight lang="ruby"> |
||
# run_encode("aaabbbbc") #=> [["a", 3], ["b", 4], ["c", 1]] |
# run_encode("aaabbbbc") #=> [["a", 3], ["b", 4], ["c", 1]] |
||
def run_encode(string) |
def run_encode(string) |
||
Line 3,780: | Line 5,369: | ||
end |
end |
||
</syntaxhighlight> |
|||
</lang> |
|||
< |
<syntaxhighlight lang="ruby">def encode(string) |
||
string.scan(/(.)(\1*)/).collect do |char, repeat| |
string.scan(/(.)(\1*)/).collect do |char, repeat| |
||
[1 + repeat.length, char] |
[1 + repeat.length, char] |
||
Line 3,790: | Line 5,379: | ||
def decode(string) |
def decode(string) |
||
string.scan(/(\d+)(\D)/).collect {|length, char| char * length.to_i}.join |
string.scan(/(\d+)(\D)/).collect {|length, char| char * length.to_i}.join |
||
end</ |
end</syntaxhighlight> |
||
This usage also seems to be idiomatic, and perhaps less cryptic: |
This usage also seems to be idiomatic, and perhaps less cryptic: |
||
< |
<syntaxhighlight lang="ruby">def encode(string) |
||
string.scan(/(.)(\1*)/).inject("") do |encoding, (char, repeat)| |
string.scan(/(.)(\1*)/).inject("") do |encoding, (char, repeat)| |
||
encoding << (1 + repeat.length).to_s << char |
encoding << (1 + repeat.length).to_s << char |
||
Line 3,803: | Line 5,392: | ||
decoding << char * length.to_i |
decoding << char * length.to_i |
||
end |
end |
||
end</ |
end</syntaxhighlight> |
||
<br>'''By regular expression'''<br> |
<br>'''By regular expression'''<br> |
||
The simplified input range of only uppercase characters allows a simple regular expression to be applied repeatedly for encoding, and another for decoding: |
The simplified input range of only uppercase characters allows a simple regular expression to be applied repeatedly for encoding, and another for decoding: |
||
< |
<syntaxhighlight lang="ruby">def encode(str) |
||
str.gsub(/(.)\1*/) {$&.length.to_s + $1} |
str.gsub(/(.)\1*/) {$&.length.to_s + $1} |
||
end |
end |
||
Line 3,813: | Line 5,402: | ||
def decode(str) |
def decode(str) |
||
str.gsub(/(\d+)(\D)/) {$2 * $1.to_i} |
str.gsub(/(\d+)(\D)/) {$2 * $1.to_i} |
||
end</ |
end</syntaxhighlight> |
||
'''Test:''' |
'''Test:''' |
||
< |
<syntaxhighlight lang="ruby">orig = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
p enc = encode(orig) |
p enc = encode(orig) |
||
p dec = decode(enc) |
p dec = decode(enc) |
||
puts "success!" if dec == orig</ |
puts "success!" if dec == orig</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 3,829: | Line 5,418: | ||
=={{header|Run BASIC}}== |
=={{header|Run BASIC}}== |
||
< |
<syntaxhighlight lang="runbasic">string$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
beg = 1 |
beg = 1 |
||
i = 1 |
i = 1 |
||
Line 3,854: | Line 5,443: | ||
beg = i |
beg = i |
||
if i < len(press$) then goto [expand] |
if i < len(press$) then goto [expand] |
||
print " Expanded:";expand$</ |
print " Expanded:";expand$</syntaxhighlight>Output: |
||
<pre>Compressed:12W1B12W3B24W1B14W |
<pre>Compressed:12W1B12W3B24W1B14W |
||
Expanded:WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
Expanded:WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust">fn encode(s: &str) -> String { |
|||
s.chars() |
|||
// wrap all values in Option::Some |
|||
.map(Some) |
|||
// add an Option::None onto the iterator to clean the pipeline at the end |
|||
.chain(std::iter::once(None)) |
|||
.scan((0usize, '\0'), |(n, c), elem| match elem { |
|||
Some(elem) if *n == 0 || *c == elem => { |
|||
// the run continues or starts here |
|||
*n += 1; |
|||
*c = elem; |
|||
// this will not have an effect on the final string because it is empty |
|||
Some(String::new()) |
|||
} |
|||
Some(elem) => { |
|||
// the run ends here |
|||
let run = format!("{}{}", n, c); |
|||
*n = 1; |
|||
*c = elem; |
|||
Some(run) |
|||
} |
|||
None => { |
|||
// the string ends here |
|||
Some(format!("{}{}", n, c)) |
|||
} |
|||
}) |
|||
// concatenate together all subresults |
|||
.collect() |
|||
} |
|||
fn decode(s: &str) -> String { |
|||
s.chars() |
|||
.fold((0usize, String::new()), |(n, text), c| { |
|||
if c.is_ascii_digit() { |
|||
// some simple number parsing |
|||
( |
|||
n * 10 + c.to_digit(10).expect("invalid encoding") as usize, |
|||
text, |
|||
) |
|||
} else { |
|||
// this must be the character that is repeated |
|||
(0, text + &format!("{}", c.to_string().repeat(n))) |
|||
} |
|||
}) |
|||
.1 |
|||
} |
|||
fn main() { |
|||
let text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
|||
let encoded = encode(text); |
|||
let decoded = decode(&encoded); |
|||
println!("original: {}\n encoded: {}\n decoded: {}", text, encoded, decoded); |
|||
assert_eq!(text, decoded); |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>original: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
encoded: 12W1B12W3B24W1B14W |
|||
decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
Care is taken to use StringBuilder for performance reasons. |
Care is taken to use StringBuilder for performance reasons. |
||
< |
<syntaxhighlight lang="scala">def encode(s: String) = (1 until s.size).foldLeft((1, s(0), new StringBuilder)) { |
||
case ((len, c, sb), index) if c != s(index) => sb.append(len); sb.append(c); (1, s(index), sb) |
case ((len, c, sb), index) if c != s(index) => sb.append(len); sb.append(c); (1, s(index), sb) |
||
case ((len, c, sb), _) => (len + 1, c, sb) |
case ((len, c, sb), _) => (len + 1, c, sb) |
||
Line 3,873: | Line 5,525: | ||
for (Code(len, c) <- Code findAllIn s) sb.append(c * len.toInt) |
for (Code(len, c) <- Code findAllIn s) sb.append(c * len.toInt) |
||
sb.toString |
sb.toString |
||
}</ |
}</syntaxhighlight> |
||
A simpler (?) encoder: |
A simpler (?) encoder: |
||
< |
<syntaxhighlight lang="scala">def encode(s:String) = { |
||
s.foldLeft((0,s(0),""))( (t,c) => t match {case (i,p,s) => if (p==c) (i+1,p,s) else (1,c,s+i+p)}) |
s.foldLeft((0,s(0),""))( (t,c) => t match {case (i,p,s) => if (p==c) (i+1,p,s) else (1,c,s+i+p)}) |
||
match {case (i,p,s) => s+i+p} |
match {case (i,p,s) => s+i+p} |
||
}</ |
}</syntaxhighlight> |
||
To make it faster (it's also faster than the longer implementation above) just replace '''""''' with '''new StringBuilder''' and '''s+i+p''' with '''{s.append(i);s.append(p)}''' |
To make it faster (it's also faster than the longer implementation above) just replace '''""''' with '''new StringBuilder''' and '''s+i+p''' with '''{s.append(i);s.append(p)}''' |
||
A simpler (?) decoder (that can handle a string like "2AB", producing "AAB"): |
|||
<syntaxhighlight lang="scala">def decode(s: String, Code: scala.util.matching.Regex = """(\d+)?([a-zA-Z])""".r) = |
|||
Code.findAllIn(s).foldLeft("") { case (acc, Code(len, c)) => |
|||
acc + c * Option(len).map(_.toInt).getOrElse(1) |
|||
}</syntaxhighlight> |
|||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
< |
<syntaxhighlight lang="scheme">(define (run-length-decode v) |
||
(apply string-append (map (lambda (p) (make-string (car p) (cdr p))) v))) |
(apply string-append (map (lambda (p) (make-string (car p) (cdr p))) v))) |
||
Line 3,898: | Line 5,556: | ||
; ((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W)) |
; ((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W)) |
||
(run-length-decode '((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W))) |
(run-length-decode '((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W))) |
||
; "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</ |
; "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"</syntaxhighlight> |
||
=={{header|sed}}== |
=={{header|sed}}== |
||
The encode script: |
The encode script: |
||
< |
<syntaxhighlight lang="sed"> |
||
/^$/ b |
/^$/ b |
||
:start |
:start |
||
Line 3,929: | Line 5,587: | ||
s/^([0-9]+.)(.*)/\2\1/ |
s/^([0-9]+.)(.*)/\2\1/ |
||
b start |
b start |
||
</syntaxhighlight> |
|||
</lang> |
|||
The decode script: |
The decode script: |
||
< |
<syntaxhighlight lang="sed"> |
||
/^$/ b |
/^$/ b |
||
:start |
:start |
||
Line 3,954: | Line 5,612: | ||
s/^0+// |
s/^0+// |
||
b loop } |
b loop } |
||
</syntaxhighlight> |
|||
</lang> |
|||
Example (assuming the scripts reside in the files <code>encode.sed</code> and <code>decode.sed</code>): |
Example (assuming the scripts reside in the files <code>encode.sed</code> and <code>decode.sed</code>): |
||
< |
<syntaxhighlight lang="bash"> |
||
sed -rf encode.sed <<< "foo oops" |
sed -rf encode.sed <<< "foo oops" |
||
# 1f2o1 2o1p1s |
# 1f2o1 2o1p1s |
||
Line 3,966: | Line 5,624: | ||
(sed -rf decode.sed | sed -rf encode.sed) <<< 1000. |
(sed -rf decode.sed | sed -rf encode.sed) <<< 1000. |
||
# 1000. |
# 1000. |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Seed7}}== |
=={{header|Seed7}}== |
||
< |
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
||
include "scanstri.s7i"; |
include "scanstri.s7i"; |
||
Line 4,004: | Line 5,662: | ||
writeln(letterRleEncode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")); |
writeln(letterRleEncode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")); |
||
writeln(letterRleDecode("12W1B12W3B24W1B14W")); |
writeln(letterRleDecode("12W1B12W3B24W1B14W")); |
||
end func;</ |
end func;</syntaxhighlight> |
||
=={{header|SETL}}== |
|||
<syntaxhighlight lang="setl">program rle; |
|||
test := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
|||
print("Input:"); |
|||
print(test); |
|||
print("Encoded:"); |
|||
print(enc := rlencode(test)); |
|||
print("Decoded:"); |
|||
print(rldecode(enc)); |
|||
proc rlencode(s); |
|||
loop while s /= "" do |
|||
part := span(s, s(1)); |
|||
r +:= str #part + part(1); |
|||
end loop; |
|||
return r; |
|||
end proc; |
|||
proc rldecode(s); |
|||
loop while s /= "" do |
|||
num := span(s, "0123456789"); |
|||
item := notany(s, ""); |
|||
r +:= val num * item; |
|||
end loop; |
|||
return r; |
|||
end proc; |
|||
end program;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Input: |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Encoded: |
|||
12W1B12W3B24W1B14W |
|||
Decoded: |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
|||
=={{header|Sidef}}== |
=={{header|Sidef}}== |
||
First solution: |
First solution: |
||
< |
<syntaxhighlight lang="ruby">func encode(str) { |
||
str.gsub(/((.)(\2*))/, {|a,b| "#{a.len}#{b}" }); |
str.gsub(/((.)(\2*))/, {|a,b| "#{a.len}#{b}" }); |
||
} |
} |
||
Line 4,014: | Line 5,708: | ||
func decode(str) { |
func decode(str) { |
||
str.gsub(/(\d+)(.)/, {|a,b| b * a.to_i }); |
str.gsub(/(\d+)(.)/, {|a,b| b * a.to_i }); |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>12W1B12W3B24W1B14W</pre> |
<pre>12W1B12W3B24W1B14W</pre> |
||
Second solution, encoding the length into a byte: |
Second solution, encoding the length into a byte: |
||
< |
<syntaxhighlight lang="ruby">func encode(str) { |
||
str.gsub(/(.)(\1{0,254})/, {|a,b| b.len+1 -> chr + a}); |
str.gsub(/(.)(\1{0,254})/, {|a,b| b.len+1 -> chr + a}); |
||
} |
} |
||
Line 4,030: | Line 5,724: | ||
} |
} |
||
return r; |
return r; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>"\fW\1B\fW\3B\30W\1B\16W"</pre> |
<pre>"\fW\1B\fW\3B\30W\1B\16W"</pre> |
||
Line 4,036: | Line 5,730: | ||
=={{header|Smalltalk}}== |
=={{header|Smalltalk}}== |
||
See [[Run-length encoding/Smalltalk]] |
See [[Run-length encoding/Smalltalk]] |
||
A "functional" version without RunArray: |
|||
{{works with|Smalltalk/X}} (and others) |
|||
<syntaxhighlight lang="smalltalk">|compress decompress| |
|||
compress := [:string | |
|||
String streamContents:[:out | |
|||
|count prev| |
|||
count := 0. |
|||
(string,'*') "trick to avoid final run handling in loop" |
|||
inject:nil |
|||
into:[:prevChar :ch | |
|||
ch ~= prevChar ifTrue:[ |
|||
count = 0 ifFalse:[ |
|||
count printOn:out. |
|||
out nextPut:prevChar. |
|||
count := 0. |
|||
]. |
|||
]. |
|||
count := count + 1. |
|||
ch |
|||
] |
|||
] |
|||
]. |
|||
decompress := [:string | |
|||
String streamContents:[:out | |
|||
string readingStreamDo:[:in | |
|||
[in atEnd] whileFalse:[ |
|||
|n ch| |
|||
n := Integer readFrom:in. |
|||
ch := in next. |
|||
out next:n put:ch. |
|||
] |
|||
] |
|||
]. |
|||
].</syntaxhighlight> |
|||
<syntaxhighlight lang="smalltalk">compress value:'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' |
|||
-> '12W1B12W3B24W1B14W' |
|||
decompress value:'12W1B12W3B24W1B14W' |
|||
-> 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'</syntaxhighlight> |
|||
Most Smalltalk dialects include a class named "RunArray", which can be used as: |
|||
{{works with|Smalltalk/X}} |
|||
{{works with|VisualWorks}} |
|||
<syntaxhighlight lang="smalltalk">compress := [:string | |
|||
String streamContents:[:out | |
|||
string asRunArray runsDo:[:count :char | |
|||
count printOn:out. out nextPut:char]]].</syntaxhighlight> |
|||
=={{header|SNOBOL4}}== |
=={{header|SNOBOL4}}== |
||
Line 4,043: | Line 5,789: | ||
{{works with|CSnobol}} |
{{works with|CSnobol}} |
||
< |
<syntaxhighlight lang="snobol4">* # Encode RLE |
||
define('rle(str)c,n') :(rle_end) |
define('rle(str)c,n') :(rle_end) |
||
rle str len(1) . c :f(return) |
rle str len(1) . c :f(return) |
||
Line 4,061: | Line 5,807: | ||
str = rle(str); output = str |
str = rle(str); output = str |
||
str = elr(str); output = str |
str = elr(str); output = str |
||
end</ |
end</syntaxhighlight> |
||
Output: |
Output: |
||
Line 4,067: | Line 5,813: | ||
12W1B12W3B24W1B14W |
12W1B12W3B24W1B14W |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW</pre> |
||
=={{header|SparForte}}== |
|||
As a structured script. |
|||
<syntaxhighlight lang="ada">#!/usr/local/bin/spar |
|||
pragma is |
|||
annotate( summary, "rle" ); |
|||
annotate( description, "Given a string containing uppercase characters (A-Z)," ); |
|||
annotate( description, "compress repeated 'runs' of the same character by" ); |
|||
annotate( description, "storing the length of that run, and provide a function to" ); |
|||
annotate( description, "reverse the compression. The output can be anything, as" ); |
|||
annotate( description, "long as you can recreate the input with it." ); |
|||
annotate( description, "" ); |
|||
annotate( description, "Example:" ); |
|||
annotate( description, "Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" ); |
|||
annotate( description, "Output: 12W1B12W3B24W1B14W" ); |
|||
annotate( see_also, "http://rosettacode.org/wiki/Run-length_encoding" ); |
|||
annotate( author, "Ken O. Burtch" ); |
|||
license( unrestricted ); |
|||
restriction( no_external_commands ); |
|||
end pragma; |
|||
procedure rle is |
|||
function to_rle( s : string ) return string is |
|||
begin |
|||
if strings.length( s ) = 0 then |
|||
return ""; |
|||
end if; |
|||
declare |
|||
result : string; |
|||
code : character; |
|||
prefix : string; |
|||
first : natural := 1; |
|||
index : natural := 1; |
|||
begin |
|||
while index <= strings.length( s ) loop |
|||
first := index; |
|||
index := @+1; |
|||
code := strings.element( s, positive(first) ); |
|||
while index <= strings.length( s ) loop |
|||
exit when code /= strings.element( s, positive(index) ); |
|||
index := @+1; |
|||
exit when index-first = 99; |
|||
end loop; |
|||
prefix := strings.trim( strings.image( index - first ), trim_end.left ); |
|||
result := @ & prefix & code; |
|||
end loop; |
|||
return result; |
|||
end; |
|||
end to_rle; |
|||
function from_rle( s : string ) return string is |
|||
begin |
|||
if strings.length( s ) = 0 then |
|||
return ""; |
|||
end if; |
|||
declare |
|||
result : string; |
|||
index : positive := 1; |
|||
prefix : string; |
|||
code : character; |
|||
begin |
|||
loop |
|||
prefix := "" & strings.element( s, index ); |
|||
index := @+1; |
|||
if strings.is_digit( strings.element( s, index ) ) then |
|||
prefix := @ & strings.element( s, index ); |
|||
index := @+1; |
|||
end if; |
|||
code := strings.element( s, index ); |
|||
index := @+1; |
|||
result := @ & ( numerics.value( prefix ) * code ); |
|||
exit when natural(index) > strings.length( s ); |
|||
end loop; |
|||
return result; |
|||
end; |
|||
end from_rle; |
|||
begin |
|||
? to_rle( "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" ); |
|||
? from_rle( "12W1B12W3B24W1B14W"); |
|||
end rle;</syntaxhighlight> |
|||
=={{header|SQL}}== |
=={{header|SQL}}== |
||
Line 4,072: | Line 5,900: | ||
<br> |
<br> |
||
* RLE encoding |
* RLE encoding |
||
<syntaxhighlight lang="sql"> |
|||
<lang SQL> |
|||
-- variable table |
-- variable table |
||
drop table if exists var; |
drop table if exists var; |
||
Line 4,120: | Line 5,948: | ||
where noWithinGroup = 1 |
where noWithinGroup = 1 |
||
) Rle_Compressed |
) Rle_Compressed |
||
</syntaxhighlight> |
|||
</lang> |
|||
* RLE decoding |
* RLE decoding |
||
<syntaxhighlight lang="sql"> |
|||
<lang SQL> |
|||
-- variable table |
-- variable table |
||
DROP TABLE IF EXISTS var; |
DROP TABLE IF EXISTS var; |
||
Line 4,186: | Line 6,014: | ||
string_agg(replicated_Letter, '' ORDER BY group_no) decoded_string |
string_agg(replicated_Letter, '' ORDER BY group_no) decoded_string |
||
FROM lettersReplicated |
FROM lettersReplicated |
||
</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Standard ML}}== |
=={{header|Standard ML}}== |
||
< |
<syntaxhighlight lang="sml">fun encode str = |
||
let |
let |
||
fun aux (sub, acc) = |
fun aux (sub, acc) = |
||
Line 4,205: | Line 6,033: | ||
fun decode lst = |
fun decode lst = |
||
concat (map (fn (c,n) => implode (List.tabulate (n, fn _ => c))) lst)</ |
concat (map (fn (c,n) => implode (List.tabulate (n, fn _ => c))) lst)</syntaxhighlight> |
||
Example: |
Example: |
||
<pre> |
<pre> |
||
Line 4,217: | Line 6,045: | ||
=={{header|Swift}}== |
=={{header|Swift}}== |
||
Using array as the internal representation of the encoded input: |
Using array as the internal representation of the encoded input: |
||
< |
<syntaxhighlight lang="swift">import Foundation |
||
// "WWWBWW" -> [(3, W), (1, B), (2, W)] |
// "WWWBWW" -> [(3, W), (1, B), (2, W)] |
||
Line 4,231: | Line 6,059: | ||
return encoded.reduce("") { $0 + String(count: $1.0, repeatedValue: $1.1) } |
return encoded.reduce("") { $0 + String(count: $1.0, repeatedValue: $1.1) } |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
'''Usage:''' |
'''Usage:''' |
||
< |
<syntaxhighlight lang="swift"> |
||
let input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
let input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
let output = decode(encode(input)) |
let output = decode(encode(input)) |
||
print(output == input) |
print(output == input) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{Out}} |
{{Out}} |
||
Line 4,247: | Line 6,075: | ||
Converting encoded array into the string and then decoding it using NSScanner: |
Converting encoded array into the string and then decoding it using NSScanner: |
||
< |
<syntaxhighlight lang="swift">// "3W1B2W" -> "WWWBWW" |
||
func decode(encoded: String) -> String { |
func decode(encoded: String) -> String { |
||
let scanner = NSScanner(string: encoded) |
let scanner = NSScanner(string: encoded) |
||
Line 4,262: | Line 6,090: | ||
return out |
return out |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
< |
<syntaxhighlight lang="swift">let encodedString = encode(input).reduce("") { $0 + "\($1.0)\($1.1)" } |
||
print(encodedString) |
print(encodedString) |
||
let outputString = decode(encodedString) |
let outputString = decode(encodedString) |
||
print(outputString == input) |
print(outputString == input) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{Out}} |
{{Out}} |
||
Line 4,278: | Line 6,106: | ||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
The encoding is an even-length list with elements <tt>{count char ...}</tt> |
The encoding is an even-length list with elements <tt>{count char ...}</tt> |
||
< |
<syntaxhighlight lang="tcl">proc encode {string} { |
||
set encoding {} |
set encoding {} |
||
# use a regular expression to match runs of one character |
# use a regular expression to match runs of one character |
||
Line 4,292: | Line 6,120: | ||
} |
} |
||
return $decoded |
return $decoded |
||
}</ |
}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="tcl">set str "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
||
set enc [encode $str] ;# ==> {12 W 1 B 12 W 3 B 24 W 1 B 14 W} |
set enc [encode $str] ;# ==> {12 W 1 B 12 W 3 B 24 W 1 B 14 W} |
||
set dec [decode $enc] |
set dec [decode $enc] |
||
if {$str eq $dec} { |
if {$str eq $dec} { |
||
puts "success" |
puts "success" |
||
}</ |
}</syntaxhighlight> |
||
=={{header|TMG}}== |
|||
Unix TMG is designed to process and generate files rather than process text in memory. Therefore encoding and decoding parts can be done in separate programs. |
|||
Encoding: |
|||
<syntaxhighlight lang="unixtmg">loop: ordcop [lch?]\loop; |
|||
ordcop: ord/copy; |
|||
ord: char(ch)/last [ch!=lch?]\new [cnt++] fail; |
|||
new: ( [lch?] parse(out) | () ) [lch=ch] [cnt=1] fail; |
|||
out: decimal(cnt) scopy = { 2 1 }; |
|||
last: parse(out) [lch=0]; |
|||
copy: smark any(!<<>>); |
|||
ch: 0; |
|||
lch: 0; |
|||
cnt: 0;</syntaxhighlight> |
|||
Decoding: |
|||
<syntaxhighlight lang="unixtmg">loop: readint(n) copy\loop; |
|||
copy: smark any(!<<>>) |
|||
repeat: [n?] parse(( scopy )) [--n>0?]\repeat; |
|||
/* Reads decimal integer */ |
|||
readint: proc(n;i) ignore(<<>>) [n=0] inta |
|||
int1: [n = n*12+i] inta\int1; |
|||
inta: char(i) [i<72?] [(i =- 60)>=0?]; |
|||
i: 0; |
|||
n: 0;</syntaxhighlight> |
|||
=={{header|TSE SAL}}== |
|||
<syntaxhighlight lang="tsesal"> |
|||
STRING PROC FNStringGetDecodeStringCharacterEqualCountS( STRING inS ) |
|||
STRING s1[255] = "" |
|||
STRING s2[255] = "" |
|||
STRING s3[255] = "" |
|||
STRING s4[255] = "" |
|||
INTEGER I = 0 |
|||
INTEGER J = 0 |
|||
INTEGER K = 0 |
|||
INTEGER L = 0 |
|||
K = Length( inS ) |
|||
I = 1 - 1 |
|||
REPEAT |
|||
J = 1 - 1 |
|||
s3 = "" |
|||
REPEAT |
|||
I = I + 1 |
|||
J = J + 1 |
|||
s1 = SubStr( inS, I, 1 ) |
|||
s3 = s3 + s1 |
|||
s4 = SubStr( inS, I + 1, 1 ) |
|||
UNTIL ( NOT ( s4 IN '0'..'9' ) ) |
|||
FOR L = 1 TO Val( s3 ) |
|||
s2 = s2 + s4 |
|||
ENDFOR |
|||
I = I + 1 |
|||
UNTIL ( I >= ( K - 1 ) ) |
|||
RETURN( s2 ) |
|||
END |
|||
// |
|||
STRING PROC FNStringGetEncodeStringCharacterEqualCountS( STRING inS ) |
|||
STRING s1[255] = "" |
|||
STRING s2[255] = "" |
|||
INTEGER I = 0 |
|||
INTEGER J = 0 |
|||
INTEGER K = 0 |
|||
K = Length( inS ) |
|||
I = 1 - 1 |
|||
REPEAT |
|||
J = 1 - 1 |
|||
REPEAT |
|||
I = I + 1 |
|||
J = J + 1 |
|||
s1 = SubStr( inS, I, 1 ) |
|||
UNTIL ( NOT ( SubStr( inS, I + 1, 1 ) == s1 ) ) |
|||
s2 = s2 + Str( J ) + s1 |
|||
UNTIL ( I >= ( K - 1 ) ) |
|||
RETURN( s2 ) |
|||
END |
|||
// |
|||
STRING PROC FNStringGetEncodeDecodeStringCharacterEqualCountS( STRING inS ) |
|||
STRING s1[255] = FNStringGetEncodeStringCharacterEqualCountS( inS ) |
|||
STRING s2[255] = FNStringGetDecodeStringCharacterEqualCountS( s1 ) |
|||
RETURN( s2 ) |
|||
END |
|||
// |
|||
PROC Main() |
|||
STRING s1[255] = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
STRING s2[255] = "" |
|||
IF ( NOT ( Ask( "string: get: encode: decode: string: character: equal: count: inS = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF |
|||
s2 = FNStringGetEncodeDecodeStringCharacterEqualCountS( s1 ) |
|||
Warn( "equal strings if result is 1", ",", " ", "and the result is", ":", " ", s1 == s2 ) |
|||
END |
|||
</syntaxhighlight> |
|||
=={{header|TUSCRIPT}}== |
=={{header|TUSCRIPT}}== |
||
< |
<syntaxhighlight lang="tuscript"> |
||
$$ MODE TUSCRIPT,{} |
$$ MODE TUSCRIPT,{} |
||
input="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",output="" |
input="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",output="" |
||
Line 4,312: | Line 6,235: | ||
PRINT input |
PRINT input |
||
PRINT output |
PRINT output |
||
</syntaxhighlight> |
|||
</lang> |
|||
Output: |
Output: |
||
<pre> |
<pre> |
||
Line 4,318: | Line 6,241: | ||
12W1B12W3B24W1B14W |
12W1B12W3B24W1B14W |
||
</pre> |
</pre> |
||
=={{header|UNIX Shell}}== |
|||
{{works with|bash}} |
|||
<syntaxhighlight lang="bash">encode() { |
|||
local phrase=$1 |
|||
[[ -z $phrase ]] && return |
|||
local result="" count=0 char=${phrase:0:1} |
|||
for ((i = 0; i < ${#phrase}; i++)); do |
|||
if [[ ${phrase:i:1} == "$char" ]]; then |
|||
((count++)) |
|||
else |
|||
result+="$(encode_sequence "$count" "$char")" |
|||
char=${phrase:i:1} |
|||
count=1 |
|||
fi |
|||
done |
|||
result+="$(encode_sequence "$count" "$char")" |
|||
echo "$result" |
|||
} |
|||
encode_sequence() { |
|||
local count=$1 char=$2 |
|||
((count == 1)) && count="" |
|||
echo "${count}${char}" |
|||
} |
|||
decode() { |
|||
local phrase=$1 |
|||
local result="" |
|||
local count char |
|||
while [[ $phrase =~ ([[:digit:]]+)([^[:digit:]]) ]]; do |
|||
printf -v phrase "%s%s%s" \ |
|||
"${phrase%%${BASH_REMATCH[0]}*}" \ |
|||
"$(repeat "${BASH_REMATCH[1]}" "${BASH_REMATCH[2]}")" \ |
|||
"${phrase#*${BASH_REMATCH[0]}}" |
|||
done |
|||
echo "$phrase" |
|||
} |
|||
repeat() { |
|||
local count=$1 char=$2 |
|||
local result |
|||
# string of count spaces |
|||
printf -v result "%*s" "$count" "" |
|||
# replace spaces with the char |
|||
echo "${result// /$char}" |
|||
}</syntaxhighlight> |
|||
Demo |
|||
<syntaxhighlight lang="bash">str="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
enc=$(encode "$str") |
|||
dec=$(decode "$enc") |
|||
declare -p str enc dec |
|||
[[ $str == "$dec" ]] && echo success || echo failure</syntaxhighlight> |
|||
Output |
|||
<pre>declare -- str="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
declare -- enc="12WB12W3B24WB14W" |
|||
declare -- dec="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
success</pre> |
|||
=={{header|Ursala}}== |
=={{header|Ursala}}== |
||
Line 4,323: | Line 6,305: | ||
which is a second order function taking a binary predicate that decides |
which is a second order function taking a binary predicate that decides |
||
when consecutive items of an input list belong to the same run. |
when consecutive items of an input list belong to the same run. |
||
< |
<syntaxhighlight lang="ursala">#import std |
||
#import nat |
#import nat |
||
Line 4,338: | Line 6,320: | ||
< |
< |
||
encode test_data, |
encode test_data, |
||
decode encode test_data></ |
decode encode test_data></syntaxhighlight> |
||
The output shows an encoding of the test data, and a decoding of the encoding, which |
The output shows an encoding of the test data, and a decoding of the encoding, which |
||
matches the original test data. |
matches the original test data. |
||
Line 4,345: | Line 6,327: | ||
=={{header|VBA}}== |
=={{header|VBA}}== |
||
<syntaxhighlight lang="vb"> |
|||
<lang vb> |
|||
Option Explicit |
Option Explicit |
||
Line 4,382: | Line 6,364: | ||
Next |
Next |
||
length_decoding = a |
length_decoding = a |
||
End Function</ |
End Function</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>12W1B12W3B24W1B14W |
<pre>12W1B12W3B24W1B14W |
||
Line 4,393: | Line 6,375: | ||
Newlines are not converted (the regular expression does not count newlines). |
Newlines are not converted (the regular expression does not count newlines). |
||
This methods supports any type of input. |
This methods supports any type of input. |
||
< |
<syntaxhighlight lang="vedit">:RL_ENCODE: |
||
BOF |
BOF |
||
While (!At_EOF) { |
While (!At_EOF) { |
||
Line 4,423: | Line 6,405: | ||
} |
} |
||
} |
} |
||
Return</ |
Return</syntaxhighlight> |
||
=={{header|V (Vlang)}}== |
|||
<syntaxhighlight lang="Zig"> |
|||
const test = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
fn main() { |
|||
encoded := encode(test) |
|||
println(encoded) |
|||
println(decode(encoded)) |
|||
} |
|||
fn encode(data string) string { |
|||
mut encode :="" |
|||
mut temp := []u8{} |
|||
for key, value in data { |
|||
if key > 1 && value != data[key - 1] { |
|||
encode += temp.len.str() + temp[0].ascii_str() |
|||
temp.clear() |
|||
} |
|||
temp << value |
|||
} |
|||
encode += temp.len.str() + temp[0].ascii_str() |
|||
temp.clear() |
|||
return encode |
|||
} |
|||
fn decode(data string) string { |
|||
mut decode :="" |
|||
mut temp := []u8{} |
|||
for value in data { |
|||
if value.is_digit() == false { |
|||
decode += value.repeat(temp.bytestr().int()) |
|||
temp.clear() |
|||
} |
|||
else {temp << value} |
|||
} |
|||
return decode |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
12W1B12W3B24W1B14W |
|||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
|||
=={{header|Wren}}== |
|||
{{libheader|Wren-pattern}} |
|||
<syntaxhighlight lang="wren">import "./pattern" for Pattern |
|||
var p = Pattern.new("/u") // match any upper case letter |
|||
var encode = Fn.new { |s| |
|||
if (s == "") return s |
|||
var e = "" |
|||
var curr = s[0] |
|||
var count = 1 |
|||
var i = 1 |
|||
while (i < s.count) { |
|||
if (s[i] == curr) { |
|||
count = count + 1 |
|||
} else { |
|||
e = e + count.toString + curr |
|||
curr = s[i] |
|||
count = 1 |
|||
} |
|||
i = i + 1 |
|||
} |
|||
return e + count.toString + curr |
|||
} |
|||
var decode = Fn.new { |e| |
|||
if (e == "") return e |
|||
var letters = Pattern.matchesText(p.findAll(e)) |
|||
var numbers = p.splitAll(e)[0..-2].map { |s| Num.fromString(s) }.toList |
|||
return (0...letters.count).reduce("") { |acc, i| acc + letters[i]*numbers[i] }.join() |
|||
} |
|||
var strings = [ |
|||
"AA", |
|||
"RROSETTAA", |
|||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" |
|||
] |
|||
for (s in strings) { |
|||
System.print("Original text : %(s)") |
|||
var e = encode.call(s) |
|||
System.print("Encoded text : %(e)") |
|||
var d = decode.call(e) |
|||
System.print("Decoded text : %(d)") |
|||
System.print("Original = decoded : %(s == d)\n") |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Original text : AA |
|||
Encoded text : 2A |
|||
Decoded text : AA |
|||
Original = decoded : true |
|||
Original text : RROSETTAA |
|||
Encoded text : 2R1O1S1E2T2A |
|||
Decoded text : RROSETTAA |
|||
Original = decoded : true |
|||
Original text : WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Encoded text : 12W1B12W3B24W1B14W |
|||
Decoded text : WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Original = decoded : true |
|||
</pre> |
|||
=={{header|XPL0}}== |
=={{header|XPL0}}== |
||
< |
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations |
||
string 0; \use zero-terminated strings, instead of MSb terminated |
string 0; \use zero-terminated strings, instead of MSb terminated |
||
Line 4,466: | Line 6,559: | ||
CrLf(0); |
CrLf(0); |
||
Expand("W11BW11B2W23BW13"); CrLf(0); |
Expand("W11BW11B2W23BW13"); CrLf(0); |
||
]</ |
]</syntaxhighlight> |
||
Output (with slightly better compression than the example): |
Output (with slightly better compression than the example): |
||
Line 4,472: | Line 6,565: | ||
W11BW11B2W23BW13 |
W11BW11B2W23BW13 |
||
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
||
</pre> |
|||
=={{header|Zig}}== |
|||
<syntaxhighlight lang="zig">const std = @import("std"); |
|||
fn Run(comptime T: type) type { |
|||
return struct { |
|||
value: T, |
|||
length: usize, |
|||
}; |
|||
} |
|||
fn encode( |
|||
comptime T: type, |
|||
input: []const T, |
|||
allocator: std.mem.Allocator, |
|||
) ![]Run(T) { |
|||
var runs = std.ArrayList(Run(T)).init(allocator); |
|||
defer runs.deinit(); |
|||
var previous: ?T = null; |
|||
var length: usize = 0; |
|||
for (input) |current| { |
|||
if (previous == current) { |
|||
length += 1; |
|||
} else if (previous) |value| { |
|||
try runs.append(.{ |
|||
.value = value, |
|||
.length = length, |
|||
}); |
|||
previous = current; |
|||
length = 1; |
|||
} else { |
|||
previous = current; |
|||
length += 1; |
|||
} |
|||
} |
|||
if (previous) |value| { |
|||
try runs.append(.{ |
|||
.value = value, |
|||
.length = length, |
|||
}); |
|||
} |
|||
return runs.toOwnedSlice(); |
|||
} |
|||
test encode { |
|||
const input = |
|||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
|||
const expected = [_]Run(u8){ |
|||
.{ .length = 12, .value = 'W' }, |
|||
.{ .length = 1, .value = 'B' }, |
|||
.{ .length = 12, .value = 'W' }, |
|||
.{ .length = 3, .value = 'B' }, |
|||
.{ .length = 24, .value = 'W' }, |
|||
.{ .length = 1, .value = 'B' }, |
|||
.{ .length = 14, .value = 'W' }, |
|||
}; |
|||
const allocator = std.testing.allocator; |
|||
const actual = try encode(u8, input, allocator); |
|||
defer allocator.free(actual); |
|||
try std.testing.expectEqual(expected.len, actual.len); |
|||
for (expected, actual) |e, a| { |
|||
try std.testing.expectEqual(e.length, a.length); |
|||
try std.testing.expectEqual(e.value, a.value); |
|||
} |
|||
} |
|||
fn decode( |
|||
comptime T: type, |
|||
runs: []const Run(T), |
|||
allocator: std.mem.Allocator, |
|||
) ![]T { |
|||
var values = std.ArrayList(T).init(allocator); |
|||
defer values.deinit(); |
|||
for (runs) |r| |
|||
try values.appendNTimes(r.value, r.length); |
|||
return values.toOwnedSlice(); |
|||
} |
|||
test decode { |
|||
const runs = [_]Run(u8){ |
|||
.{ .length = 12, .value = 'W' }, |
|||
.{ .length = 1, .value = 'B' }, |
|||
.{ .length = 12, .value = 'W' }, |
|||
.{ .length = 3, .value = 'B' }, |
|||
.{ .length = 24, .value = 'W' }, |
|||
.{ .length = 1, .value = 'B' }, |
|||
.{ .length = 14, .value = 'W' }, |
|||
}; |
|||
const allocator = std.testing.allocator; |
|||
const decoded = try decode(u8, &runs, allocator); |
|||
defer allocator.free(decoded); |
|||
try std.testing.expectEqualStrings( |
|||
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW", |
|||
decoded, |
|||
); |
|||
} |
|||
pub fn main() !void { |
|||
var gpa = std.heap.GeneralPurposeAllocator(.{}){}; |
|||
defer std.debug.assert(gpa.deinit() == .ok); |
|||
const allocator = gpa.allocator(); |
|||
var input = std.ArrayList(u8).init(allocator); |
|||
defer input.deinit(); |
|||
const stdout = std.io.getStdOut().writer(); |
|||
const stdin = std.io.getStdIn().reader(); |
|||
try stdout.print("Input: ", .{}); |
|||
try stdin.streamUntilDelimiter(input.writer(), '\n', null); |
|||
const runs = try encode(u8, input.items, allocator); |
|||
defer allocator.free(runs); |
|||
try stdout.print("Encoded:\n", .{}); |
|||
for (runs) |r| |
|||
try stdout.print(" {}\n", .{r}); |
|||
const decoded = try decode(u8, runs, allocator); |
|||
defer allocator.free(decoded); |
|||
try stdout.print("Decoded: {s}\n", .{decoded}); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
Encoded: |
|||
run_length_encoding.Run(u8){ .value = 87, .length = 12 } |
|||
run_length_encoding.Run(u8){ .value = 66, .length = 1 } |
|||
run_length_encoding.Run(u8){ .value = 87, .length = 12 } |
|||
run_length_encoding.Run(u8){ .value = 66, .length = 3 } |
|||
run_length_encoding.Run(u8){ .value = 87, .length = 24 } |
|||
run_length_encoding.Run(u8){ .value = 66, .length = 1 } |
|||
run_length_encoding.Run(u8){ .value = 87, .length = 14 } |
|||
Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW |
|||
</pre> |
</pre> |
||
=={{header|zkl}}== |
=={{header|zkl}}== |
||
A byte stream to byte stream codec, the streams hard coded for ease. Character '\1' is used as a sentinel and there are limits on the run length to avoid byte overflow. |
A byte stream to byte stream codec, the streams hard coded for ease. Character '\1' is used as a sentinel and there are limits on the run length to avoid byte overflow. |
||
< |
<syntaxhighlight lang="zkl">const MAX_LEN=250, MIN_LEN=3; |
||
fcn compress(text){ // !empty byte/text stream -->Data (byte stream) |
fcn compress(text){ // !empty byte/text stream -->Data (byte stream) |
||
sink:=Data(); cnt:=Ref(0); |
sink:=Data(); cnt:=Ref(0); |
||
Line 4,493: | Line 6,730: | ||
},text[0]) : write(_,cnt.value); |
},text[0]) : write(_,cnt.value); |
||
sink; |
sink; |
||
}</ |
}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="zkl">fcn inflate(data){ //-->String |
||
data.howza(3).pump(String, |
data.howza(3).pump(String, |
||
fcn(c){ // if c==1, read n,c2 and expand, else write c |
fcn(c){ // if c==1, read n,c2 and expand, else write c |
||
if(c=="\x01") return(Void.Read,2) else return(Void.Write,c) }, |
if(c=="\x01") return(Void.Read,2) else return(Void.Write,c) }, |
||
fcn(_,n,c){ c*n.toAsc() }) |
fcn(_,n,c){ c*n.toAsc() }) |
||
}</ |
}</syntaxhighlight> |
||
< |
<syntaxhighlight lang="zkl">text:="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"; |
||
d:=compress(text); |
d:=compress(text); |
||
d.bytes().println(); |
d.bytes().println(); |
||
println(text.len()," bytes --> ",d.len()," bytes"); |
println(text.len()," bytes --> ",d.len()," bytes"); |
||
println(text==inflate(d));</ |
println(text==inflate(d));</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
Latest revision as of 20:08, 3 February 2024
This page uses content from Wikipedia. The original article was at Run-length_encoding. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |
You are encouraged to solve this task according to the task description, using any language you may know.
- 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:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
- Output:
12W1B12W3B24W1B14W
Note: the encoding step in the above example is the same as a step of the Look-and-say sequence.
11l
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))
- Output:
Encoded value is [5a, 6h, 7m, 1u, 7i, 6a] Decoded value is aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa
8086 Assembly
Output is in hexadecimal but is otherwise correct.
.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
- Output:
0C 57 01 42 0C 57 03 42 .W.B.W.B 18 57 01 42 0E 57 00 00 .W.B.W.. 00 00 00 00 00 00 00 00 ........ 00 00 00 00 00 00 00 00 ........
The hexdump above converts to: 12W 1B 12W 3B 24W 1B 14W
Action!
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
- Output:
Screenshot from Atari 8-bit computer
original: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded: 12W1B12W3B24W1B14W decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Ada
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;
Sample output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
ALGOL 68
Note: The following uses iterators, eliminating the need of declaring arbitrarily large CHAR arrays for caching.
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)
Output:
Encode input: 12W1B12W3B24W1B14W Decode output: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Amazing Hopper
/*
TASK BASIC-EMBEBIDO de HOPPER
onechar("WB",objetivo)
deja un único carcater de todos los que encuentre consecutivamente,
de la lista de caracteres "WB".
índice:=()
copia el valor de la función entre paréntesis en "índice", pero
deja ese valor en el stack de trabajo, para ser asignado a "largo".
poschar(INICIO, v, objetivo)
entrega la posición donde el caracter dado "v" deja de repetirse
(por eso se resta 1 al resultado).
objetivo+=sublargo
borra los primeros sublargo-ésimo caracteres.
#basic{...} / #(...)
BASIC embebido de Hopper.
*/
#include <basico.h>
#define INICIO 1
#proto codificar(_X_,_Y_,_Z_)
#proto decodificar(_X_,_Y_)
principal {
índice="", largo=0, codificado="", decodificado=""
objetivo = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
decimales '0', fijar separador 'NULO'
#basic{
largo = len(índice:=( onechar("WB",objetivo) ) )
print ("Original =",objetivo,NL)
codificado = codificar(objetivo, índice, largo)
decodificado = decodificar(codificado, índice)
print ("Codificado =",codificado,"\nDecodificado =",decodificado,NL)
}
terminar
}
subrutinas
codificar( o, i, l)
v="", sublargo=0
para cada caracter ( v, i, l )
/* deja ésto en el stack de trabajo: */
#( sublargo := (poschar(INICIO, v, o) - 1 ) ), 'v'
o+=sublargo
siguiente
unir esto
retornar
decodificar(c, i)
v="", posición=0, l=0
#( l=len(i) )
para cada caracter ( v, i, l )
#basic{
posición = find(v, c)-1
/* deja ésto en el stack de trabajo: */
replicate(v, number(copy(posición,1,c)) )
}
++posición,c+=posición
siguiente
unir esto
retornar
- Output:
Original =WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Codificado =12W1B12W3B24W1B14W Decodificado =WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
APL
∇ ret←RLL rll;count
[1] count←∣2-/((1,(2≠/rll),1)×⍳1+⍴rll)~0
[2] ret←(⍕count,¨(1,2≠/rll)/rll)~' '
∇
Sample Output:
RLL 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' 12W1B12W3B24W1B14W
AppleScript
------------------ 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|
- Output:
W12B1W12B3W24B1W14 WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW true
Arturo
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!"
- Output:
encoded: 12W1B12W3B24W1B14W decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Success!
AutoHotkey
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
}
AWK
It works with "textual" input. Lines containing numbers are skipped, since they can't be represented in a not ambiguous way in this implementation (e.g. "11AA" would be encoded as "212A", which would be decoded as A repeated 212 times!)
Encoding
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)
}
Decoding
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
}
BaCon
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$)
- Output:
RLEData: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded: 12W1B12W3B24W1B14W Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
BASIC
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
Sample output (last one shows errors from using numbers in input string):
Type something: aaaaeeeeeeiiiioooouuy aaaaeeeeeeiiiioooouuy 4a6e4i4o2u1y aaaaeeeeeeiiiioooouuy Type something: My dog has fleas. My dog has fleas. 1M1y1 1d1o1g1 1h1a1s1 1f1l1e1a1s1. My dog has fleas. Type something: 1r 1r 111r rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
Applesoft BASIC
10 I$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
20 GOSUB 100ENCODE
30 GOSUB 200DECODE
40 PRINT "INPUT: ";I$
50 PRINT "OUTPUT: ";
60 GOSUB 250 PRINT
70 END
100 O$ = MID$ (I$,1,1):N$ = MID$ ( CHR$ (0),1, LEN (O$)): IF LEN (I$) < 2 THEN RETURN
110 FOR I = 2 TO LEN (I$):C$ = MID$ (I$,I,1): IF C$ < > RIGHT$ (O$,1) THEN O$ = O$ + C$:N$ = N$ + CHR$ (0): NEXT I: RETURN
120 N$ = MID$ (N$,1, LEN (O$) - 1) + CHR$ ( ASC ( MID$ (N$, LEN (O$))) + 1): NEXT I: RETURN
200 I$ = "": IF LEN (O$) THEN FOR I = 1 TO LEN (O$): FOR J = 0 TO ASC ( MID$ (N$,I)):I$ = I$ + MID$ (O$,I,1): NEXT J,I
210 RETURN
250 IF LEN (O$) THEN FOR I = 1 TO LEN (O$): PRINT ASC ( MID$ (N$,I)) + 1; MID$ (O$,I,1);: NEXT I
260 RETURN
- Output:
INPUT: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW OUTPUT: 12W1B12W3B24W1B14W
BASIC256
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
- Output:
La salida es similar a la de BASIC, mostrada arriba.
BBC BASIC
The run counts are indicated by means of character codes in the range 131 to 255.
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$
Befunge
Not the same format as in the example,it puts "n\n" at the beginning so you can pipe the output back in and receive the input. Pipe the output of the program-it's more reliable.
~"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
Bracmat
( 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
12W1B12W3B24W1B14W
Burlesque
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
=[{^^[~\/L[Sh}\m
C
Encoder that can deal with byte streams. Can encode/decode any byte values and any length with reasonable efficiency. Also showing OO and polymophism with structs.
#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;
}
C#
Linq
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();
}
}
}
Output:
raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded = 12W1B12W3B24W1B14W Encode(raw) = encoded = 12W1B12W3B24W1B14W Decode(encode) = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Decode(Encode(raw)) = True
Many solutions do not follow the suggested output guideline in the challenge (not helped by its wording), instead producing a list of tuples or equivalent. This is much simpler (especially for decode) and the following provides an equivalent of those (IMHO deficient) solutions, to make comparisons easier.
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}]"));
}
}
Output:
raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encode(raw) = encoded = [12,W],[1,B],[12,W],[3,B],[24,W],[1,B],[14,W] Decode(encoded) = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Decode(Encode(raw)) = True
Stringbuilder version. Might be more performant but mixes output formatting with encoding/decoding logic.
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();
}
}
}
Output:
raw = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded = 12W1B12W3B24W1B14W Encode(raw) = encoded = 12W1B12W3B24W1B14W Decode(encode) = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Decode(Encode(raw)) = True
Imperative
This example only works if there are no digits in the string to be encoded and then decoded.
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();
}
RegEx
Somewhat shorter, using Regex.Replace with MatchEvaluator (using C#2 syntax only):
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));
});
}
}
C++
#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';
}
#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( ) ;
}
Ceylon
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");
}
Clojure
(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)))
COBOL
>>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.
- Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded: 12W1B12W3B24W1B14W Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
CoffeeScript
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
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW W12B1W12B3W24B1W14 WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
The following version encodes the number of ocurrences as an unicode character. You can change the way it looks by rotating the offset.
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('')
> encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" WWBLWWBNWcBLWY > encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW", 1200 WҼBұWҼBҳWӈBұWҾ > encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW", 5200 WᑜBᑑWᑜBᑓWᑨBᑑWᑞ
Common Lisp
(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)))
D
Short Functional Version
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));
}
Basic Imperative Version
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);
}
- Output:
Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded: 12W1B12W3B24W1B14W
UTF String Version
D's native string is utf-encoded. This version works for utf string, and uses a Variable-length Quantity module.
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");
}
output from "display.txt":
尋尋覓覓冷冷清清淒淒慘慘戚戚 WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 11#222##333 ----- 2尋2覓2冷2清2淒2慘2戚1 12W1B12W3B24W1B14W1 2#11##3#22##3#3 ----- 尋尋覓覓冷冷清清淒淒慘慘戚戚 WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 11#222##333
NOTE: some characters in this section use Chinese font.
UTF String Version with Regular Expression
The code looks more complex than the third Python version because this also handles digits by escaping them with #.
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)));
}
Déjà Vu
rle:
if not dup:
drop
return []
swap ]
local :source chars
pop-from source
1
for c in source:
if = c over:
++
else:
1 c &
&
return [
rld:
)
for pair in swap:
repeat &< pair:
&> pair
concat(
rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
!. dup
!. rld
- Output:
[ & 12 "W" & 1 "B" & 12 "W" & 3 "B" & 24 "W" & 1 "B" & 14 "W" ] "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Delphi
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.
- Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
E
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
}
? rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
# value: [[12, 'W'], [1, 'B'], [12, 'W'], [3, 'B'], [24, 'W'], [1, 'B'], [14, 'W']]
? unrle(rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"))
# value: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
EasyLang
func$ rlenc in$ .
for c$ in strchars in$
if c$ = c0$
cnt += 1
else
if cnt > 0
out$ &= cnt & c0$ & " "
.
c0$ = c$
cnt = 1
.
.
out$ &= cnt & c0$
return out$
.
func$ rldec in$ .
for h$ in strsplit in$ " "
c$ = substr h$ len h$ 1
for i to number h$
out$ &= c$
.
.
return out$
.
s$ = input
print s$
s$ = rlenc s$
print s$
s$ = rldec s$
print s$
#
input_data
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Elena
ELENA 6.x :
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)
}
- Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Elixir
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)
- Output:
string "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" "12W1B12W3B24W1B14W" "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" char_list 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW' '12W1B12W3B24W1B14W' 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
Emacs Lisp
(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) "")))
(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))))
Erlang
A single-threaded/process version with a simple set of unit test.
-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)
].
A version that works on character lists:
-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]).
Euphoria
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))
Output:
{12,'W',1,'B',12,'W',3,'B',24,'W',1,'B',14,'W'} WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
F#
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) ""
Factor
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@
- Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
FALSE
1^[^$~][$@$@=$[%%\1+\$0~]?~[@.,1\$]?%]#%\., {encode}
[0[^$$'9>'0@>|~]['0-\10*+]#]n:
[n;!$~][[\$][1-\$,]#%%]#%% {decode}
Fan
**
** 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}" }
}
Forth
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 - ;
Example:
s" WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
here 1000 + encode here 2000 + decode cr 3 spaces type
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Fortran
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
Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
FreeBASIC
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
- Output:
La salida es similar a la de BASIC, mostrada arriba.
FutureBasic
This gives RLE encoding for strings and RLE decoding for strings and arrays, e.g., for Conway's Game of Life
local fn encode( string as CFStringRef) as CFStringRef
CFStringRef ch, s, t
Short i, rl
s = @"" // Initalize the output string
for i = 0 to len( string ) - 1 // Encode string char by char
ch = mid( string, i, 1) // Read character at index
rl = 1 // Start run-length counter
while fn StringIsEqual( mid( string, i + rl, 1), ch )
rl ++ // Same char, so increase counter
wend
if rl == 1 then t = @"" else t = fn StringWithFormat( @"%d", rl ) // Counter as string, don't encode 1's
t = fn StringByAppendingString( t, ch ) // Add character
s = fn StringByAppendingString( s, t ) // Add to already encoded string
i += rl - 1 // Move index
next
print s
end fn
local fn decode( string as CFStringRef )
CFStringRef ch, s, t // character, outputstring, temporary string
Short i, rl // index, run length
s = @"" // Initalize the output string
for i = 0 to len( string ) - 1 // Decode input string char by char
ch = mid( string, i, 1 ) // Read character at index
if intval( ch ) == 0 // Not a digit
rl = 1
else
rl = intval( mid( string, i ) ) // Read run-length
i += fix( log10( rl ) + 1 ) // Move index past digits
ch = mid( string, i, 1 ) // Read character after run length
end if
t = fn StringByPaddingToLength( ch, rl, ch, 0 ) // Assemble temp string
s = fn StringByAppendingString( s, t ) // Add to decoded string
next
print s
end fn
local fn decode2D( string as CFStringRef ) // For Conway's Game of Life objects
Boolean a(500, 500) // Or larger to hold bigger life forms
CFStringRef ch
Short i, j, rl, f // Decoded char
Short v = 0, w = 0, x = 0, y = 0 // Temp width, max width, array coordinates
for i = 0 to len( string ) - 2 // Final char is always !
ch = mid( string, i, 1 )
if intval( ch ) == 0
rl = 1
else
rl = intval( mid( string, i ) )
i += fix( log10( rl ) + 1 )
ch = mid( string, i, 1 )
end if
select ch // Decode character as:
case @"$" : f = -1 // - new line
case @"b" : f = 0 // - dead
case @"o" : f = 1 // - live
case else : // Ignore
end select
for j = 1 to rl // Fill array with run of chars
if f = -1
x = 0 : y ++ : v = 0 // New line
else
a(x, y) = f
x ++ : v ++ : if v > w then w = v
end if
next
next
for j = 0 to y : for i = 0 to w - 1
print a(i, j);
next : print : next
end fn
fn decode( @"12W1B12W3B24W1B14W" ) // Assignment
fn encode( @"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" )
fn decode2D( @"bo$2bo$3o!" ) // Glider
handleevents // Join Mac event loop
Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12WB12W3B24WB14W 011 001 111
Gambas
Click this link to run this code
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
Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W, 1B, 12W, 3B, 24W, 1B, 14W
Go
Decoder kind of necessary to demonstrate task requirement that I can recreate the input.
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)
}
Output:
source: 67 bytes: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded: 12 bytes: [36 22 1 36 22 27 1 48 22 1 38 22] decoded: 67 bytes: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW decoded = source: true
Groovy
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()
}
Test code
def text = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
def rleEncoded = rleEncode(text)
assert rleEncoded == '12W1B12W3B24W1B14W'
assert text == rleDecode(rleEncoded)
println "Original Text: $text"
println "Encoded Text: $rleEncoded"
Output:
Original Text: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded Text: 12W1B12W3B24W1B14W
Haskell
In terms of group
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
- Output:
Encoded: [(12,'W'),(1,'B'),(12,'W'),(3,'B'),(24,'W'),(1,'B'),(14,'W')] Decoded: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Or:
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)
- Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW test: text == decode => True
In terms of span
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
- Output:
W12B1W12B3W24B1W14 WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW True
As a fold
----------------------- 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
- Output:
12W1B12W3B24W1B14W True
Icon and Unicon
Sample output:
s="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" s1="12W1B12W3B24W1B14W" s2="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" Encode/Decode worked.
J
Solution:
rle=: ;@(<@(":@(#-.1:),{.);.1~ 1, 2 ~:/\ ])
rld=: ;@(-.@e.&'0123456789' <@({:#~1{.@,~".@}:);.2 ])
Example:
rle 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
12W1B12W3B24W1B14W
rld '12W1B12W3B24W1B14W'
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Note that this implementation fails for the empty case. Here's a version that fixes that:
rle=: ;@(<@(":@#,{.);.1~ 2 ~:/\ (a.{.@-.{.),])
Other approaches include using rle ::(''"_) or rle^:(*@#) or equivalent variations on the original sentence.
Alternative Implementation
A numeric approach, based on a discussion in the J forums (primarily Pascal Jasmin and Marshall Lochbaum):
torle=: (#, {.);.1~ 1,2 ~:/\ ]
frle=: #/@|:
Task example:
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
Note that this approach also fails on the empty case.
Java
This can be achieved using regular expression capturing
import java.util.regex.Matcher;
import java.util.regex.Pattern;
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();
}
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();
}
string = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded = 12W1B12W3B24W1B14W decoded = WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW string.equals(decoded) = true string = https://www.rosettacode.org/ encoded = 1h2t1p1s1:2/3w1.1r1o1s1e2t1a1c1o1d1e1.1o1r1g1/ decoded = https://www.rosettacode.org/ string.equals(decoded) = true
An alternate demonstration
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"));
}
}
Tests:
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"));
}
}
JavaScript
ES5
Here's an encoding method that walks the input string character by character
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;
}
Here's an encoding method that uses a regular expression to grab the character runs (
for the forEach
method)
function encode_re(input) {
var encoding = [];
input.match(/(.)\1*/g).forEach(function(substr){ encoding.push([substr.length, substr[0]]) });
return encoding;
}
And to decode (see Repeating a string)
function decode(encoded) {
var output = "";
encoded.forEach(function(pair){ output += new Array(1+pair[0]).join(pair[1]) })
return output;
}
ES6
By defining a generic group function:
(() => {
'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();
})();
- Output:
From: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" -> [[12,"W"],[1,"B"],[12,"W"],[3,"B"],[24,"W"],[1,"B"],[14,"W"]] -> "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
A .reduce()
based one-liner
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")
jq
Note: "run_length_decode" as defined below requires a version of jq with regex support.
Utility function:
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 ) ;
Run-length encoding and decoding:
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)) ;
Example:
"ABBCCC" | run_length_encode | run_length_decode
- Output:
$ jq -n -f Run_length_encoding.jq
"ABBCCC"
Julia
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
- Output:
Original: aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa -> encoded: Tuple{Int64,Char}[(5, 'a'), (6, 'h'), (7, 'm'), (1, 'u'), (7, 'i'), (6, 'a')] -> decoded: aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa Original: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW -> encoded: Tuple{Int64,Char}[(12, 'W'), (1, 'B'), (12, 'W'), (3, 'B'), (24, 'W'), (1, 'B'), (14, 'W')] -> decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
K
rle: {,/($-':i,#x),'x@i:&1,~=':x}
rld: {d:"0123456789"; ,/(.(d," ")@d?/:x)#'x _dvl d}
Example:
rle "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
"12W1B12W3B24W1B14W"
rld "12W1B12W3B24W1B14W"
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Kotlin
Tail recursive implementation of Run Length Encoding
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")
}
Lasso
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')
- Output:
12W1B12W3B24W1B14W 1d1s1f1k1j2h1k1d1s1j1f1h1d1s1k1h1s1h1d2j1f2h1d1l1s2l1w WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW dsfkjhhkdsjfhdskhshdjjfhhdlsllw
Liberty BASIC
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
LiveCode
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
Logo
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
Lua
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
M2000 Interpreter
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
- Output:
Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW RLE Encoded: 12W1B12W3B24W1B14W RLE Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Checked: True
Mathematica/Wolfram Language
The function
RunLengthEncode[input_String]:= (l |-> {First@l, Length@l}) /@ (Split@Characters@input)
takes as input an arbitrary string of characters and returns a list of {c, n} pairs, where c is the character and n is the number of repeats. The function
RunLengthDecode[input_List]:= ConstantArray @@@ input // Flatten // StringJoin
recreates the string.
Example: For the string
mystring="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
here is the run-length encoding:
rle = RunLengthEncode[mystring]
{{"W", 12}, {"B", 1}, {"W", 12}, {"B", 3}, {"W", 24}, {"B", 1}, {"W", 14}}
Check that the input string is recreated:
mystring == RunLengthDecode[rle]
True
Maxima
To encode
rle(a) := block(
[n: slength(a), b: "", c: charat(a, 1), k: 1],
for i from 2 thru n do
if cequal(c, charat(a, i)) then k: k + 1 else (b: sconcat(b, k, c), c: charat(a, i), k: 1),
sconcat(b, k, c)
)$
To decode
/* Function to return a list where all but the last entries are integers */
intbucket(lst):=block(bucket:[],while integerp(first(lst)) do (push(first(lst),bucket),lst:rest(lst)),lst:append(reverse(bucket),[first(lst)]));
/* Run-length decoding */
rld(string_list):=block(
coref:map(eval_string,charlist(string_list)),
listcharact:sublist(coref,lambda([x],integerp(x)=false)),
map(intbucket,append([coref],makelist(coref:rest(coref,length(intbucket(coref))),length(listcharact)-1))),
makelist(sublist(%%[i],integerp),i,1,length(%%)),
map(eval_string,makelist(apply(concat,%%[i]),i,1,length(%%))),
makelist(smake(%%[i],string(listcharact[i])),i,1,length(listcharact)),
apply(concat,%%));
Output
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW");
"12W1B12W3B24W1B14W"
rld(%);
/* "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" */
MMIX
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
Example run encode --> decode:
~/MIX/MMIX/Rosetta> mmix rle 12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Nim
import parseutils, strutils
proc compress(input: string): string =
var
count = 1
prev = '\0'
for ch in input:
if ch != prev:
if prev != '\0':
result.add $count & prev
count = 1
prev = ch
else:
inc count
result.add $count & prev
proc uncompress(text: string): string =
var start = 0
var count: int
while true:
let n = text.parseInt(count, start)
if n == 0 or start + n >= text.len:
raise newException(ValueError, "corrupted data.")
inc start, n
result.add repeat(text[start], count)
inc start
if start == text.len: break
const Text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
echo "Text: ", Text
let compressed = Text.compress()
echo "Compressed: ", compressed
echo "Uncompressed: ", compressed.uncompress()
- Output:
Text: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Compressed: 12W1B12W3B24W1B14W Uncompressed: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Objeck
use RegEx;
class RunLengthEncoding {
function : Main(args : String[]) ~ Nil {
input := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
encoded := Encode(input);
"encoding: {$encoded}"->PrintLine();
test := encoded->Equals("12W1B12W3B24W1B14W");
"encoding match: {$test}"->PrintLine();
decoded := Decode(encoded);
test := input->Equals(decoded);
"decoding match: {$test}"->PrintLine();
}
function : Encode(source : String) ~ String {
dest := "";
each(i : source) {
runLength := 1;
while(i+1 < source->Size() & source->Get(i) = source->Get(i+1)) {
runLength+= 1;
i+= 1;
};
dest->Append(runLength);
dest->Append(source->Get(i));
};
return dest;
}
function : Decode(source : String) ~ String {
output := "";
regex := RegEx->New("[0-9]+|([A-Z]|[a-z])");
found := regex->Find(source);
count : Int;
each(i : found) {
if(i % 2 = 0) {
count := found->Get(i)->As(String)->ToInt();
}
else {
letter := found->Get(i)->As(String);
while(count <> 0) {
output->Append(letter);
count -= 1;
};
};
};
return output;
}
}
encoding: 12W1B12W3B24W1B14W encoding match: true decoding match: true
Objective-C
See Run-length encoding/Objective-C
OCaml
let encode str =
let len = String.length str in
let rec aux i acc =
if i >= len then List.rev acc
else
let c1 = str.[i] in
let rec aux2 j =
if j >= len then (c1, j-i)
else
let c2 = str.[j] in
if c1 = c2
then aux2 (j+1)
else (c1, j-i)
in
let (c,n) as t = aux2 (i+1) in
aux (i+n) (t::acc)
in
aux 0 []
;;
let decode lst =
let l = List.map (fun (c,n) -> String.make n c) lst in
(String.concat "" l)
let () =
let e = encode "aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa" in
List.iter (fun (c,n) ->
Printf.printf " (%c, %d);\n" c n;
) e;
print_endline (decode [('a', 5); ('h', 6); ('m', 7); ('u', 1); ('i', 7); ('a', 6)]);
;;
- Using regular expressions
#load "str.cma";;
open Str
let encode =
global_substitute (Str.regexp "\\(.\\)\\1*")
(fun s -> string_of_int (String.length (matched_string s)) ^
matched_group 1 s)
let decode =
global_substitute (Str.regexp "\\([0-9]+\\)\\([^0-9]\\)")
(fun s -> String.make (int_of_string (matched_group 1 s))
(matched_group 2 s).[0])
let () =
print_endline (encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW");
print_endline (decode "12W1B12W3B24W1B14W");
Oforth
: encode(s)
StringBuffer new
s group apply(#[ tuck size asString << swap first <<c ]) ;
: decode(s)
| c i |
StringBuffer new
0 s forEach: c [
c isDigit ifTrue: [ 10 * c asDigit + continue ]
loop: i [ c <<c ] 0
]
drop ;
- Output:
>"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" encode .s [1] (StringBuffer) 12W1B12W3B24W1B14W ok >decode .s [1] (StringBuffer) WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW ok
Ol
(define (RLE str)
(define iter (string->list str))
(let loop ((iter iter) (chr (car iter)) (n 0) (rle '()))
(cond
((null? iter)
(reverse (cons (cons n chr) rle)))
((char=? chr (car iter))
(loop (cdr iter) chr (+ n 1) rle))
(else
(loop (cdr iter) (car iter) 1 (cons (cons n chr) rle))))))
(define (decode rle)
(apply string-append (map (lambda (p)
(make-string (car p) (cdr p))) rle)))
Test:
(define str "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
(print str)
(define rle (RLE str))
(for-each (lambda (pair)
(print (car pair) " : " (string (cdr pair))))
rle)
(print (decode rle))
- Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12 : W 1 : B 12 : W 3 : B 24 : W 1 : B 14 : W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Oz
declare
fun {RLEncode Xs}
for G in {Group Xs} collect:C do
{C {Length G}#G.1}
end
end
fun {RLDecode Xs}
for C#Y in Xs append:Ap do
{Ap {Replicate Y C}}
end
end
%% Helpers
%% e.g. "1122" -> ["11" "22"]
fun {Group Xs}
case Xs of nil then nil
[] X|Xr then
Ys Zs
{List.takeDropWhile Xr fun {$ W} W==X end ?Ys ?Zs}
in
(X|Ys) | {Group Zs}
end
end
%% e.g. 3,4 -> [3 3 3 3]
fun {Replicate X N}
case N of 0 then nil
else X|{Replicate X N-1}
end
end
Data = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Enc = {RLEncode Data}
in
{System.showInfo Data}
{Show Enc}
{System.showInfo {RLDecode Enc}}
PARI/GP
rle(s)={
if(s=="", return(s));
my(v=Vec(s),cur=v[1],ct=1,out="");
v=concat(v,99); \\ sentinel
for(i=2,#v,
if(v[i]==cur,
ct++
,
out=Str(out,ct,cur);
cur=v[i];
ct=1
)
);
out
};
elr(s)={
if(s=="", return(s));
my(v=Vec(s),ct=eval(v[1]),out="");
v=concat(v,99); \\ sentinel
for(i=2,#v,
if(v[i]>="0" && v[i]<="9",
ct=10*ct+eval(v[i])
,
for(j=1,ct,out=Str(out,v[i]));
ct=0
)
);
out
};
rle("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
elr(%)
Output:
%1 = "12W1B12W3B24W1B14W" %2 = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Pascal
Program RunLengthEncoding(output);
procedure encode(s: string; var counts: array of integer; var letters: string);
var
i, j: integer;
begin
j := 0;
letters := '';
if length(s) > 0 then
begin
j := 1;
letters := letters + s[1];
counts[1] := 1;
for i := 2 to length(s) do
if s[i] = letters[j] then
inc(counts[j])
else
begin
inc(j);
letters := letters + s[i];
counts[j] := 1;
end;
end;
end;
procedure decode(var s: string; counts: array of integer; letters: string);
var
i, j: integer;
begin
s := '';
for i := 1 to length(letters) do
for j := 1 to counts[i] do
s := s + letters[i];
end;
var
s: string;
counts: array of integer;
letters: string;
i: integer;
begin
s := 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWW';
writeln(s);
setlength(counts, length(s));
encode(s, counts, letters);
for i := 1 to length(letters) - 1 do
write(counts[i], ' * ', letters[i], ', ');
writeln(counts[length(letters)], ' * ', letters[length(letters)]);
decode(s, counts, letters);
writeln(s);
end.
Output:
:> ./RunLengthEncoding WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWW 12 * W, 1 * B, 12 * W, 3 * B, 24 * W, 1 * B, 13 * W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWW
Perl
Simple version using ASCII numerals as length markers, like the example in the task description (won't work correctly on input strings that already contain digits):
sub encode {
shift =~ s/(.)\1*/length($&).$1/grse;
}
sub decode {
shift =~ s/(\d+)(.)/$2 x $1/grse;
}
Modified version that can take arbitrary byte strings as input (produces encoded byte strings that are compatible with the C solution):
sub encode {
shift =~ s/(.)\1{0,254}/pack("C", length($&)).$1/grse;
}
sub decode {
shift =~ s/(.)(.)/$2 x unpack("C", $1)/grse;
}
Further modified version that supports compact representation of longer non-repeating substrings, just like the C solution (so should be fully compatible with that solution for both encoding and decoding):
sub encode {
my $str = shift;
my $ret = "";
my $nonrep = "";
while ($str =~ m/(.)\1{0,127}|\z/gs) {
my $len = length($&);
if (length($nonrep) && (length($nonrep) == 127 || $len != 1)) {
$ret .= pack("C", 128 + length($nonrep)) . $nonrep;
$nonrep = "";
}
if ($len == 1) { $nonrep .= $1 }
elsif ($len > 1) { $ret .= pack("C", $len) . $1 }
}
return $ret;
}
sub decode {
my $str = shift;
my $ret = "";
for (my $i = 0; $i < length($str);) {
my $len = unpack("C", substr($str, $i, 1));
if ($len <= 128) {
$ret .= substr($str, $i + 1, 1) x $len;
$i += 2;
}
else {
$ret .= substr($str, $i + 1, $len - 128);
$i += 1 + $len - 128;
}
}
return $ret;
}
Demonstration of the third version:
use Data::Dump qw(dd);
dd my $str = "XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA";
dd my $enc = encode($str);
dd decode($enc);
- Output:
"XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA" "\5X\x89ABCDEFGHI\31o\6A" "XXXXXABCDEFGHIoooooooooooooooooooooooooAAAAAA"
Phix
Based on Euphoria, but uses a few string in place of sequence.
with javascript_semantics function encode(string s) sequence r = {} if length(s) then integer ch = s[1], count = 1 for i=2 to length(s) do if s[i]!=ch then r &= {count,ch} ch = s[i] count = 1 else count += 1 end if end for r &= {count,ch} end if return r end function function decode(sequence s) string r = "" for i=1 to length(s) by 2 do r &= repeat(s[i+1],s[i]) end for return r end function sequence s = encode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW") ?s ?decode(s)
- Output:
Note the character hints are desktop/Phix only and don't appear under p2js.
{12,87'W',1,66'B',12,87'W',3,66'B',24,87'W',1,66'B',14,87'W'} "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
PHP
<?php
function encode($str)
{
return preg_replace_callback('/(.)\1*/', function ($match) {
return strlen($match[0]) . $match[1];
}, $str);
}
function decode($str)
{
return preg_replace_callback('/(\d+)(\D)/', function($match) {
return str_repeat($match[2], $match[1]);
}, $str);
}
echo encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'), PHP_EOL;
echo decode('12W1B12W3B24W1B14W'), PHP_EOL;
?>
Picat
While loop
Quite slow.
rle(S) = RLE =>
RLE = "",
Char = S[1],
I = 2,
Count = 1,
while (I <= S.len)
if Char == S[I] then
Count := Count + 1
else
RLE := RLE ++ Count.to_string() ++ Char.to_string(),
Count := 1,
Char := S[I]
end,
I := I + 1
end,
RLE := RLE ++ Count.to_string() ++ Char.to_string().
Using positions of different chars
Much faster than rle/1
.
rle2(S) = RLE =>
Ix = [1] ++ [I : I in 2..S.len, S[I] != S[I-1]] ++ [S.len+1],
Diffs = diff(Ix),
RLE = [Diffs[I].to_string() ++ S[Ix[I]].to_string() : I in 1..Diffs.len].join('').
Recursive approach
The fastest version.
rle3(S) = RLE =>
rle3(S.tail(),S[1],1,[],RLE).
rle3([],LastChar,Count,RLE1,RLE) =>
RLE = (RLE1 ++ [Count.to_string(),LastChar.to_string()]).join('').
rle3([C|T],LastChar,Count,RLE1,RLE) =>
C == LastChar ->
rle3(T,C,Count+1,RLE1,RLE)
;
rle3(T,C,1,RLE1++[Count.to_string()++LastChar.to_string()],RLE).
Test
Encode and decode (only using rle3/1
):
go =>
S = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWWA",
println(S),
RLE = rle3(S),
println(rle=RLE),
D = rl_decode(RLE),
println(D),
if D == S then
println(ok)
else
println(not_ok)
end,
nl.
- Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWWA rle = 12W1B12W3B24W1B14W1A WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWWA ok
Benchmark on larger string
A benchmark on a larger string (30_000) clearly shows that rle3/1 is the fastest.
go2 =>
_ = random2(),
Alpha = "AB",
Len2 = Alpha.len,
_ = random2(),
S = [Alpha[random(1,Len2)] : _ in 1..30_000],
if S.len < 200 then println(s=S) end ,
println("rle/1:"),
time(_=rle(S)),
println("rle2/1:"),
time(_=rle2(S)),
println("rle3/1:"),
time(_=rle3(S)),
nl.
- Output:
rle/1: CPU time 4.02 seconds. rle3/1: CPU time 2.422 seconds. rle3/1: CPU time 0.812 seconds.
PicoLisp
(de encode (Str)
(pack
(make
(for (Lst (chop Str) Lst)
(let (N 1 C)
(while (= (setq C (pop 'Lst)) (car Lst))
(inc 'N) )
(link N C) ) ) ) ) )
(de decode (Str)
(pack
(make
(let N 0
(for C (chop Str)
(if (>= "9" C "0")
(setq N (+ (format C) (* 10 N)))
(do N (link C))
(zero N) ) ) ) ) ) )
(and
(prinl "Data: " "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
(prinl "Encoded: " (encode @))
(prinl "Decoded: " (decode @)) )
Output:
Data: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded: 12W1B12W3B24W1B14W Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
PL/I
declare (c1, c2) character (1);
declare run_length fixed binary;
declare input file;
open file (input) title ('/RLE.DAT,type(text),recsize(20000)');
on endfile (input) go to epilog;
get file (input) edit (c1) (a(1));
run_length = 1;
do forever;
get file (input) edit (c2) (a(1));
if c1 = c2 then
run_length = run_length + 1;
else
do; put edit (trim(run_length), c1) (a); run_length=1; end;
c1 = c2;
end;
epilog:
put edit (trim(run_length), c1) (a);
put skip;
/* The reverse of the above operation: */
declare c character (1);
declare i fixed binary;
declare new file;
open file (new) title ('/NEW.DAT,type(text),recsize(20000)');
on endfile (new) stop;
do forever;
run_length = 0;
do forever;
get file (new) edit (c) (a(1));
if index('0123456789', c) = 0 then leave;
run_length = run_length*10 + c;
end;
put edit ((c do i = 1 to run_length)) (a);
end;
PowerBASIC
This version can handle any arbitrary string that doesn't contain numbers (not just letters). (A flag value could be added which would allow the inclusion of any character, but such a flag isn't in this example.)
FUNCTION RLDecode (i AS STRING) AS STRING
DIM Loop0 AS LONG, rCount AS STRING, outP AS STRING, m AS STRING
FOR Loop0 = 1 TO LEN(i)
m = MID$(i, Loop0, 1)
SELECT CASE m
CASE "0" TO "9"
rCount = rCount & m
CASE ELSE
IF LEN(rCount) THEN
outP = outP & STRING$(VAL(rCount), m)
rCount=""
ELSE
outP = outP & m
END IF
END SELECT
NEXT
FUNCTION = outP
END FUNCTION
FUNCTION RLEncode (i AS STRING) AS STRING
DIM tmp1 AS STRING, tmp2 AS STRING, outP AS STRING
DIM Loop0 AS LONG, rCount AS LONG
tmp1 = MID$(i, 1, 1)
tmp2 = tmp1
rCount = 1
FOR Loop0 = 2 TO LEN(i)
tmp1 = MID$(i, Loop0, 1)
IF tmp1 <> tmp2 THEN
outP = outP & TRIM$(STR$(rCount)) & tmp2
tmp2 = tmp1
rCount = 1
ELSE
INCR rCount
END IF
NEXT
outP = outP & TRIM$(STR$(rCount))
outP = outP & tmp2
FUNCTION = outP
END FUNCTION
FUNCTION PBMAIN () AS LONG
DIM initial AS STRING, encoded AS STRING, decoded AS STRING
initial = INPUTBOX$("Type something.")
encoded = RLEncode(initial)
decoded = RLDecode(encoded)
'in PB/Win, "?" = MSGBOX; in PB/DOS & PB/CC. "?" = PRINT
? initial & $CRLF & encoded & $CRLF & decoded
END FUNCTION
Outputs are similar to those in BASIC, above.
PowerShell
function Compress-RLE ($s) {
$re = [regex] '(.)\1*'
$ret = ""
foreach ($m in $re.Matches($s)) {
$ret += $m.Length
$ret += $m.Value[0]
}
return $ret
}
function Expand-RLE ($s) {
$re = [regex] '(\d+)(.)'
$ret = ""
foreach ($m in $re.Matches($s)) {
$ret += [string] $m.Groups[2] * [int] [string] $m.Groups[1]
}
return $ret
}
Output:
PS> Compress-RLE "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" 12W1B12W3B24W1B14W PS> Expand-RLE "12W1B12W3B24W1B14W" WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Prolog
Works with SWI-Prolog.
This code is inspired from a code found here : http://groups.google.com/group/comp.lang.prolog/browse_thread/thread/b053ea2512e8b350 (author : Pascal J. Bourguignon).
% the test
run_length :-
L = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
writef('encode %s\n', [L]),
encode(L, R),
writeln(R), nl,
writef('decode %w\n', [R]),
decode(R, L1),
writeln(L1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% encode
%
% translation
% from
% "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
% to
% "12W1B12W3B24W1B14W"
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
encode(In, Out) :-
% Because of the special management of the "strings" by Prolog
( is_list(In) -> I = In; string_to_list(In, I)),
packList(I, R1),
dcg_packList2List(R1,R2, []),
string_to_list(Out,R2).
dcg_packList2List([[N, V]|T]) -->
{ number_codes(N, LN)},
LN,
[V],
dcg_packList2List(T).
dcg_packList2List([]) --> [].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% decode
%
% translation
% from
% "12W1B12W3B24W1B14W"
% to
% "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
decode(In, Out) :-
% Because of the special management of the "strings" by Prolog
( is_list(In) -> I = In; string_to_list(In, I)),
dcg_List2packList(I, R1, []),
packList(L1, R1),
string_to_list(Out, L1).
dcg_List2packList([H|T]) -->
{code_type(H, digit)},
parse_number([H|T], 0).
dcg_List2packList([]) --> [].
parse_number([H|T], N) -->
{code_type(H, digit), !,
N1 is N*10 + H - 48 },
parse_number(T, N1).
parse_number([H|T], N) -->
[[N, H]],
dcg_List2packList(T).
% use of library clpfd allows packList(?In, ?Out) to works
% in both ways In --> Out and In <-- Out.
:- use_module(library(clpfd)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% ?- packList([a,a,a,b,c,c,c,d,d,e], L).
% L = [[3,a],[1,b],[3,c],[2,d],[1,e]] .
% ?- packList(R, [[3,a],[1,b],[3,c],[2,d],[1,e]]).
% R = [a,a,a,b,c,c,c,d,d,e] .
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
packList([],[]).
packList([X],[[1,X]]) :- !.
packList([X|Rest],[XRun|Packed]):-
run(X,Rest, XRun,RRest),
packList(RRest,Packed).
run(Var,[],[1,Var],[]).
run(Var,[Var|LRest],[N1, Var],RRest):-
N #> 0,
N1 #= N + 1,
run(Var,LRest,[N, Var],RRest).
run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
dif(Var,Other).
Output :
?- run_length. encode WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W1B12W3B24W1B14W decode 12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW true .
Pure
using system;
encode s = strcat $ map (sprintf "%d%s") $ encode $ chars s with
encode [] = [];
encode xs@(x:_) = (#takewhile (==x) xs,x) : encode (dropwhile (==x) xs);
end;
decode s = strcat [c | n,c = parse s; i = 1..n] with
parse s::string = regexg item "([0-9]+)(.)" REG_EXTENDED s 0;
item info = val (reg 1 info!1), reg 2 info!1;
end;
let s = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
let r = encode s; // "12W1B12W3B24W1B14W"
decode r;
PureBasic
with some optimations to use pointers instead of string functions. According to the task description it works with uppercase A - Z. In this implementation it also functions with all characters that are non-digits and whose value is non-zero.
Procedure.s RLDecode(toDecode.s)
Protected.s repCount, output, currChar, tmp
Protected *c.Character = @toDecode
While *c\c <> #Null
currChar = Chr(*c\c)
Select *c\c
Case '0' To '9'
repCount + currChar
Default
If repCount
tmp = Space(Val(repCount))
ReplaceString(tmp, " ", currChar, #PB_String_InPlace)
output + tmp
repCount = ""
Else
output + currChar
EndIf
EndSelect
*c + SizeOf(Character)
Wend
ProcedureReturn output
EndProcedure
Procedure.s RLEncode(toEncode.s)
Protected.s currChar, prevChar, output
Protected repCount
Protected *c.Character = @toEncode
prevChar = Chr(*c\c)
repCount = 1
*c + SizeOf(Character)
While *c\c <> #Null
currChar = Chr(*c\c)
If currChar <> prevChar
output + Str(repCount) + prevChar
prevChar = currChar
repCount = 1
Else
repCount + 1
EndIf
*c + SizeOf(Character)
Wend
output + Str(repCount)
output + prevChar
ProcedureReturn output
EndProcedure
If OpenConsole()
Define initial.s, encoded.s, decoded.s
Print("Type something: ")
initial = Input()
encoded = RLEncode(initial)
decoded = RLDecode(encoded)
PrintN(initial)
PrintN(RLEncode(initial))
PrintN(RLDecode(encoded))
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
Input()
CloseConsole()
EndIf
Sample output:
Type something: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWW WWW WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Python
def encode(input_string):
count = 1
prev = None
lst = []
for character in input_string:
if character != prev:
if prev:
entry = (prev, count)
lst.append(entry)
count = 1
prev = character
else:
count += 1
else:
try:
entry = (character, count)
lst.append(entry)
return (lst, 0)
except Exception as e:
print("Exception encountered {e}".format(e=e))
return (e, 1)
def decode(lst):
q = []
for character, count in lst:
q.append(character * count)
return ''.join(q)
#Method call
value = encode("aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa")
if value[1] == 0:
print("Encoded value is {}".format(value[0]))
decode(value[0])
Functional
from itertools import groupby
def encode(input_string):
return [(len(list(g)), k) for k,g in groupby(input_string)]
def decode(lst):
return ''.join(c * n for n,c in lst)
encode("aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa")
decode([(5, 'a'), (6, 'h'), (7, 'm'), (1, 'u'), (7, 'i'), (6, 'a')])
By regular expression
The simplified input range of only uppercase characters allows a simple regular expression to be applied repeatedly for encoding, and another for decoding:
from re import sub
def encode(text):
'''
Doctest:
>>> encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW')
'12W1B12W3B24W1B14W'
'''
return sub(r'(.)\1*', lambda m: str(len(m.group(0))) + m.group(1),
text)
def decode(text):
'''
Doctest:
>>> decode('12W1B12W3B24W1B14W')
'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
'''
return sub(r'(\d+)(\D)', lambda m: m.group(2) * int(m.group(1)),
text)
textin = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
assert decode(encode(textin)) == textin
Quackery
lookandsay
is defined at Look-and-say sequence#Quackery.
[ lookandsay ] is encode ( $ --> $ )
[ $ "" 0 rot
witheach
[ dup
char 0 char 9 1+
within iff
[ char 0 -
swap 10 * + ]
else
[ swap of join
0 ] ]
drop ] is decode ( $ --> $ )
$ "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
dup echo$ cr
encode
dup echo$ cr
decode
echo$ cr
- Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
R
R has a built-in function, rle, for run length encoding. This modification allows input and output in the forms specified above.
runlengthencoding <- function(x)
{
splitx <- unlist(strsplit(input, ""))
rlex <- rle(splitx)
paste(with(rlex, as.vector(rbind(lengths, values))), collapse="")
}
input <- "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
runlengthencoding(input)
Similarly, inverse.rle provides decompression after a run length encoding.
inverserunlengthencoding <- function(x)
{
lengths <- as.numeric(unlist(strsplit(output, "[[:alpha:]]")))
values <- unlist(strsplit(output, "[[:digit:]]"))
values <- values[values != ""]
uncompressed <- inverse.rle(list(lengths=lengths, values=values))
paste(uncompressed, collapse="")
}
output <- "12W1B12W3B24W1B14W"
inverserunlengthencoding(output)
Racket
#lang racket
(define (encode str)
(regexp-replace* #px"(.)\\1*" str (λ (m c) (~a (string-length m) c))))
(define (decode str)
(regexp-replace* #px"([0-9]+)(.)" str (λ (m n c) (make-string (string->number n) (string-ref c 0)))))
Raku
(formerly Perl 6) Note that Raku regexes don't care about unquoted whitespace, and that backrefs count from 0, not from 1.
sub encode($str) { $str.subst(/(.) $0*/, { $/.chars ~ $0 }, :g) }
sub decode($str) { $str.subst(/(\d+) (.)/, { $1 x $0 }, :g) }
my $e = encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW');
say $e;
say decode($e);
Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
REXX
version 1
The task (input) rule was relaxed a bit as this program accepts upper─ and lowercase input.
An error message is generated if the input text is invalid.
In addition, a yay or nay message is also displayed if the decoding of the encoding was successful.
Note that this REXX version (for encoding and decoding) uses a replication count, not the count of characters,
so a replication count of 11 represents a count of 12 characters.
/*REXX program encodes and displays a string by using a run─length encoding scheme. */
parse arg input . /*normally, input would be in a file. */
default= 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
if input=='' | input=="," then input= default /*Not specified? Then use the default.*/
encode= RLE(input) ; say ' input=' input /*encode input string; display input. */
say 'encoded=' encode /* display run─len*/
decode= RLD(encode); say 'decoded=' decode /*decode the run─len; display decode.*/
if decode==input then say 'OK'; else say "¬ OK" /*display yay or nay (success/failure).*/
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
err: say; say "***error*** input data isn't alphabetic:" c; say; exit 13
/*──────────────────────────────────────────────────────────────────────────────────────*/
RLE: procedure; parse arg x; $= /*$: is the output string (so far). */
Lx= length(x) /*get length of the plain text string. */
do j=1 by 0 to Lx; c= substr(x, j, 1) /*obtain a character from plain text. */
if \datatype(c, 'M') then call err /*Character not a letter? Issue error.*/
r= 0 /*R: is NOT the number of characters. */
do k=j+1 to Lx while substr(x, k, 1)==c /*while characters ≡ C */
r= r + 1 /*bump the replication count for a char*/
end /*k*/
j= j + r + 1 /*increment (add to) the DO loop index.*/
if r==0 then $= $ || c /*don't use R if it is equal to zero.*/
else $= $ || r || c /*add character to the encoded string. */
end /*j*/; return $ /*return the encoded string to caller. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
RLD: procedure; parse arg x; $= /*$: is the output string (so far). */
Lx= length(x) /*get the length of the encoded string.*/
do j=1 by 0 to Lx; c= substr(x, j, 1) /*obtain a character from run encoding.*/
if \datatype(c, 'W') then do; $= $ || c; j= j + 1; iterate /*j*/
end /* [↑] a loner char, add it to output.*/
#= 1 /* [↓] W: use a Whole number*/
do k=j+1 to Lx while datatype(substr(x,k,1), 'w') /*while numeric*/
#= # + 1 /*bump the count of the numeric chars. */
end /*k*/
n= substr(x, j, #) + 1 /*#: the length of encoded character. */
$= $ || copies( substr(x, k, 1), n) /*N: is now the number of characters. */
j= j + # + 1 /*increment the DO loop index by D+1. */
end /*j*/; return $ /*return the decoded string to caller. */
- output when using the default input:
input= WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded= 11WB11W2B23WB13W decoded= WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
version 2
/*REXX*/
s='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
Say ' s='s
enc=encode(s)
Say 'enc='enc
dec=decode(enc)
Say 'dec='dec
if dec==s Then Say 'OK'
Exit
encode: Procedure
Parse Arg s
c=left(s,1)
cnt=1
ol=''
Do i=2 To length(s)
If substr(s,i,1)=c Then
cnt=cnt+1
Else Do
Call o cnt||c
c=substr(s,i,1)
cnt=1
End
End
Call o cnt||c
Return ol
decode: Procedure
Parse Arg s
abc='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
ol=''
Do While s<>''
p=verify(s,abc,'M')
Parse Var s cnt =(p) c +1 s
Call o copies(c,cnt)
End
Return ol
o: ol=ol||arg(1)
Return
- Output:
s=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW enc=12W1B12W3B24W1B14W dec=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW OK
version 3
No need to output counts that are 1
/*REXX*/
s='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
Say ' s='s
enc=encode(s)
Say 'enc='enc
dec=decode(enc)
Say 'dec='dec
if dec==s Then Say 'OK'
Exit
encode: Procedure
Parse Arg s
c=left(s,1)
cnt=1
ol=''
Do i=2 To length(s)
If substr(s,i,1)=c Then
cnt=cnt+1
Else Do
If cnt=1 Then
Call o c
Else
Call o cnt||c
c=substr(s,i,1)
cnt=1
End
End
Call o cnt||c
Return ol
decode: Procedure
Parse Arg s
abc='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
ol=''
Do While s<>''
p=verify(s,abc,'M')
If pos(left(s,1),abc)>0 Then Do
Parse Var s c +1 s
Call o c
End
Else Do
Parse Var s cnt =(p) c +1 s
Call o copies(c,cnt)
End
End
Return ol
o: ol=ol||arg(1)
Return
- Output:
s=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW enc=12WB12W3B24WB14W dec=WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW OK
Ring
# Project : Run-length encoding
load "stdlib.ring"
test = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
num = 0
nr = 0
decode = newlist(7,2)
for n = 1 to len(test) - 1
if test[n] = test[n+1]
num = num + 1
else
nr = nr + 1
decode[nr][1] = (num + 1)
decode[nr][2] = test[n]
see "" + (num + 1) + test[n]
num = 0
ok
next
see "" + (num + 1) + test[n]
see nl
nr = nr + 1
decode[nr][1] = (num + 1)
decode[nr][2] = test[n]
for n = 1 to len(decode)
dec = copy(decode[n][2], decode[n][1])
see dec
next
Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
RPL
≪ DUP 1 DUP SUB → in c ≪ "" 1 2 in SIZE FOR j in j DUP SUB IF DUP c == THEN DROP 1 + ELSE ROT ROT →STR + c + SWAP 'c' STO 1 END NEXT →STR + c + ≫ ≫ ‘RLENC’ STO ≪ → in ≪ "" 0 1 in SIZE FOR j in j DUP SUB IF DUP "A" ≥ THEN ROT 1 4 ROLL START OVER + NEXT SWAP DROP 0 ELSE STR→ SWAP 10 * + END NEXT DROP ≫ ≫ ‘RLDEC’ STO
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" RLENC DUP RLDEC
- Output:
2: "12W1B12W3B24W1B14W" 1: "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
Ruby
Built-in
Ruby has built-in run-length encoding in the form of chunk
, here I provide a thin wrapper around it:
# run_encode("aaabbbbc") #=> [["a", 3], ["b", 4], ["c", 1]]
def run_encode(string)
string
.chars
.chunk{|i| i}
.map {|kind, array| [kind, array.length]}
end
# run_decode([["a", 3], ["b", 4], ["c", 1]]) #=> "aaabbbbc"
def run_decode(char_counts)
char_counts
.map{|char, count| char * count}
.join
end
def encode(string)
string.scan(/(.)(\1*)/).collect do |char, repeat|
[1 + repeat.length, char]
end.join
end
def decode(string)
string.scan(/(\d+)(\D)/).collect {|length, char| char * length.to_i}.join
end
This usage also seems to be idiomatic, and perhaps less cryptic:
def encode(string)
string.scan(/(.)(\1*)/).inject("") do |encoding, (char, repeat)|
encoding << (1 + repeat.length).to_s << char
end
end
def decode(string)
string.scan(/(\d+)(\D)/).inject("") do |decoding, (length, char)|
decoding << char * length.to_i
end
end
By regular expression
The simplified input range of only uppercase characters allows a simple regular expression to be applied repeatedly for encoding, and another for decoding:
def encode(str)
str.gsub(/(.)\1*/) {$&.length.to_s + $1}
end
def decode(str)
str.gsub(/(\d+)(\D)/) {$2 * $1.to_i}
end
Test:
orig = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
p enc = encode(orig)
p dec = decode(enc)
puts "success!" if dec == orig
- Output:
"12W1B12W3B24W1B14W" "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" success!
Run BASIC
string$ = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
beg = 1
i = 1
[loop]
s$ = mid$(string$,beg,1)
while mid$(string$,i,1) = s$
i = i + 1
wend
press$ = press$ ; i-beg;s$
beg = i
if i < len(string$) then goto [loop]
print "Compressed:";press$
beg = 1
i = 1
[expand]
while mid$(press$,i,1) <= "9"
i = i + 1
wend
for j = 1 to val(mid$(press$,beg, i - beg))
expand$ = expand$ + mid$(press$,i,1)
next j
i = i + 1
beg = i
if i < len(press$) then goto [expand]
print " Expanded:";expand$
Output:
Compressed:12W1B12W3B24W1B14W Expanded:WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Rust
fn encode(s: &str) -> String {
s.chars()
// wrap all values in Option::Some
.map(Some)
// add an Option::None onto the iterator to clean the pipeline at the end
.chain(std::iter::once(None))
.scan((0usize, '\0'), |(n, c), elem| match elem {
Some(elem) if *n == 0 || *c == elem => {
// the run continues or starts here
*n += 1;
*c = elem;
// this will not have an effect on the final string because it is empty
Some(String::new())
}
Some(elem) => {
// the run ends here
let run = format!("{}{}", n, c);
*n = 1;
*c = elem;
Some(run)
}
None => {
// the string ends here
Some(format!("{}{}", n, c))
}
})
// concatenate together all subresults
.collect()
}
fn decode(s: &str) -> String {
s.chars()
.fold((0usize, String::new()), |(n, text), c| {
if c.is_ascii_digit() {
// some simple number parsing
(
n * 10 + c.to_digit(10).expect("invalid encoding") as usize,
text,
)
} else {
// this must be the character that is repeated
(0, text + &format!("{}", c.to_string().repeat(n)))
}
})
.1
}
fn main() {
let text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
let encoded = encode(text);
let decoded = decode(&encoded);
println!("original: {}\n encoded: {}\n decoded: {}", text, encoded, decoded);
assert_eq!(text, decoded);
}
- Output:
original: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW encoded: 12W1B12W3B24W1B14W decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Scala
Care is taken to use StringBuilder for performance reasons.
def encode(s: String) = (1 until s.size).foldLeft((1, s(0), new StringBuilder)) {
case ((len, c, sb), index) if c != s(index) => sb.append(len); sb.append(c); (1, s(index), sb)
case ((len, c, sb), _) => (len + 1, c, sb)
} match {
case (len, c, sb) => sb.append(len); sb.append(c); sb.toString
}
def decode(s: String) = {
val sb = new StringBuilder
val Code = """(\d+)([A-Z])""".r
for (Code(len, c) <- Code findAllIn s) sb.append(c * len.toInt)
sb.toString
}
A simpler (?) encoder:
def encode(s:String) = {
s.foldLeft((0,s(0),""))( (t,c) => t match {case (i,p,s) => if (p==c) (i+1,p,s) else (1,c,s+i+p)})
match {case (i,p,s) => s+i+p}
}
To make it faster (it's also faster than the longer implementation above) just replace "" with new StringBuilder and s+i+p with {s.append(i);s.append(p)}
A simpler (?) decoder (that can handle a string like "2AB", producing "AAB"):
def decode(s: String, Code: scala.util.matching.Regex = """(\d+)?([a-zA-Z])""".r) =
Code.findAllIn(s).foldLeft("") { case (acc, Code(len, c)) =>
acc + c * Option(len).map(_.toInt).getOrElse(1)
}
Scheme
(define (run-length-decode v)
(apply string-append (map (lambda (p) (make-string (car p) (cdr p))) v)))
(define (run-length-encode s)
(let ((n (string-length s)))
(let loop ((i (- n 2)) (c (string-ref s (- n 1))) (k 1) (v '()))
(if (negative? i) (cons (cons k c) v)
(let ((x (string-ref s i)))
(if (char=? c x) (loop (- i 1) c (+ k 1) v)
(loop (- i 1) x 1 (cons (cons k c) v))))))))
(run-length-encode "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
; ((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W))
(run-length-decode '((12 . #\W) (1 . #\B) (12 . #\W) (3 . #\B) (24 . #\W) (1 . #\B) (14 . #\W)))
; "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
sed
The encode script:
/^$/ b
:start
/^[0-9]/ b
s/^/1/
:loop
h
/^9+([^0-9])\1+/ {
s/^(9+).*/0\1/
y/09/10/
G
s/^(.+)\n[0-9]+.(.*)/\1\2/
b loop }
/^[0-9]*[0-8]([^0-9])\1+/ {
s/^[0-9]*([0-8]).*/\1/
y/012345678/123456789/
G
s/^(.)\n([0-9]*)[0-8].(.*)/\2\1\3/
b loop }
/^[0-9]+9+([^0-9])\1+/ {
s/^[0-9]*([0-8]9+).*/\1/
y/0123456789/1234567890/
G
s/^(.+)\n([0-9]*)[0-8]9+.(.*)/\2\1\3/
b loop }
s/^([0-9]+.)(.*)/\2\1/
b start
The decode script:
/^$/ b
:start
/^[^0-9]/ b
:loop
/^1[^0-9]/ {
s/^1(.)(\1*)(.*)/\3\1\2/
b start }
h
/^[0-9]*[1-9][^0-9]/ {
s/^[0-9]*([1-9]).*/\1/
y/123456789/012345678/
G
s/^([0-8])\n([0-9]*)[1-9]([^0-9])(.*)/\2\1\3\3\4/
b loop }
/^[0-9]+0[^0-9]/ {
s/^[0-9]*([1-9]0+)[^0-9].*/\1/
y/0123456789/9012345678/
G
s/^([0-9]+)\n([0-9]*)[1-9]0+([^0-9])(.*)/\2\1\3\3\4/
s/^0+//
b loop }
Example (assuming the scripts reside in the files encode.sed
and decode.sed
):
sed -rf encode.sed <<< "foo oops"
# 1f2o1 2o1p1s
sed -rf decode.sed <<< "1f2o1 2o1p1s"
# foo oops
(sed -rf decode.sed | sed -rf encode.sed) <<< 1000.
# 1000.
Seed7
$ include "seed7_05.s7i";
include "scanstri.s7i";
const func string: letterRleEncode (in string: data) is func
result
var string: result is "";
local
var char: code is ' ';
var integer: index is 1;
begin
if length(data) <> 0 then
code := data[1];
repeat
incr(index);
until index > length(data) or code <> data[index];
result := str(pred(index)) & str(code) & letterRleEncode(data[index ..]);
end if;
end func;
const func string: letterRleDecode (in var string: data) is func
result
var string: result is "";
local
var integer: count is 0;
begin
if length(data) <> 0 then
count := integer parse getDigits(data);
result := data[1 len 1] mult count & letterRleDecode(data[2 ..]);
end if;
end func;
const proc: main is func
begin
writeln(letterRleEncode("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"));
writeln(letterRleDecode("12W1B12W3B24W1B14W"));
end func;
SETL
program rle;
test := "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
print("Input:");
print(test);
print("Encoded:");
print(enc := rlencode(test));
print("Decoded:");
print(rldecode(enc));
proc rlencode(s);
loop while s /= "" do
part := span(s, s(1));
r +:= str #part + part(1);
end loop;
return r;
end proc;
proc rldecode(s);
loop while s /= "" do
num := span(s, "0123456789");
item := notany(s, "");
r +:= val num * item;
end loop;
return r;
end proc;
end program;
- Output:
Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded: 12W1B12W3B24W1B14W Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Sidef
First solution:
func encode(str) {
str.gsub(/((.)(\2*))/, {|a,b| "#{a.len}#{b}" });
}
func decode(str) {
str.gsub(/(\d+)(.)/, {|a,b| b * a.to_i });
}
- Output:
12W1B12W3B24W1B14W
Second solution, encoding the length into a byte:
func encode(str) {
str.gsub(/(.)(\1{0,254})/, {|a,b| b.len+1 -> chr + a});
}
func decode(str) {
var chars = str.chars;
var r = '';
(chars.len/2 -> int).range.each { |i|
r += (chars[2*i + 1] * chars[2*i].ord);
}
return r;
}
- Output:
"\fW\1B\fW\3B\30W\1B\16W"
Smalltalk
See Run-length encoding/Smalltalk
A "functional" version without RunArray:
(and others)
|compress decompress|
compress := [:string |
String streamContents:[:out |
|count prev|
count := 0.
(string,'*') "trick to avoid final run handling in loop"
inject:nil
into:[:prevChar :ch |
ch ~= prevChar ifTrue:[
count = 0 ifFalse:[
count printOn:out.
out nextPut:prevChar.
count := 0.
].
].
count := count + 1.
ch
]
]
].
decompress := [:string |
String streamContents:[:out |
string readingStreamDo:[:in |
[in atEnd] whileFalse:[
|n ch|
n := Integer readFrom:in.
ch := in next.
out next:n put:ch.
]
]
].
].
compress value:'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
-> '12W1B12W3B24W1B14W'
decompress value:'12W1B12W3B24W1B14W'
-> 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
Most Smalltalk dialects include a class named "RunArray", which can be used as:
compress := [:string |
String streamContents:[:out |
string asRunArray runsDo:[:count :char |
count printOn:out. out nextPut:char]]].
SNOBOL4
* # Encode RLE
define('rle(str)c,n') :(rle_end)
rle str len(1) . c :f(return)
str span(c) @n =
rle = rle n c :(rle)
rle_end
* # Decode RLE
define('elr(str)c,n') :(elr_end)
elr str span('0123456789') . n len(1) . c = :f(return)
elr = elr dupl(c,n) :(elr)
elr_end
* # Test and display
str = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
output = str;
str = rle(str); output = str
str = elr(str); output = str
end
Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
SparForte
As a structured script.
#!/usr/local/bin/spar
pragma is
annotate( summary, "rle" );
annotate( description, "Given a string containing uppercase characters (A-Z)," );
annotate( description, "compress repeated 'runs' of the same character by" );
annotate( description, "storing the length of that run, and provide a function to" );
annotate( description, "reverse the compression. The output can be anything, as" );
annotate( description, "long as you can recreate the input with it." );
annotate( description, "" );
annotate( description, "Example:" );
annotate( description, "Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" );
annotate( description, "Output: 12W1B12W3B24W1B14W" );
annotate( see_also, "http://rosettacode.org/wiki/Run-length_encoding" );
annotate( author, "Ken O. Burtch" );
license( unrestricted );
restriction( no_external_commands );
end pragma;
procedure rle is
function to_rle( s : string ) return string is
begin
if strings.length( s ) = 0 then
return "";
end if;
declare
result : string;
code : character;
prefix : string;
first : natural := 1;
index : natural := 1;
begin
while index <= strings.length( s ) loop
first := index;
index := @+1;
code := strings.element( s, positive(first) );
while index <= strings.length( s ) loop
exit when code /= strings.element( s, positive(index) );
index := @+1;
exit when index-first = 99;
end loop;
prefix := strings.trim( strings.image( index - first ), trim_end.left );
result := @ & prefix & code;
end loop;
return result;
end;
end to_rle;
function from_rle( s : string ) return string is
begin
if strings.length( s ) = 0 then
return "";
end if;
declare
result : string;
index : positive := 1;
prefix : string;
code : character;
begin
loop
prefix := "" & strings.element( s, index );
index := @+1;
if strings.is_digit( strings.element( s, index ) ) then
prefix := @ & strings.element( s, index );
index := @+1;
end if;
code := strings.element( s, index );
index := @+1;
result := @ & ( numerics.value( prefix ) * code );
exit when natural(index) > strings.length( s );
end loop;
return result;
end;
end from_rle;
begin
? to_rle( "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" );
? from_rle( "12W1B12W3B24W1B14W");
end rle;
SQL
- RLE encoding
-- variable table
drop table if exists var;
create temp table var ( value varchar(1000) );
insert into var(value) select 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW';
-- select
with recursive
ints(num) as
(
select 1
union all
select num+1
from ints
where num+1 <= length((select value from var))
)
,
chars(num,chr,nextChr,isGroupEnd) as
(
select tmp.*, case when tmp.nextChr <> tmp.chr then 1 else 0 end groupEnds
from (
select num,
substring((select value from var), num, 1) chr,
(select substring((select value from var), num+1, 1)) nextChr
from ints
) tmp
)
select (select value from var) plain_text, (
select string_agg(concat(cast(maxNoWithinGroup as varchar(10)) , chr), '' order by num)
from (
select *, max(noWithinGroup) over (partition by chr, groupNo) maxNoWithinGroup
from (
select num,
chr,
groupNo,
row_number() over( partition by chr, groupNo order by num) noWithinGroup
from (
select *, (select count(*)
from chars chars2
where chars2.isGroupEnd = 1 and
chars2.chr = chars.chr and
chars2.num < chars.num) groupNo
from chars
) tmp
) sub
) final
where noWithinGroup = 1
) Rle_Compressed
- RLE decoding
-- variable table
DROP TABLE IF EXISTS var;
CREATE temp TABLE var ( VALUE VARCHAR(1000) );
INSERT INTO var(VALUE) SELECT '1A2B3C4D5E6F';
-- select
WITH recursive
ints(num) AS
(
SELECT 1
UNION ALL
SELECT num+1
FROM ints
WHERE num+1 <= LENGTH((SELECT VALUE FROM var))
)
,
chars(num,chr,nextChr) AS
(
SELECT tmp.*
FROM (
SELECT num,
SUBSTRING((SELECT VALUE FROM var), num, 1) chr,
(SELECT SUBSTRING((SELECT VALUE FROM var), num+1, 1)) nextChr
FROM ints
) tmp
)
,
charsWithGroup(num,chr,nextChr,group_no) AS
(
SELECT *,(SELECT COUNT(*)
FROM chars chars2
WHERE chars2.chr !~ '[0-9]' AND
chars2.num < chars.num) group_No
FROM chars
)
,
charsWithGroupAndLetter(num,chr,nextChr,group_no,group_letter) AS
(
SELECT *,(SELECT chr
FROM charsWithGroup g2
where g2.group_no = charsWithGroup.group_no
ORDER BY num DESC
LIMIT 1)
FROM charsWithGroup
)
,
lettersWithCount(group_no,amount,group_letter) AS
(
SELECT group_no, string_agg(chr, '' ORDER BY num), group_letter
FROM charsWithGroupAndLetter
WHERE chr ~ '[0-9]'
GROUP BY group_no, group_letter
)
,
lettersReplicated(group_no,amount,group_letter, replicated_Letter) AS
(
SELECT *, rpad(group_letter, cast(amount as int), group_letter)
FROM lettersWithCount
)
select (SELECT value FROM var) rle_encoded,
string_agg(replicated_Letter, '' ORDER BY group_no) decoded_string
FROM lettersReplicated
Standard ML
fun encode str =
let
fun aux (sub, acc) =
case Substring.getc sub
of NONE => rev acc
| SOME (x, sub') =>
let
val (y, z) = Substring.splitl (fn c => c = x) sub'
in
aux (z, (x, Substring.size y + 1) :: acc)
end
in
aux (Substring.full str, [])
end
fun decode lst =
concat (map (fn (c,n) => implode (List.tabulate (n, fn _ => c))) lst)
Example:
- encode "aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa"; val it = [(#"a",5),(#"h",6),(#"m",7),(#"u",1),(#"i",7),(#"a",6)] : (char * int) list - decode [(#"a",5),(#"h",6),(#"m",7),(#"u",1),(#"i",7),(#"a",6)]; val it = "aaaaahhhhhhmmmmmmmuiiiiiiiaaaaaa" : string
Swift
Using array as the internal representation of the encoded input:
import Foundation
// "WWWBWW" -> [(3, W), (1, B), (2, W)]
func encode(input: String) -> [(Int, Character)] {
return input.characters.reduce([(Int, Character)]()) {
if $0.last?.1 == $1 { var r = $0; r[r.count - 1].0++; return r }
return $0 + [(1, $1)]
}
}
// [(3, W), (1, B), (2, W)] -> "WWWBWW"
func decode(encoded: [(Int, Character)]) -> String {
return encoded.reduce("") { $0 + String(count: $1.0, repeatedValue: $1.1) }
}
Usage:
let input = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
let output = decode(encode(input))
print(output == input)
- Output:
true
Converting encoded array into the string and then decoding it using NSScanner:
// "3W1B2W" -> "WWWBWW"
func decode(encoded: String) -> String {
let scanner = NSScanner(string: encoded)
var char: NSString? = nil
var count: Int = 0
var out = ""
while scanner.scanInteger(&count) {
while scanner.scanCharactersFromSet(NSCharacterSet.letterCharacterSet(), intoString: &char) {
out += String(count: count, repeatedValue: Character(char as! String))
}
}
return out
}
let encodedString = encode(input).reduce("") { $0 + "\($1.0)\($1.1)" }
print(encodedString)
let outputString = decode(encodedString)
print(outputString == input)
- Output:
12W1B12W3B24W1B14W true
Tcl
The encoding is an even-length list with elements {count char ...}
proc encode {string} {
set encoding {}
# use a regular expression to match runs of one character
foreach {run -} [regexp -all -inline {(.)\1+|.} $string] {
lappend encoding [string length $run] [string index $run 0]
}
return $encoding
}
proc decode {encoding} {
foreach {count char} $encoding {
append decoded [string repeat $char $count]
}
return $decoded
}
set str "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
set enc [encode $str] ;# ==> {12 W 1 B 12 W 3 B 24 W 1 B 14 W}
set dec [decode $enc]
if {$str eq $dec} {
puts "success"
}
TMG
Unix TMG is designed to process and generate files rather than process text in memory. Therefore encoding and decoding parts can be done in separate programs.
Encoding:
loop: ordcop [lch?]\loop;
ordcop: ord/copy;
ord: char(ch)/last [ch!=lch?]\new [cnt++] fail;
new: ( [lch?] parse(out) | () ) [lch=ch] [cnt=1] fail;
out: decimal(cnt) scopy = { 2 1 };
last: parse(out) [lch=0];
copy: smark any(!<<>>);
ch: 0;
lch: 0;
cnt: 0;
Decoding:
loop: readint(n) copy\loop;
copy: smark any(!<<>>)
repeat: [n?] parse(( scopy )) [--n>0?]\repeat;
/* Reads decimal integer */
readint: proc(n;i) ignore(<<>>) [n=0] inta
int1: [n = n*12+i] inta\int1;
inta: char(i) [i<72?] [(i =- 60)>=0?];
i: 0;
n: 0;
TSE SAL
STRING PROC FNStringGetDecodeStringCharacterEqualCountS( STRING inS )
STRING s1[255] = ""
STRING s2[255] = ""
STRING s3[255] = ""
STRING s4[255] = ""
INTEGER I = 0
INTEGER J = 0
INTEGER K = 0
INTEGER L = 0
K = Length( inS )
I = 1 - 1
REPEAT
J = 1 - 1
s3 = ""
REPEAT
I = I + 1
J = J + 1
s1 = SubStr( inS, I, 1 )
s3 = s3 + s1
s4 = SubStr( inS, I + 1, 1 )
UNTIL ( NOT ( s4 IN '0'..'9' ) )
FOR L = 1 TO Val( s3 )
s2 = s2 + s4
ENDFOR
I = I + 1
UNTIL ( I >= ( K - 1 ) )
RETURN( s2 )
END
//
STRING PROC FNStringGetEncodeStringCharacterEqualCountS( STRING inS )
STRING s1[255] = ""
STRING s2[255] = ""
INTEGER I = 0
INTEGER J = 0
INTEGER K = 0
K = Length( inS )
I = 1 - 1
REPEAT
J = 1 - 1
REPEAT
I = I + 1
J = J + 1
s1 = SubStr( inS, I, 1 )
UNTIL ( NOT ( SubStr( inS, I + 1, 1 ) == s1 ) )
s2 = s2 + Str( J ) + s1
UNTIL ( I >= ( K - 1 ) )
RETURN( s2 )
END
//
STRING PROC FNStringGetEncodeDecodeStringCharacterEqualCountS( STRING inS )
STRING s1[255] = FNStringGetEncodeStringCharacterEqualCountS( inS )
STRING s2[255] = FNStringGetDecodeStringCharacterEqualCountS( s1 )
RETURN( s2 )
END
//
PROC Main()
STRING s1[255] = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
STRING s2[255] = ""
IF ( NOT ( Ask( "string: get: encode: decode: string: character: equal: count: inS = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
s2 = FNStringGetEncodeDecodeStringCharacterEqualCountS( s1 )
Warn( "equal strings if result is 1", ",", " ", "and the result is", ":", " ", s1 == s2 )
END
TUSCRIPT
$$ MODE TUSCRIPT,{}
input="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",output=""
string=strings(input," ? ")
letter=ACCUMULATE(string,freq)
freq=SPLIT(freq),letter=SPLIT(letter)
output=JOIN(freq,"",letter)
output=JOIN(output,"")
PRINT input
PRINT output
Output:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW 12W1B12W3B24W1B14W
UNIX Shell
encode() {
local phrase=$1
[[ -z $phrase ]] && return
local result="" count=0 char=${phrase:0:1}
for ((i = 0; i < ${#phrase}; i++)); do
if [[ ${phrase:i:1} == "$char" ]]; then
((count++))
else
result+="$(encode_sequence "$count" "$char")"
char=${phrase:i:1}
count=1
fi
done
result+="$(encode_sequence "$count" "$char")"
echo "$result"
}
encode_sequence() {
local count=$1 char=$2
((count == 1)) && count=""
echo "${count}${char}"
}
decode() {
local phrase=$1
local result=""
local count char
while [[ $phrase =~ ([[:digit:]]+)([^[:digit:]]) ]]; do
printf -v phrase "%s%s%s" \
"${phrase%%${BASH_REMATCH[0]}*}" \
"$(repeat "${BASH_REMATCH[1]}" "${BASH_REMATCH[2]}")" \
"${phrase#*${BASH_REMATCH[0]}}"
done
echo "$phrase"
}
repeat() {
local count=$1 char=$2
local result
# string of count spaces
printf -v result "%*s" "$count" ""
# replace spaces with the char
echo "${result// /$char}"
}
Demo
str="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
enc=$(encode "$str")
dec=$(decode "$enc")
declare -p str enc dec
[[ $str == "$dec" ]] && echo success || echo failure
Output
declare -- str="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" declare -- enc="12WB12W3B24WB14W" declare -- dec="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" success
Ursala
A standard library function, rlc, does most of the work for this task, which is a second order function taking a binary predicate that decides when consecutive items of an input list belong to the same run.
#import std
#import nat
encode = (rlc ==); *= ^lhPrNCT\~&h %nP+ length
decode = (rlc ~&l-=digits); *=zyNCXS ^|DlS/~& iota+ %np
test_data = 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
#show+
example =
<
encode test_data,
decode encode test_data>
The output shows an encoding of the test data, and a decoding of the encoding, which matches the original test data.
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
VBA
Option Explicit
Sub Main()
Dim p As String
p = length_encoding("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW")
Debug.Print p
Debug.Print length_decoding(p)
End Sub
Private Function length_encoding(S As String) As String
Dim F As String, r As String, a As String, n As Long, c As Long, k As Long
r = Left(S, 1)
c = 1
For n = 2 To Len(S)
If r <> Mid(S, n, 1) Then
a = a & c & r
r = Mid(S, n, 1)
c = 1
Else
c = c + 1
End If
Next
length_encoding = a & c & r
End Function
Private Function length_decoding(S As String) As String
Dim F As Long, r As String, a As String
For F = 1 To Len(S)
If IsNumeric(Mid(S, F, 1)) Then
r = r & Mid(S, F, 1)
Else
a = a & String(CLng(r), Mid(S, F, 1))
r = vbNullString
End If
Next
length_decoding = a
End Function
- Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Vedit macro language
The following example encodes/decodes an entire file. Each run is coded with two bytes. The first byte is the run length with high bit set, the second byte is the character code. ASCII characters with run length of 1 are left unchanged. Character codes above 127 are always coded with run length. Newlines are not converted (the regular expression does not count newlines). This methods supports any type of input.
:RL_ENCODE:
BOF
While (!At_EOF) {
if (At_EOL) { Line(1) Continue } // skip newlines
#1 = Cur_Char // #1 = character
Match("(.)\1*", REGEXP) // count run length
#2 = Chars_Matched // #2 = run length
if (#2 > 127) { #2 = 127 } // can be max 127
if (#2 > 1 || #1 > 127) {
Del_Char(#2)
Ins_Char(#2 | 128) // run length (high bit set)
Ins_Char(#1) // character
} else { // single ASCII char
Char // skip
}
}
Return
:RL_DECODE:
BOF
While (!At_EOF) {
#2 = Cur_Char
if (#2 > 127) { // is this run length?
#1 = Cur_Char(1) // #1 = character value
Del_Char(2)
Ins_Char(#1, COUNT, #2 & 127)
} else { // single ASCII char
Char
}
}
Return
V (Vlang)
const test = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
fn main() {
encoded := encode(test)
println(encoded)
println(decode(encoded))
}
fn encode(data string) string {
mut encode :=""
mut temp := []u8{}
for key, value in data {
if key > 1 && value != data[key - 1] {
encode += temp.len.str() + temp[0].ascii_str()
temp.clear()
}
temp << value
}
encode += temp.len.str() + temp[0].ascii_str()
temp.clear()
return encode
}
fn decode(data string) string {
mut decode :=""
mut temp := []u8{}
for value in data {
if value.is_digit() == false {
decode += value.repeat(temp.bytestr().int())
temp.clear()
}
else {temp << value}
}
return decode
}
- Output:
12W1B12W3B24W1B14W WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Wren
import "./pattern" for Pattern
var p = Pattern.new("/u") // match any upper case letter
var encode = Fn.new { |s|
if (s == "") return s
var e = ""
var curr = s[0]
var count = 1
var i = 1
while (i < s.count) {
if (s[i] == curr) {
count = count + 1
} else {
e = e + count.toString + curr
curr = s[i]
count = 1
}
i = i + 1
}
return e + count.toString + curr
}
var decode = Fn.new { |e|
if (e == "") return e
var letters = Pattern.matchesText(p.findAll(e))
var numbers = p.splitAll(e)[0..-2].map { |s| Num.fromString(s) }.toList
return (0...letters.count).reduce("") { |acc, i| acc + letters[i]*numbers[i] }.join()
}
var strings = [
"AA",
"RROSETTAA",
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
]
for (s in strings) {
System.print("Original text : %(s)")
var e = encode.call(s)
System.print("Encoded text : %(e)")
var d = decode.call(e)
System.print("Decoded text : %(d)")
System.print("Original = decoded : %(s == d)\n")
}
- Output:
Original text : AA Encoded text : 2A Decoded text : AA Original = decoded : true Original text : RROSETTAA Encoded text : 2R1O1S1E2T2A Decoded text : RROSETTAA Original = decoded : true Original text : WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded text : 12W1B12W3B24W1B14W Decoded text : WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Original = decoded : true
XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations
string 0; \use zero-terminated strings, instead of MSb terminated
proc Compress(S); \Compress string using run-length encoding, & display it
char S;
int I, C0, C, N;
[I:= 0;
C0:= S(I); I:= I+1;
repeat ChOut(0, C0);
N:= 0;
repeat C:= S(I); I:= I+1;
N:= N+1;
until C#C0;
if N>1 then IntOut(0, N-1);
C0:= C;
until C=0;
]; \Compress
proc Expand(S); \Expand compressed string, and display it
char S;
int I, C0, C, N;
[I:= 0;
C0:= S(I); I:= I+1;
repeat ChOut(0, C0);
C:= S(I); I:= I+1;
if C>=^1 & C<=^9 then
[N:= 0;
while C>=^0 & C<=^9 do
[N:= N*10 + C-^0;
C:= S(I); I:= I+1;
];
while N do [ChOut(0, C0); N:= N-1];
];
C0:= C;
until C=0;
]; \Expand
[Compress("WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW");
CrLf(0);
Expand("W11BW11B2W23BW13"); CrLf(0);
]
Output (with slightly better compression than the example):
W11BW11B2W23BW13 WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
Zig
const std = @import("std");
fn Run(comptime T: type) type {
return struct {
value: T,
length: usize,
};
}
fn encode(
comptime T: type,
input: []const T,
allocator: std.mem.Allocator,
) ![]Run(T) {
var runs = std.ArrayList(Run(T)).init(allocator);
defer runs.deinit();
var previous: ?T = null;
var length: usize = 0;
for (input) |current| {
if (previous == current) {
length += 1;
} else if (previous) |value| {
try runs.append(.{
.value = value,
.length = length,
});
previous = current;
length = 1;
} else {
previous = current;
length += 1;
}
}
if (previous) |value| {
try runs.append(.{
.value = value,
.length = length,
});
}
return runs.toOwnedSlice();
}
test encode {
const input =
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
const expected = [_]Run(u8){
.{ .length = 12, .value = 'W' },
.{ .length = 1, .value = 'B' },
.{ .length = 12, .value = 'W' },
.{ .length = 3, .value = 'B' },
.{ .length = 24, .value = 'W' },
.{ .length = 1, .value = 'B' },
.{ .length = 14, .value = 'W' },
};
const allocator = std.testing.allocator;
const actual = try encode(u8, input, allocator);
defer allocator.free(actual);
try std.testing.expectEqual(expected.len, actual.len);
for (expected, actual) |e, a| {
try std.testing.expectEqual(e.length, a.length);
try std.testing.expectEqual(e.value, a.value);
}
}
fn decode(
comptime T: type,
runs: []const Run(T),
allocator: std.mem.Allocator,
) ![]T {
var values = std.ArrayList(T).init(allocator);
defer values.deinit();
for (runs) |r|
try values.appendNTimes(r.value, r.length);
return values.toOwnedSlice();
}
test decode {
const runs = [_]Run(u8){
.{ .length = 12, .value = 'W' },
.{ .length = 1, .value = 'B' },
.{ .length = 12, .value = 'W' },
.{ .length = 3, .value = 'B' },
.{ .length = 24, .value = 'W' },
.{ .length = 1, .value = 'B' },
.{ .length = 14, .value = 'W' },
};
const allocator = std.testing.allocator;
const decoded = try decode(u8, &runs, allocator);
defer allocator.free(decoded);
try std.testing.expectEqualStrings(
"WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
decoded,
);
}
pub fn main() !void {
var gpa = std.heap.GeneralPurposeAllocator(.{}){};
defer std.debug.assert(gpa.deinit() == .ok);
const allocator = gpa.allocator();
var input = std.ArrayList(u8).init(allocator);
defer input.deinit();
const stdout = std.io.getStdOut().writer();
const stdin = std.io.getStdIn().reader();
try stdout.print("Input: ", .{});
try stdin.streamUntilDelimiter(input.writer(), '\n', null);
const runs = try encode(u8, input.items, allocator);
defer allocator.free(runs);
try stdout.print("Encoded:\n", .{});
for (runs) |r|
try stdout.print(" {}\n", .{r});
const decoded = try decode(u8, runs, allocator);
defer allocator.free(decoded);
try stdout.print("Decoded: {s}\n", .{decoded});
}
- Output:
Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW Encoded: run_length_encoding.Run(u8){ .value = 87, .length = 12 } run_length_encoding.Run(u8){ .value = 66, .length = 1 } run_length_encoding.Run(u8){ .value = 87, .length = 12 } run_length_encoding.Run(u8){ .value = 66, .length = 3 } run_length_encoding.Run(u8){ .value = 87, .length = 24 } run_length_encoding.Run(u8){ .value = 66, .length = 1 } run_length_encoding.Run(u8){ .value = 87, .length = 14 } Decoded: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
zkl
A byte stream to byte stream codec, the streams hard coded for ease. Character '\1' is used as a sentinel and there are limits on the run length to avoid byte overflow.
const MAX_LEN=250, MIN_LEN=3;
fcn compress(text){ // !empty byte/text stream -->Data (byte stream)
sink:=Data(); cnt:=Ref(0);
write:='wrap(c,n){ // helper function
while(n>MAX_LEN){
sink.write(1); sink.write(MAX_LEN); sink.write(c);
n-=MAX_LEN;
}
if(n>MIN_LEN){ sink.write(1); sink.write(n); sink.write(c); }
else { do(n) { sink.write(c); } }
};
text.reduce('wrap(a,b){
if(a==b) cnt.inc();
else{ write(a,cnt.value); cnt.set(1); }
b
},text[0]) : write(_,cnt.value);
sink;
}
fcn inflate(data){ //-->String
data.howza(3).pump(String,
fcn(c){ // if c==1, read n,c2 and expand, else write c
if(c=="\x01") return(Void.Read,2) else return(Void.Write,c) },
fcn(_,n,c){ c*n.toAsc() })
}
text:="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";
d:=compress(text);
d.bytes().println();
println(text.len()," bytes --> ",d.len()," bytes");
println(text==inflate(d));
- Output:
L(1,12,87,66,1,12,87,66,66,66,1,24,87,66,1,14,87) 67 bytes --> 17 bytes True
- WikipediaSourced
- Programming Tasks
- Compression
- Encodings
- 11l
- 8086 Assembly
- Action!
- Ada
- ALGOL 68
- Amazing Hopper
- APL
- AppleScript
- Arturo
- AutoHotkey
- AWK
- BaCon
- BASIC
- Applesoft BASIC
- BASIC256
- BBC BASIC
- Befunge
- Bracmat
- Burlesque
- C
- C sharp
- C++
- Boost
- Ceylon
- Clojure
- COBOL
- CoffeeScript
- Common Lisp
- D
- Déjà Vu
- Delphi
- System.SysUtils
- E
- EasyLang
- Elena
- Elixir
- Emacs Lisp
- Seq.el
- Erlang
- Euphoria
- F Sharp
- Factor
- FALSE
- Fan
- Forth
- Fortran
- FreeBASIC
- FutureBasic
- Gambas
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JUnit
- JavaScript
- Jq
- Julia
- K
- Kotlin
- Lasso
- Liberty BASIC
- LiveCode
- Logo
- Lua
- M2000 Interpreter
- Mathematica
- Wolfram Language
- Maxima
- MMIX
- Nim
- Objeck
- Objective-C
- OCaml
- Oforth
- Ol
- Oz
- PARI/GP
- Pascal
- Perl
- Phix
- PHP
- Picat
- PicoLisp
- PL/I
- PowerBASIC
- PowerShell
- Prolog
- Pure
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- REXX
- Ring
- RPL
- Ruby
- Run BASIC
- Rust
- Scala
- Scheme
- Sed
- Seed7
- SETL
- Sidef
- Smalltalk
- SNOBOL4
- SparForte
- SQL
- Standard ML
- Swift
- Tcl
- TMG
- TSE SAL
- TUSCRIPT
- UNIX Shell
- Ursala
- VBA
- Vedit macro language
- V (Vlang)
- Wren
- Wren-pattern
- XPL0
- Zig
- Zkl
- Pages with too many expensive parser function calls