Thue-Morse

Thue-Morse
You are encouraged to solve this task according to the task description, using any language you may know.

Task

Create a   Thue-Morse sequence.

See also

•   YouTube entry:   The Fairest Sharing Sequence Ever

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 #

1. 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>

BBC BASIC

<lang bbcbasic>REM >thuemorse tm$ = "0" PRINT tm$ FOR i% = 1 TO 8

 tm$ = FN_thue_morse(tm$)
 PRINT tm$

NEXT END

DEF FN_thue_morse(previous$) LOCAL i%, tm$ tm$ = "" FOR i% = 1 TO LEN previous$

 IF MID$(previous$, i%, 1) = "1" THEN tm$ += "0" ELSE tm$ += "1"

NEXT = previous$ + tm$</lang>

Output:

0
01
0110
01101001
0110100110010110
01101001100101101001011001101001
0110100110010110100101100110100110010110011010010110100110010110
01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001
0110100110010110100101100110100110010110011010010110100110010110100101100110100101101001100101100110100110010110100101100110100110010110011010010110100110010110011010011001011010010110011010010110100110010110100101100110100110010110011010010110100110010110

C

Translation of: Java

<lang c>#include <stdio.h>

1. include <stdlib.h>
2. 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>

1. include <iostream>
2. include <iterator>
3. 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)

1. 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

NewLISP

<lang newslisp> (define (Thue-Morse loops)

   (setf TM '(0))
   (println TM)
   (for (i 1 (-- loops))
       (setf tm TM)
       (replace '0 tm '_)
       (replace '1 tm '0)
       (replace '_ tm '1)
       (setf TM (append TM tm))
       (println TM)
   )

)

(Thue-Morse 5) (exit) </lang>

Output:

(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)

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

Works with: Free 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 -MDelphi
without -O4 -> 2 secs

 0
 1  ^
 2  ^v
 3  ^vv
 4  ^vv^
 5  ^vv^v
 6  ^vv^v^
 7  ^vv^v^^
 8  ^vv^v^^v

not written: 1 shl 30 == 1GB

real  0m0.806s user  0m0.563s sys 0m0.242s

Perl 6

Works with: rakudo version 2015-12-22

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 1^st 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}

1. this could also be written as:
2. 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>

XLISP

<lang lisp>(defun thue-morse (n)

   (defun flip-bits (s)
       (defun flip (l)
           (if (not (null l))
               (cons
                   (if (equal (car l) #\1)
                       #\0
                       #\1)
                   (flip (cdr l)))))
       (list->string (flip (string->list s))))
   (if (= n 0)
       "0"
       (string-append (thue-morse (- n 1)) (flip-bits (thue-morse (- n 1))))))

define RANGE, for testing purposes

(defun range (x y)

   (if (< x y)
       (cons x (range (+ x 1) y))))

test THUE-MORSE by printing the strings it returns for n = 0 to n = 6

(mapcar (lambda (n) (print (thue-morse n))) (range 0 7))</lang>

Output:

"0" 
"01" 
"0110" 
"01101001" 
"0110100110010110" 
"01101001100101101001011001101001" 
"0110100110010110100101100110100110010110011010010110100110010110"

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).

Translation of: Java

<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