Thue-Morse: Difference between revisions
(Added Ruby) |
(Added Sidef) |
||
Line 526: | Line 526: | ||
6.times{puts s << s.tr("01","10")}</lang> |
6.times{puts s << s.tr("01","10")}</lang> |
||
{{out}} |
|||
<pre> |
|||
0 |
|||
01 |
|||
0110 |
|||
01101001 |
|||
0110100110010110 |
|||
01101001100101101001011001101001 |
|||
0110100110010110100101100110100110010110011010010110100110010110 |
|||
</pre> |
|||
=={{header|Sidef}}== |
|||
<lang ruby>func recmap(repeat, seed, transform, callback) { |
|||
func (repeat, seed) { |
|||
callback(seed) |
|||
repeat > 0 && __FUNC__(repeat-1, transform(seed)) |
|||
}(repeat, seed) |
|||
} |
|||
recmap(6, "0", {|s| s + s.tr('01', '10') }, { .say })</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
Revision as of 21:32, 4 June 2016
You are encouraged to solve this task according to the task description, using any language you may know.
Create a Thue-Morse sequence.
- See also
ALGOL 68
<lang algol68># "flips" the "bits" in a string (assumed to contain only "0" and "1" characters) # OP FLIP = ( STRING s )STRING:
BEGIN STRING result := s; FOR char pos FROM LWB result TO UPB result DO result[ char pos ] := IF result[ char pos ] = "0" THEN "1" ELSE "0" FI OD; result END; # FLIP #
- print the first few members of the Thue-Morse sequence #
STRING tm := "0"; TO 7 DO
print( ( tm, newline ) ); tm +:= FLIP tm
OD</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
AWK
<lang AWK>BEGIN{print x="0"} {gsub(/./," &",x);gsub(/ 0/,"01",x);gsub(/ 1/,"10",x);print x}</lang>
C
<lang c>#include <stdio.h>
- include <stdlib.h>
- include <string.h>
int main(int argc, char *argv[]){ char sequence[256+1] = "0"; char inverse[256+1] = "1"; char buffer[256+1]; int i;
for(i = 0; i < 8; i++){ strcpy(buffer, sequence); strcat(sequence, inverse); strcat(inverse, buffer); }
puts(sequence); return 0; }</lang>
- Output:
0110100110010110100101100110100110010110011010010110100110010110100101100110100101101001100101100110100110010110100101100110100110010110011010010110100110010110011010011001011010010110011010010110100110010110100101100110100110010110011010010110100110010110
C++
<lang cpp>
- include <iostream>
- include <iterator>
- include <vector>
int main( int argc, char* argv[] ) {
std::vector<bool> t; t.push_back( 0 ); size_t len = 1; std::cout << t[0] << "\n"; do { for( size_t x = 0; x < len; x++ ) t.push_back( t[x] ? 0 : 1 ); std::copy( t.begin(), t.end(), std::ostream_iterator<bool>( std::cout ) ); std::cout << "\n"; len = t.size(); } while( len < 60 ); return 0;
} </lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
D
<lang d>import std.range; import std.stdio;
struct TM {
private char[] sequence = ['0']; private char[] inverse = ['1']; private char[] buffer;
enum empty = false; auto front() { return sequence; } auto popFront() { buffer = sequence; sequence ~= inverse; inverse ~= buffer; }
}
void main() {
TM sequence;
foreach (step; sequence.take(8)) { writeln(step); }
} </lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
Elixir
<lang elixir>Enum.reduce(0..6, '0', fn _,s ->
IO.puts s s ++ Enum.map(s, fn c -> if c==?0, do: ?1, else: ?0 end)
end)
- or
Stream.iterate('0', fn s -> s ++ Enum.map(s, fn c -> if c==?0, do: ?1, else: ?0 end) end) |> Enum.take(7) |> Enum.each(&IO.puts/1)</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
Go
<lang go>// prints the first few members of the Thue-Morse sequence
package main
import (
"fmt" "bytes"
)
// sets tmBuffer to the next member of the Thue-Morse sequence // tmBuffer must contain a valid Thue-Morse sequence member before the call func nextTMSequenceMember( tmBuffer * bytes.Buffer ) {
// "flip" the bytes, adding them to the buffer for b, currLength, currBytes := 0, tmBuffer.Len(), tmBuffer.Bytes() ; b < currLength; b ++ { if currBytes[ b ] == '1' { tmBuffer.WriteByte( '0' ) } else { tmBuffer.WriteByte( '1' ) } }
}
func main() {
var tmBuffer bytes.Buffer // initial sequence member is "0" tmBuffer.WriteByte( '0' ) fmt.Println( tmBuffer.String() ) for i := 2; i <= 7; i ++ { nextTMSequenceMember( & tmBuffer ) fmt.Println( tmBuffer.String() ) }
}</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
Haskell
<lang haskell>import Control.Monad
thueMorse = ap (++) (map (1-)) `iterate` [0]</lang>
Output: <lang haskell>~> thueMorse !! 5 [0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1]</lang>
J
We only show a prefix of the sequence:
<lang J> (, -.)@]^:[&0]9 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 ...</lang>
Or, more compactly:
<lang J> ' '-.~":(, -.)@]^:[&0]9 0110100110010110100101100110100110010110011010010110100110010110100101100110100101101001100101100110100110010110100101100110100110010110011010010110100110010110011010011001011010010110011010010110100110010110100101100110100110010110011010010110100110010110...</lang>
Java
<lang java>public class ThueMorse {
public static void main(String[] args) { sequence(6); }
public static void sequence(int steps) { StringBuilder sb1 = new StringBuilder("0"); StringBuilder sb2 = new StringBuilder("1"); for (int i = 0; i < steps; i++) { String tmp = sb1.toString(); sb1.append(sb2); sb2.append(tmp); } System.out.println(sb1); }
}</lang>
0110100110010110100101100110100110010110011010010110100110010110
Lua
<lang Lua>ThueMorse = {sequence = "0"}
function ThueMorse:show ()
print(self.sequence)
end
function ThueMorse:addBlock ()
local newBlock = "" for bit = 1, self.sequence:len() do if self.sequence:sub(bit, bit) == "1" then newBlock = newBlock .. "0" else newBlock = newBlock .. "1" end end self.sequence = self.sequence .. newBlock
end
for i = 1, 5 do
ThueMorse:show() ThueMorse:addBlock()
end</lang>
- Output:
0 01 0110 01101001 0110100110010110
OASYS Assembler
<lang oasys_oaa>; Thue-Morse sequence
[*'A] ; Ensure the vocabulary is not empty [&] ; Declare the initialization procedure %#1> ; Initialize length counter %@*> ; Create first object ,#1> ; Initialize loop counter
- ; Begin loop
%@<.#<PI ; Print current cell *.#%@<.#<NOT> ; Create new cell %@%@<NXT> ; Advance to next cell ,#,#<DN> ; Decrement loop counter ,#</ ; Check if loop counter is now zero %#%#<2MUL> ; Double length counter ,#%#<> ; Reset loop counter %@FO> ; Reset object pointer CR ; Line break
| ; Repeat loop</lang> The standard DOS-based interpreter will display an error message about word too long after 7 lines are output; this is because the 8th line does not fit in 80 columns.
Pascal
Like the C++ Version [[1]] the lenght of the sequence is given in advance. <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';
var
pOrg, pRpl : pChar; i,k,ml : NativeUInt;//MaxLen: NativeInt
Begin
iF maxlen < 1 then Begin result := ; EXIT; end; //setlength only one time setlength(result,Maxlen);
pOrg := @result[1]; pOrg[0] := cVal0; IF maxlen = 1 then EXIT;
pRpl := pOrg; inc(pRpl); k := 1; ml:= Maxlen; repeat i := 0; repeat pRpl[0] := chr(Ord(cVal0)+Ord(cVal1)-Ord(pOrg[i])); inc(pRpl); inc(i); 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;
var
i : integer;
Begin
For i := 0 to 8 do writeln(i:3,' ',fThueMorse(i)); fThueMorse(1 shl 30);
end.</lang>
- Output:
Compile with /usr/lib/fpc/3.0.1/ppc386 "ThueMorse.pas" -al -XX -Xs -O4 -MDelphiwithout -O4 -> 2 secs
0 1 ^ 2 ^v 3 ^vv 4 ^vv^ 5 ^vv^v 6 ^vv^v^ 7 ^vv^v^^ 8 ^vv^v^^vnot written: 1 shl 30 == 1GB
real 0m0.806s user 0m0.563s sys 0m0.242s
Perl 6
Use Ctrl-C to interrupt. <lang perl6>.say for 0, { '0' ~ @_.join.trans( "01" => "10", :g) } ... *;</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110 01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001 ^C
PicoLisp
<lang PicoLisp>(let R 0
(prinl R) (for (X 1 (>= 32 X)) (setq R (bin (pack (bin R) (bin (x| (dec (** 2 X)) R)) ) ) ) (prinl (pack 0 (bin R))) (inc 'X X) ) )</lang>
PowerShell
<lang powershell>function New-ThueMorse ( $Digits )
{ # Start with seed 0 $ThueMorse = "0" # Decrement digits remaining $Digits-- # While we still have digits to calculate... While ( $Digits -gt 0 ) { # Number of digits we'll get this loop (what we still need up to the maximum available), corrected to 0 base $LastDigit = [math]::Min( $ThueMorse.Length, $Digits ) - 1 # Loop through each digit ForEach ( $i in 0..$LastDigit ) { # Append the twos complement $ThueMorse += ( 1 - $ThueMorse.Substring( $i, 1 ) ) } # Calculate the number of digits still remaining $Digits = $Digits - $LastDigit - 1 } return $ThueMorse }
New-ThueMorse 5 New-ThueMorse 16 New-ThueMorse 73</lang>
- Output:
01101 0110100110010110 0110100110010110100101100110100110010110011010010110100110010110100101100
Python
<lang racket|Python> m='0' print(m) for i in range(0,6):
m0=m m=m.replace('0','a') m=m.replace('1','0') m=m.replace('a','1') m=m0+m print(m)
</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
Racket
<lang racket>#lang racket (define 1<->0 (match-lambda [#\0 #\1] [#\1 #\0])) (define (thue-morse-step (s "0"))
(string-append s (list->string (map 1<->0 (string->list s)))))
(define (thue-morse n)
(let inr ((n (max (sub1 n) 0)) (rv (list "0"))) (if (zero? n) (reverse rv) (inr (sub1 n) (cons (thue-morse-step (car rv)) rv)))))
(for-each displayln (thue-morse 7))</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
REXX
using functions
Programming note: pop count (or weight) is the number of 1's bits in the binary representation of a number. <lang rexx>/*REXX pgm generates & displays the Thue─Morse sequence up to the Nth term (inclusive). */ parse arg N . /*obtain the optional argument from CL.*/ if N== | N=="," then N=80 /*Not specified? Then use the default.*/ $= /*the Thue─Morse sequence (so far). */
do j=0 to N /*generate sequence up to the Nth item.*/ $=$ || $weight(j) // 2 /*append the item to the Thue─Morse seq*/ end /*j*/
say $ exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ $pop: return length( space( translate( arg(1), , 0), 0) ) /*count 1's in number.*/ $weight: return $pop( x2b( d2x( arg(1) ) ) ) /*dec──►bin, pop count*/</lang> output when using the default input:
01101001100101101001011001101001100101100110100101101001100101101001011001101001
using in-line code
<lang rexx>/*REXX pgm generates & displays the Thue─Morse sequence up to the Nth term (inclusive). */ parse arg N . /*obtain the optional argument from CL.*/ if N== | N=="," then N=80 /*Not specified? Then use the default.*/ $= /*the Thue─Morse sequence (so far). */
do j=0 to N /*generate sequence up to the Nth item.*/ $=$ || length( space( translate( x2b( d2x(j) ), , 0), 0) ) // 2 /*append to $.*/ end /*j*/
say $ /*stick a fork in it, we're all done. */</lang>
output is identical to the 1st REXX version.
using 2's complement
Programming note: this method displays the sequence, but it doubles in (binary) length each iteration.
Because of this, the displaying of the output lacks the granularity of the first two REXX versions. <lang rexx>/*REXX pgm generates & displays the Thue─Morse sequence up to the Nth term (inclusive). */ parse arg N . /*obtain the optional argument from CL.*/ if N== | N=="," then N=6 /*Not specified? Then use the default.*/ $=0 /*the Thue─Morse sequence (so far). */
do j=1 for N /*generate sequence up to the Nth item.*/ $=$ || translate($, 10, 01) /*append $'s complement to $ string.*/ end /*j*/
say $ /*stick a fork in it, we're all done. */</lang> output when using the default input:
0110100110010110100101100110100110010110011010010110100110010110
Ruby
<lang ruby>puts s = "0" 6.times{puts s << s.tr("01","10")}</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
Sidef
<lang ruby>func recmap(repeat, seed, transform, callback) {
func (repeat, seed) { callback(seed) repeat > 0 && __FUNC__(repeat-1, transform(seed)) }(repeat, seed)
}
recmap(6, "0", {|s| s + s.tr('01', '10') }, { .say })</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
SQL
This example is using SQLite. <lang SQL>with recursive a(a) as (select '0' union all select replace(replace(hex(a),'30','01'),'31','10') from a) select * from a;</lang> You can add a LIMIT clause to the end to limit how many lines of output you want.
Tcl
Since string map correctly handles overlapping replacements, the simple map 0 -> 01; 1 -> 10 can be applied with no special handling:
<lang Tcl>proc tm_expand {s} {string map {0 01 1 10} $s}
- this could also be written as:
- interp alias {} tm_expand {} string map {0 01 1 10}
proc tm {k} {
set s 0 while {[incr k -1] >= 0} { set s [tm_expand $s] } return $s
}</lang>
Testing:
<lang Tcl>for {set i 0} {$i <= 6} {incr i} {
puts [tm $i]
}</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110
For giggles, also note that the above SQL solution can be "natively" applied in Tcl8.5+, which bundles Sqlite as a core extension:
<lang Tcl> package require sqlite3 ;# available with Tcl8.5+ core sqlite3 db "" ;# create in-memory database set LIMIT 6 db eval {with recursive a(a) as (select '0' union all select replace(replace(hex(a),'30','01'),'31','10') from a) select a from a limit $LIMIT} {
puts $a
}</lang>
zkl
<lang zkl>fcn nextTM(str){ str.pump(str,'-.fp("10")) } // == fcn(c){ "10" - c }) }</lang> "12233334444" - "23"-->"14444" <lang zkl>str:="0"; do(7){ str=nextTM(str.println()) }</lang> println() returns the result it prints (as a string).
<lang zkl>fcn nextTM2{
var sb1=Data(Void,"0"), sb2=Data(Void,"1"); r:=sb1.text; sb1.append(sb2); sb2.append(r); r
}</lang> <lang zkl>do(7){ nextTM2().println() }</lang>
- Output:
0 01 0110 01101001 0110100110010110 01101001100101101001011001101001 0110100110010110100101100110100110010110011010010110100110010110