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

Time for an 2014 update…

Browse source
This commit is contained in:
Ingy döt Net 2014-01-17 05:32:22 +00:00
parent 372c577f83
commit 09687c4926
2520 changed files with 34227 additions and 7318 deletions
Download patch file Download diff file Expand all files Collapse all files

124
Task/Run-length-encoding/COBOL/run-length-encoding.cobol Normal file
View file

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

24
Task/Run-length-encoding/D/run-length-encoding-2.d
View file

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

29
Task/Run-length-encoding/Deja-Vu/run-length-encoding.djv Normal file
View file

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

27
Task/Run-length-encoding/REXX/run-length-encoding-1.rexx
View file

@ -1,21 +1,20 @@
/*REXX program encodes string by using a run-length scheme (min len=2).*/
parse arg x /*normally, input would be a file*/
def='WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
if x=='' then x=def /*No input? Then use the default*/
/*REXX program encodes a string by using a run-length scheme. */
parse arg x . /*normally, input would be a file*/
/*═══ arg x . ═══*/ /*◄── use if X must be uppercase.*/
def= 'WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'
if x='' then x=def /*No input? Then use the default.*/
Lx=length(x) /*get the length of the X string.*/
y= /*Y is the output string (so far)*/
do j=1 to Lx /*warning! J is modified below.*/
do j=1 by 0 to Lx /*J is incremented (below). */
c=substr(x,j,1) /*pick a character, check for err*/
if \datatype(c,'m') then do;say "error!: data isn't alphabetic";exit 13; end
if \datatype(c,'M') then do; say "error!: data isn't alphabetic:" c; exit 13; end
r=0 /*R is NOT the number of chars. */
do k=j+1 to Lx while substr(x,k,1)==c
r=r+1 /*R is a replication count. */
end /*k*/
if r==0 then Y = Y || c /*C wan't repeated, just OUT it.*/
else Y = Y || r || c /*add it to the encoded string. */
j=j+r /*A bad thing to do, but simple. */
do k=j+1 to Lx while substr(x,k,1)==c
r=r+1 /*R is a replication count. */
end /*k*/
j=j+1+r /*modify (add to) the do index. */
if r==0 then r= /*don't use R if R is zero.*/
Y = Y || r || c /*add it to the encoded string.*/
end /*j*/
say ' input=' x

13
Task/Run-length-encoding/REXX/run-length-encoding-2.rexx
View file

@ -1,22 +1,21 @@
/*REXX program decodes string by using a run-length scheme (min len=2).*/
parse arg x /*normally, input would be a file*/
/*REXX program decodes a string by using a run-length scheme. */
parse arg x . /*normally, input would be a file*/
if x=='' then x='11WB11W2B23WB13W' /*No input? Then use the default*/
Lx=length(x) /*get the length of the X string.*/
y= /*Y is the output string (so far)*/
do j=1 to Lx /*warning! J is modified below.*/
do j=1 by 0 to Lx /*warning! J is modified below.*/
c=substr(x,j,1)
if \datatype(c,'W') then do /*a loner char, simply add to OUT*/
y=y || c
iterate
y=y || c; j=j+1; iterate /*j*/
end
d=1
do k=j+1 to Lx while datatype(substr(x,k,1),'w') /*look for #end*/
d=d+1 /*d is the number of digs so far.*/
d=d+1 /*D is the number of digs so far.*/
end /*k*/
n=substr(x,j,d)+1 /*D is length of encoded number.*/
y=y || copies(substr(x,k,1),n) /*N is now the number of chars. */
j=j+d /*A bad thing to do, but simple. */
j=j+1+d /*increment the DO loop index. */
end /*j*/
say ' input=' x