Thue-Morse: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Kotlin)
Line 693: Line 693:
01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001
01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001
^C</pre>
^C</pre>

=={{header|Phix}}==
<lang Phix>string tm = "0"
for i=1 to 8 do
?tm
tm &= sq_sub('0'+'1',tm)
end for</lang>
{{Out}}
<pre>
"0"
"01"
"0110"
"01101001"
"0110100110010110"
"01101001100101101001011001101001"
"0110100110010110100101100110100110010110011010010110100110010110"
"01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001"
</pre>


=={{header|PicoLisp}}==
=={{header|PicoLisp}}==

Revision as of 17:16, 3 April 2017

Task
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



Ada

Implementation using an L-system.

<lang Ada>with Ada.Text_IO; use Ada.Text_IO;

procedure Thue_Morse is

  function Replace(S: String) return String is
     -- replace every "0" by "01" and every "1" by "10"
     (if S'Length = 0 then "" 
     else (if S(S'First) = '0' then "01" else "10") & 

Replace(S(S'First+1 .. S'Last)));

  function Sequence (N: Natural) return String is
     (if N=0 then "0" else Replace(Sequence(N-1)));   
     

begin

  for I in 0 .. 6 loop
     Ada.Text_IO.Put_Line(Integer'Image(I) & ": " & Sequence(I));
  end loop;

end Thue_Morse;</lang>

Output:
 0: 0
 1: 01
 2: 0110
 3: 01101001
 4: 0110100110010110
 5: 01101001100101101001011001101001
 6: 0110100110010110100101100110100110010110011010010110100110010110

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

AppleScript

Translation of: JavaScript

<lang AppleScript>-- thueMorse :: Int -> String on thueMorse(nCycles)

   script concatBinaryInverse
       on lambda(xs)
           script binaryInverse
               on lambda(x)
                   1 - x
               end lambda
           end script
           
           xs & map(binaryInverse, xs)
       end lambda
   end script
   
   intercalate("", ¬
       foldl(concatBinaryInverse, [0], range(1, nCycles)))

end thueMorse


-- TEST on run

   thueMorse(6)
   
   --> 0110100110010110100101100110100110010110011010010110100110010110

end run


-- GENERIC LIBRARY FUNCTIONS

-- map :: (a -> b) -> [a] -> [b] on map(f, xs)

   tell mReturn(f)
       set lng to length of xs
       set lst to {}
       repeat with i from 1 to lng
           set end of lst to lambda(item i of xs, i, xs)
       end repeat
       return lst
   end tell

end map

-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       repeat with i from 1 to lng
           set v to lambda(v, item i of xs, i, xs)
       end repeat
       return v
   end tell

end foldl

-- intercalate :: Text -> [Text] -> Text on intercalate(strText, lstText)

   set {dlm, my text item delimiters} to {my text item delimiters, strText}
   set strJoined to lstText as text
   set my text item delimiters to dlm
   return strJoined

end intercalate

-- range :: Int -> Int -> [Int] on range(m, n)

   if n < m then
       set d to -1
   else
       set d to 1
   end if
   set lst to {}
   repeat with i from m to n by d
       set end of lst to i
   end repeat
   return lst

end range

-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)

   if class of f is script then
       f
   else
       script
           property lambda : f
       end script
   end if

end mReturn</lang>

"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

Common Lisp

<lang lisp>(defun bit-complement (bit-vector)

 (loop with result = (make-array (length bit-vector) :element-type 'bit)
       for b across bit-vector
       for i from 0
       do (setf (aref result i) (- 1 b))
       finally (return result)))

(defun next (bit-vector)

 (concatenate 'bit-vector bit-vector (bit-complement bit-vector)))

(defun print-bit-vector (bit-vector)

 (loop for b across bit-vector
       do (princ b)
       finally (terpri)))

(defun thue-morse (max)

 (loop repeat (1+ max)
       for value = #*0 then (next value)
       do (print-bit-vector value)))

(thue-morse 6)</lang>

Output:
0
01
0110
01101001
0110100110010110
01101001100101101001011001101001
0110100110010110100101100110100110010110011010010110100110010110

D

Translation of: C

<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

Fortran

Works with: Fortran version 90 and later

<lang fortran>program thue_morse

 implicit none
 logical :: f(32) = .false.
 integer :: n = 1
 do
   write(*,*) f(1:n)
   if (n > size(f)/2) exit  
   f(n+1:2*n) = .not. f(1:n)
   n = n * 2
 end do
 

end program thue_morse</lang>

Output:
  F
  F  T
  F  T  T  F
  F  T  T  F  T  F  F  T
  F  T  T  F  T  F  F  T  T  F  F  T  F  T  T  F
  F  T  T  F  T  F  F  T  T  F  F  T  F  T  T  F  T  F  F  T  F  T  T  F  F  T  T  F  T  F  F  T

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

Kotlin

Translation of: Java

<lang scala>// version 1.1.1 fun thueMorse(n: Int): String {

   val sb0 = StringBuilder("0")
   val sb1 = StringBuilder("1")
   (0 until n).forEach {
       val tmp = sb0.toString()
       sb0.append(sb1)
       sb1.append(tmp)
   }
   return sb0.toString() 

}

fun main(args: Array<String>) {

   for (i in 0..6) println("$i : ${thueMorse(i)}")

} </lang>

Output:
0 : 0
1 : 01
2 : 0110
3 : 01101001
4 : 0110100110010110
5 : 01101001100101101001011001101001
6 : 0110100110010110100101100110100110010110011010010110100110010110

JavaScript

ES6

<lang JavaScript>(() => {

   'use strict';
   // THUE MORSE
   // thueMorse :: Int -> String
   let thueMorse = nCycles => range(1, Math.abs(nCycles))
           .reduce(a => a.concat(a.map(x => 1 - x)), [0])
           .join();


   // GENERIC FUNCTION
   // range :: Int -> Int  -> [Int]
   let range = (m, n) => Array.from({
       length: Math.floor((n - m)) + 1
   }, (_, i) => m + i);


   // TEST
   return thueMorse(6);
   // 0110100110010110100101100110100110010110011010010110100110010110

})(); </lang>

Output:
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 newlisp>(define (Thue-Morse loops)

   (setf TM '(0))
   (println TM)
   (for (i 1 (-- loops))
       (setf tmp TM)
       (replace '0 tmp '_)
       (replace '1 tmp '0)
       (replace '_ tmp '1)
       (setf TM (append TM tmp))
       (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

Phix

<lang Phix>string tm = "0" for i=1 to 8 do

   ?tm
   tm &= sq_sub('0'+'1',tm)

end for</lang>

Output:
"0"
"01"
"0110"
"01101001"
"0110100110010110"
"01101001100101101001011001101001"
"0110100110010110100101100110100110010110011010010110100110010110"
"01101001100101101001011001101001100101100110100101101001100101101001011001101001011010011001011001101001100101101001011001101001"

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

Python: By substitution

<lang 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

Python: By counting set ones in binary representation

<lang Python> >>> def thue_morse_digits(digits): ... return [bin(n).count('1') % 2 for n in range(digits)] ... >>> thue_morse_digits(20) [0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1]

>>> </lang>

Python: By substitution system

<lang Python> >>> def thue_morse_subs(chars): ... ans = '0' ... while len(ans) < chars: ... ans = ans.replace('0', '0_').replace('1', '10').replace('_', '1') ... return ans[:chars] ... >>> thue_morse_subs(20) '01101001100101101001'

>>> </lang>

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}

  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>

uBasic/4tH

<lang>For x = 0 to 6 ' sequence loop

 Print Using "_#";x;": ";             ' print sequence
 For y = 0 To (2^x)-1                 ' element loop
   Print AND(FUNC(_Parity(y)),1);     ' print element
 Next                                 ' next element
 Print                                ' terminate elements line

Next ' next sequence

End

_Parity Param (1) ' parity function

 Local (1)                            ' number of bits set
 b@ = 0                               ' no bits set yet
 Do While a@ # 0                      ' until all bits are counted
   If AND (a@, 1) Then b@ = b@ + 1    ' bit set? increment count
   a@ = SHL(a@, -1)                   ' shift the number
 Loop

Return (b@) ' return number of bits set</lang>

Output:
 0: 0
 1: 01
 2: 0110
 3: 01101001
 4: 0110100110010110
 5: 01101001100101101001011001101001
 6: 0110100110010110100101100110100110010110011010010110100110010110

0 OK, 0:123

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