Thue-Morse: Difference between revisions

Content added Content deleted
(added =={{header|Pascal}}==)
m (→‎{{header|Pascal}}: use a function with length set once. 50% faster than before. ^ v as alias for 0 1)
Line 149: Line 149:
=={{header|Pascal}}==
=={{header|Pascal}}==
{{works with|Free Pascal}}
{{works with|Free Pascal}}
Like the C++ Version [[http://rosettacode.org/wiki/Thue-Morse#C.2B.2B]] the lenght of the sequence is given in advance.
<lang pascal>
Program ThueMorse;
<lang pascal>Program ThueMorse;

function fThueMorse(maxLen: NativeInt):AnsiString;
⚫
//double by appending the flipped original 0 -> 1;1 -> 0
//Flipping between two values:x oszillating A,B,A,B -> x_next = A+B-x
//Beware A+B < High(Char), the compiler will complain ...
⚫
const
cVal0 = '^';cVal1 = 'v';// cVal0 = '0';cVal1 = '1';


procedure NextThueMorse(var s: AnsiString);
⚫
//double length and append by flipping every original 0 -> 1;1 -> 0
//flipping x between A;B - > x_next = A+B-x
var
var
⚫
i : NativeInt;
pOrg,
pOrg,
pRpl : pChar;
pRpl : pChar;
i,k,ml : NativeUInt;//MaxLen: NativeInt
Begin
Begin
IF s = '' then
iF maxlen < 1 then
Begin
Begin
s := '0';
result := '';
EXIT;
EXIT;
end;
end;
//setlength only one time
⚫
i := length(s);
setlength(s,i+i);
setlength(result,Maxlen);
⚫
pOrg := @s[1];
pRpl := @s[i+1];
⚫
repeat
⚫
dec(i);
⚫
pRpl[i] := chr(Ord('1')+Ord('0')-Ord(pOrg[i]));
⚫
until i<=0;
end;


⚫
pOrg := @result[1];
procedure NextThueMorseLSystem(var s: AnsiString);
pOrg[0] := cVal0;
//double length and replace every 0 -> 01 and 1 -> 10
⚫
IF maxlen = 1 then
//doing it backwards, so no extra copy is needed.
⚫
const
cReplace : array['0'..'1'] of String[2] = ('01','10');
var
i : NativeInt;
pS,pR : pChar;
Begin
⚫
IF s = '' then
Begin
s := '0';
EXIT;
EXIT;

end;
i := length(s);
pRpl := pOrg;
setlength(s,i+i);
inc(pRpl);
pS := @s[i+i];
k := 1;
dec(ps);
ml:= Maxlen;
repeat
repeat
pR := @cReplace[s[i]];
i := 0;
pS[ 1]:= pR[2];
repeat
pS[ 0]:= pR[1];
pRpl[0] := chr(Ord(cVal0)+Ord(cVal1)-Ord(pOrg[i]));
dec(ps,2);
inc(pRpl);
dec(i);
inc(i);
until i<=0;
until i>=k;
⚫
inc(k,k);
until k+k> ml;
// the rest
⚫
i := 0;
⚫
k := ml-k;
⚫
IF k > 0 then
⚫
repeat
⚫
pRpl[0] := chr(Ord(cVal0)+Ord(cVal1)-Ord(pOrg[i]));
⚫
inc(pRpl);
inc(i)
⚫
until i>=k;
end;
end;


var
var
s: AnsiString;
i : integer;
i : integer;
Begin
Begin
For i := 0 to 30 do
For i := 0 to 8 do
writeln(i:3,' ',fThueMorse(i));
Begin
fThueMorse(1 shl 30);
NextThueMorse(s);
⚫
IF i < 6 then
⚫
writeln(s);
end;
writeln(length(s));
end.</lang>
end.</lang>
{{Output}}<pre>Compile with /usr/lib/fpc/3.0.1/ppc386 "ThueMorse.pas" -al -XX -Xs -O4 -MDelphi
{{Output}}<pre>//NextThueMorse
without -O4 -> 2 secs
0
0
01
1 ^
0110
2 ^v
01101001
3 ^vv
0110100110010110
4 ^vv^
01101001100101101001011001101001
5 ^vv^v
1073741824 ( 1 GB)
6 ^vv^v^
⚫
real 0m1.162s user 0m0.689s sys 0m0.472s //memory allocation
7 ^vv^v^^
//NextThueMorseLSystem
8 ^vv^v^^v
Same Output
not written: 1 shl 30 == 1GB
real 0m1.981s user 0m1.492s sys 0m0.486s
⚫
real 0m0.806s user 0m0.563s sys 0m0.242s</pre>
</pre>

=={{header|Perl 6}}==
=={{header|Perl 6}}==
{{Works with|rakudo|2015-12-22}}
{{Works with|rakudo|2015-12-22}}
Retrieved from "https://rosettacode.org/wiki/Thue-Morse"