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:
=={{header|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>
<lang pascal>Program ThueMorse;
 
function fThueMorse(maxLen: NativeInt):AnsiString;
//double lengthby and append byappending flippingthe everyflipped 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
i : NativeInt;▼
pOrg,
pRpl : pChar;
i,k,ml : NativeUInt;//MaxLen: NativeInt
Begin
IFiF smaxlen =< ''1 then
Begin
sresult := '0';
EXIT;
end;
//setlength only one time
i := length(s);▼
setlength(sresult,i+iMaxlen);
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 := @sresult[1];
procedure NextThueMorseLSystem(var s: AnsiString);
pOrg[0] := cVal0;
//double length and replace every 0 -> 01 and 1 -> 10
IF smaxlen = ''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;
 
end;
ipRpl := length(s)pOrg;
setlengthinc(s,i+ipRpl);
pSk := @s[i+i]1;
dec(ps)ml:= Maxlen;
repeat
pRi := @cReplace[s[i]]0;
pS[ 1]:= pR[2];repeat
pS[ pRpl[0] := pRchr(Ord(cVal0)+Ord(cVal1)-Ord(pOrg[1i]));
dec inc(ps,2pRpl);
dec inc(i);
until i<>=0k;
▲ decinc(ik,k);
until k+k> ml;
// the rest
▲ i := NativeInt0;
▲ ik := length(s)ml-k;
IF ik <> 60 then▼
▲ repeat
▲ pRpl[i0] := chr(Ord('1'cVal0)+Ord('0'cVal1)-Ord(pOrg[i]));
writelninc(spRpl);▼
inc(i)
▲ until i<>=0k;
end;
 
var
s: AnsiString;
i : integer;
Begin
For i := 0 to 308 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>
{{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 0m10m0.162s806s user 0m0.689s563s sys 0m0.472s 242s<//memory allocation pre>
</pre>
 
=={{header|Perl 6}}==
{{Works with|rakudo|2015-12-22}}
Retrieved from "https://rosettacode.org/wiki/Thue-Morse"