Another update from ingydotnet^djgoku

Task/Stern-Brocot-sequence/Ada/stern-brocot-sequence.ada

@@ -0,0 +1,94 @@
+with Ada.Text_IO, Ada.Containers.Vectors;
+
+procedure Sequence is
+
+   package Vectors is new
+     Ada.Containers.Vectors(Index_Type => Positive, Element_Type => Positive);
+   use type Vectors.Vector;
+
+   type Sequence is record
+      List: Vectors.Vector;
+      Index: Positive;
+      -- This implements some form of "lazy evaluation":
+      --  + List holds the elements computed, so far, it is extended
+      --    if the user tries to "Get" an element not yet computed;
+      --  + Index is the location of the next element under consideration
+   end record;
+
+   function Initialize return Sequence is
+      (List => (Vectors.Empty_Vector & 1 & 1), Index => 2);
+
+   function Get(Seq: in out Sequence; Location: Positive) return Positive is
+      -- returns the Location'th element of the sequence
+      -- extends Seq.List (and then increases Seq.Index) if neccessary
+      That: Positive := Seq.List.Element(Seq.Index);
+      This: Positive := That + Seq.List.Element(Seq.Index-1);
+   begin
+      while Seq.List.Last_Index < Location loop
+	 Seq.List := Seq.List & This & That;
+	 Seq.Index := Seq.Index + 1;
+      end loop;
+      return Seq.List.Element(Location);
+   end Get;
+
+   S: Sequence := Initialize;
+   J: Positive;
+
+   use Ada.Text_IO;
+
+begin
+   -- show first fifteen members
+   Put("First 15:");
+   for I in 1 .. 15 loop
+      Put(Integer'Image(Get(S, I)));
+   end loop;
+   New_Line;
+
+   -- show the index where 1, 2, 3, ... first appear in the sequence
+   for I in 1 .. 10 loop
+      J := 1;
+      while Get(S, J) /= I loop
+	 J := J + 1;
+      end loop;
+      Put("First" & Integer'Image(I) & " at" & Integer'Image(J) & ";  ");
+      if I mod 4 = 0 then
+	 New_Line; -- otherwise, the output gets a bit too ugly
+      end if;
+   end loop;
+
+   -- show the index where 100 first appears in the sequence
+   J := 1;
+   while Get(S, J) /= 100 loop
+      J := J + 1;
+   end loop;
+   Put_Line("First 100 at" & Integer'Image(J) & ".");
+
+   -- check GCDs
+   declare
+      function GCD (A, B : Integer) return Integer is
+	 M : Integer := A;
+	 N : Integer := B;
+	 T : Integer;
+      begin
+	 while N /= 0 loop
+	    T := M;
+	    M := N;
+	    N := T mod N;
+	 end loop;
+	 return M;
+      end GCD;
+
+      A, B: Positive;
+   begin
+      for I in 1 .. 999 loop
+	 A := Get(S, I);
+	 B := Get(S, I+1);
+	 if GCD(A, B) /= 1 then
+	    raise Constraint_Error;
+	 end if;
+      end loop;
+      Put_Line("Correct: The first 999 consecutive pairs are relative prime!");
+   exception
+      when Constraint_Error => Put_Line("Some GCD > 1; this is wrong!!!") ;
+   end;
+end Sequence;

Task/Stern-Brocot-sequence/C++/stern-brocot-sequence.cpp

@@ -0,0 +1,50 @@
+#include <iostream>
+#include <iomanip>
+#include <algorithm>
+#include <vector>
+
+unsigned gcd( unsigned i, unsigned j ) {
+    return i ? i < j ? gcd( j % i, i ) : gcd( i % j, j ) : j;
+}
+void createSequence( std::vector<unsigned>& seq, int c ) {
+    if( 1500 == seq.size() ) return;
+    unsigned t = seq.at( c ) + seq.at( c + 1 );
+    seq.push_back( t );
+    seq.push_back( seq.at( c + 1 ) );
+    createSequence( seq, c + 1 );
+}
+int main( int argc, char* argv[] ) {
+    std::vector<unsigned> seq( 2, 1 );
+    createSequence( seq, 0 );
+
+    std::cout << "First fifteen members of the sequence:\n    ";
+    for( unsigned x = 0; x < 15; x++ ) {
+        std::cout << seq[x] << " ";
+    }
+
+    std::cout << "\n\n";
+    for( unsigned x = 1; x < 11; x++ ) {
+        std::vector<unsigned>::iterator i = std::find( seq.begin(), seq.end(), x );
+        if( i != seq.end() ) {
+            std::cout << std::setw( 3 ) << x << " is at pos. #" << 1 + distance( seq.begin(), i ) << "\n";
+        }
+    }
+
+    std::cout << "\n";
+    std::vector<unsigned>::iterator i = std::find( seq.begin(), seq.end(), 100 );
+    if( i != seq.end() ) {
+        std::cout << 100 << " is at pos. #" << 1 + distance( seq.begin(), i ) << "\n";
+    }
+
+    std::cout << "\n";
+    unsigned g;
+    bool f = false;
+    for( int x = 0, y = 1; x < 1000; x++, y++ ) {
+        g =  gcd( seq[x], seq[y] );
+	if( g != 1 ) f = true;
+        std::cout << std::setw( 4 ) << x + 1 << ": GCD (" << seq[x] << ", "
+                  << seq[y] << ") = " << g << ( g != 1 ? " <-- ERROR\n" : "\n" );
+    }
+    std::cout << "\n" << ( f ? "THERE WERE ERRORS --- NOT ALL GCDs ARE '1'!" : "CORRECT: ALL GCDs ARE '1'!" ) << "\n\n";
+    return 0;
+}

Task/Stern-Brocot-sequence/Perl/stern-brocot-sequence-2.pl

@@ -0,0 +1,20 @@
+use List::Util qw/first/;
+use ntheory qw/gcd vecsum/;
+
+sub stern_diatomic {
+  my ($p,$q,$i) = (0,1,shift);
+  while ($i) {
+    if ($i & 1) { $p += $q; } else { $q += $p; }
+    $i >>= 1;
+  }
+  $p;
+}
+
+my @s = map { stern_diatomic($_) } 1..15;
+print "First fifteen: [@s]\n";
+@s = map { my $n=$_; first { stern_diatomic($_) == $n } 1..10000 } 1..10;
+print "Index of 1-10 first occurrence: [@s]\n";
+print "Index of 100 first occurrence: ", (first { stern_diatomic($_) == 100 } 1..10000), "\n";
+print "The first 999 consecutive pairs are ",
+ (vecsum( map { gcd(stern_diatomic($_),stern_diatomic($_+1)) } 1..999 ) == 999)
+ ? "all coprime.\n" : "NOT all coprime!\n";

Task/Stern-Brocot-sequence/REXX/stern-brocot-sequence.rexx

@@ -1,43 +1,43 @@
-/*REXX pgm gens/shows Stern-Brocot sequence, finds 1-based indices, GCDs*/
-parse arg N idx fix chk .              /*get optional argument from C.L.*/
-if   N=='' |   N==','  then   N=  15   /*use the default for    N ?     */
-if idx=='' | idx==','  then idx=  10   /* "   "     "     "   idx ?     */
-if fix=='' | fix==','  then fix= 100   /* "   "     "     "   fix ?     */
-if chk=='' | chk==','  then chk=1000   /* "   "     "     "   chk ?     */
-                                       /*═══════════════════════════════*/
-say center('the first'  N  'numbers in the Stern-Brocot sequence', 70,'═')
-a=Stern_Brocot(N)                      /*invoke function to generate seq*/
-say a                                  /*display sequence to terminal.  */
-                                       /*═══════════════════════════════*/
-say center('the 1-based index for the first'  idx  "integers",  70, '═')
-a=Stern_Brocot(-idx)                   /*invoke function to generate seq*/
+/*REXX program gens/shows Stern─Brocot sequence, finds 1─based indices, GCDs. */
+parse arg N idx fix chk .              /*get optional arguments from the C.L. */
+if   N=='' |   N==','  then   N=  15   /* N  defined?   Then use the default. */
+if idx=='' | idx==','  then idx=  10   /*IDX    "         "   "   "     "     */
+if fix=='' | fix==','  then fix= 100   /*FIX    "         "   "   "     "     */
+if chk=='' | chk==','  then chk=1000   /*CHK    "         "   "   "     "     */
+
+say center('the first'   N   'numbers in the Stern─Brocot sequence', 70, '═')
+a=Stern_Brocot(N)                      /*invoke function to generate sequence.*/
+say a                                  /*display the sequence to the terminal.*/
+
+say;   say center('the 1-based index for the first'    idx    "integers",70,'═')
+a=Stern_Brocot(-idx)                   /*invoke function to generate sequence.*/
        do i=1  for idx
-       say 'for '  right(i,length(idx))",  the index is: "    wordpos(i,a)
+       say 'for '   right(i,length(idx))",  the index is: "     wordpos(i,a)
        end   /*i*/
-                                       /*═══════════════════════════════*/
-say center('the 1-based index for'  fix,  70, '═')
-a=Stern_Brocot(-fix)                   /*invoke function to generate seq*/
-say 'for '  fix",  the index is: "   wordpos(fix,a)
-                                       /*═══════════════════════════════*/
-say center('checking if all two consecutive members have a GCD=1', 70,'═')
-a=Stern_Brocot(chk)                    /*invoke function to generate seq*/
+
+say;   say center('the 1-based index for'   fix,70,'═')
+a=Stern_Brocot(-fix)                   /*invoke function to generate sequence.*/
+say 'for '   fix",  the index is: "    wordpos(fix, a)
+
+say;   say center('checking if all two consecutive members have a GCD=1',70,'═')
+a=Stern_Brocot(chk)                    /*invoke function to generate sequence.*/
        do c=1  for chk-1;       if gcd(subword(a,c,2))==1  then iterate
-       say 'GCD check failed at member'  c".";  exit 13
+       say 'GCD check failed at member'   c".";            exit 13
        end   /*c*/
-say '───── All '    chk    " two consecutive members have a GCD of unity."
-exit                                   /*stick a fork in it, we're done.*/
-/*──────────────────────────────────GCD subroutine──────────────────────*/
-gcd: procedure; $=;   do i=1  for arg();   $=$ arg(i);  end   /*arg list*/
+say '───── All '     chk     " two consecutive members have a GCD of unity."
+exit                                   /*stick a fork in it,  we're all done. */
+/*────────────────────────────────────────────────────────────────────────────*/
+gcd: procedure; $=;        do i=1  for arg();   $=$ arg(i);  end    /*arg list*/
 parse var $ x z .;  if x=0  then x=z            /*handle special 0 case.*/
 x=abs(x)
-          do j=2  to words($);  y=abs(word($,j));  if y=0  then iterate
-            do  until _==0; _=x//y; x=y; y=_; end     /*◄──heavy lifting*/
-          end   /*j*/
+         do j=2  to words($);  y=abs(word($,j));  if y=0  then iterate
+           do  until y==0; parse value x//y y with y x; end /*◄──heavy lifting*/
+         end   /*j*/
 return x
-/*──────────────────────────────────STERN_BROCOT subroutine.────────────*/
-Stern_Brocot:  parse arg h 1 f;   if h<0  then h=1e9; else f=0;   f=abs(f)
-$=1 1
-       do k=2  until  words($)>=h;   _=word($,k);    $=$ (_+word($,k-1)) _
+/*────────────────────────────────────────────────────────────────────────────*/
+Stern_Brocot:  parse arg h 1 f;  $=1 1;           if h<0  then h=1e9
+                                                          else f=0;     f=abs(f)
+       do k=2  until  words($)>=h;   _=word($,k);         $=$ (_+word($,k-1)) _
        if f==0  then iterate;        if wordpos(f,$)\==0  then leave
        end   /*until*/
 

Task/Stern-Brocot-sequence/Tcl/stern-brocot-sequence.tcl

@@ -0,0 +1,104 @@
+#!/usr/bin/env tclsh
+#
+
+package require generator   ;# from tcllib
+
+namespace eval stern-brocot {
+    proc generate {{count 100}} {
+        set seq {1 1}
+        set n 0
+        while {[llength $seq] < $count} {
+            lassign [lrange $seq $n $n+1] a b
+            lappend seq [expr {$a + $b}] $b
+            incr n
+        }
+        return $seq
+    }
+
+    proc genr {} {
+        yield [info coroutine]
+        set seq {1 1}
+        while {1} {
+            set seq [lassign $seq a]
+            set b [lindex $seq 0]
+            set c [expr {$a + $b}]
+            lappend seq $c $b
+            yield $a
+        }
+    }
+
+    proc Step {a b args} {
+        set c [expr {$a + $b}]
+        list $a [list $b {*}$args $c $b]
+    }
+
+    generator define gen {} {
+        set cmd [list 1 1]
+        while {1} {
+            lassign [Step {*}$cmd] a cmd
+            generator yield $a
+        }
+    }
+
+    namespace export {[a-z]*}
+    namespace ensemble create
+}
+
+interp alias {} sb {} stern-brocot
+
+# a simple adaptation of gcd from http://wiki.tcl.tk/2891
+proc coprime {a args} {
+    set gcd $a
+    foreach arg $args {
+        while {$arg != 0} {
+            set t $arg
+            set arg [expr {$gcd % $arg}]
+            set gcd $t
+            if {$gcd == 1} {return true}
+        }
+    }
+    return false
+}
+
+proc main {} {
+
+    puts "#1. First 15 members of the Stern-Brocot sequence:"
+    puts \t[generator to list [generator take 16 [sb gen]]]
+
+    puts "#2. First occurrences of 1 through 10:"
+    set first {}
+    set got 0
+    set i 0
+    generator foreach x [sb gen] {
+        incr i
+        if {$x>10} continue
+        if {[dict exists $first $x]} continue
+        dict set first $x $i
+        if {[incr got] >= 10} break
+    }
+    foreach {a b} [lsort -integer -stride 2 $first] {
+        puts "\tFirst $a at $b"
+    }
+
+    puts "#3. First occurrence of 100:"
+    set i 0
+    generator foreach x [sb gen] {
+        incr i
+        if {$x eq 100} break
+    }
+    puts "\tFirst $x at $i"
+
+    puts "#4. Check first 1k elements for common divisors:"
+    set prev [expr {2*3*5*7*11*13*17*19+1}] ;# a handy prime
+    set i 0
+    generator foreach x [sb gen] {
+        if {[incr i] >= 1000} break
+        if {![coprime $x $prev]} {
+            error "Element $i, $x is not coprime with $prev!"
+        }
+        set prev $x
+    }
+    puts "\tFirst $i elements are all pairwise coprime"
+}
+
+main