Thue-Morse: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations.)
Line 477: Line 477:
===using functions===
===using functions===
Programming note: &nbsp; ''pop count'' &nbsp; (or &nbsp; ''weight'') &nbsp; is the number of &nbsp; <b>1</b>'s &nbsp; bits in the binary representation of a number.
Programming note: &nbsp; ''pop count'' &nbsp; (or &nbsp; ''weight'') &nbsp; is the number of &nbsp; <b>1</b>'s &nbsp; bits in the binary representation of a number.
<lang rexx>/*REXX program generates & displays the Thue─Morse sequence up to the Nth item*/
<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.*/
parse arg N . /*obtain the optional argument from CL.*/
if N=='' | N=="," then N=80 /*Not specified? Then use the default.*/
if N=='' | N=="," then N=80 /*Not specified? Then use the default.*/
$= /*the Thue─Morse sequence (so far). */
$= /*the Thue─Morse sequence (so far). */
do j=0 to N /*generate sequence up to the Nth item.*/
do j=0 to N /*generate sequence up to the Nth item.*/
$=$ || $weight(j)//2 /*append the item to the Thue─Morse seq*/
$=$ || $weight(j) // 2 /*append the item to the Thue─Morse seq*/
end /*j*/
end /*j*/
say $
say $
exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
$pop: return length(space(translate(arg(1),,0),0)) /*count 1's in number.*/
$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>
$weight: return $pop( x2b( d2x( arg(1) ) ) ) /*dec──►bin, pop count*/</lang>
'''output''' &nbsp; when using the default input:
'''output''' &nbsp; when using the default input:
<pre>
<pre>
Line 495: Line 495:


===using in-line code===
===using in-line code===
<lang rexx>/*REXX program generates & displays the Thue─Morse sequence up to the Nth item*/
<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.*/
parse arg N . /*obtain the optional argument from CL.*/
if N=='' | N=="," then N=80 /*Not specified? Then use the default.*/
if N=='' | N=="," then N=80 /*Not specified? Then use the default.*/
$= /*the Thue─Morse sequence (so far). */
$= /*the Thue─Morse sequence (so far). */
do j=0 to n /*generate sequence up to the Nth item.*/
do j=0 to N /*generate sequence up to the Nth item.*/
$=$ || length(space(translate(x2b(d2x(j)),,0),0))//2 /*append it to $.*/
$=$ || length( space( translate( x2b( d2x(j) ), , 0), 0) ) // 2 /*append to $.*/
end /*j*/
end /*j*/
say $ /*stick a fork in it, we're all done. */</lang>
say $ /*stick a fork in it, we're all done. */</lang>
'''output''' &nbsp; is identical to the 1<sup>st</sup> REXX version. <br>
'''output''' &nbsp; is identical to the 1<sup>st</sup> REXX version. <br>


Line 509: Line 509:


Because of this, the displaying of the output lacks the granularity of the first two REXX versions.
Because of this, the displaying of the output lacks the granularity of the first two REXX versions.
<lang rexx>/*REXX program generates & displays the Thue─Morse sequence up to the Nth item*/
<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.*/
parse arg N . /*obtain the optional argument from CL.*/
if N=='' | N=="," then N=6 /*Not specified? Then use the default.*/
if N=='' | N=="," then N=6 /*Not specified? Then use the default.*/
$=0 /*the Thue─Morse sequence (so far). */
$=0 /*the Thue─Morse sequence (so far). */
do j=1 for N /*generate sequence up to the Nth item.*/
do j=1 for N /*generate sequence up to the Nth item.*/
$=$ || translate($, 10, 01) /*append $'s complement to $. */
$=$ || translate($, 10, 01) /*append $'s complement to $ string.*/
end /*j*/
end /*j*/
say $ /*stick a fork in it, we're all done. */</lang>
say $ /*stick a fork in it, we're all done. */</lang>
'''output''' &nbsp; when using the default input:
'''output''' &nbsp; when using the default input:
<pre>
<pre>

Revision as of 15:22, 26 April 2016

Task
Thue-Morse
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 #
  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>

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

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

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>

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