Merge pull request #179 from jlp765/master

More Rosetta

src/rosetta/factorial.flx

@@ -0,0 +1,26 @@
+val zero = uint256(0);
+val one = uint256(1);
+val two = uint256(2);
+
+val start = uint256(150);
+
+fun fact_recurs (x: uint256): uint256 = {
+  if x > zero perform
+    return x * fact_recurs(x - one);
+  return 1.uint256;
+}
+
+fun fact_loop (x: uint256) : uint256 = {
+  var res = one;
+  for var i in two upto x perform
+    res *= i;
+  return res;
+}
+
+var t1 = time();
+println$ "Recursive: " + str(fact_recurs(start));
+println$ f"Duration: %0.3f sec" (time() - t1);
+t1 = time();
+println$ "Loop:      " + str(fact_loop(start));
+println$ f"Duration: %0.3f sec" (time() - t1);
+

src/rosetta/four_is_magic.flx

@@ -0,0 +1,33 @@
+fun int_name (i: int) = {
+  var ones = list("zero","one","two","three","four","five",
+                  "six","seven","eight","nine","ten","eleven","twelve",
+                  "thirteen","fourteen","fifteen","sixteen","seventeen",
+                  "eighteen","nineteen");
+  var tens = list("","ten","twenty","thirty", "forty", "fifty",
+                  "sixty","seventy","eighty","ninety");
+  var thousands = list("hundred","thousand","million","billion");
+
+  if i < 20 return ones.(i);
+  // 20, 30, .., 90
+  if i % 10 == 0 and i < 100 return tens.(i / 10); 
+  if i < 100 return tens.(i / 10) + " " + int_name(i % 10); 
+
+  var zeros = int(log10(i.double)) / 3;  // number of thousands
+  var factor = 100;
+  if zeros > 0 perform 
+    factor = int(pow(10.0, (3.0 * zeros.double)));
+
+  return int_name(i / factor) + " " + thousands.(zeros) + " " + int_name(i % factor);
+}
+
+fun decode (a:int) : string = {
+  var res = int_name(a);
+  var alen = res.len.int;
+  var alenstr = int_name(alen);
+  if a == 4 
+    return res + " is magic.";
+  return res + " is " + alenstr + ", " + decode(alen); 
+}
+
+for var i in 0 upto 20 perform
+  println$ decode(i);

src/rosetta/fractal_tree.flx

@@ -0,0 +1,34 @@
+val pi: double = 3.1415926535897932384626433832795;
+//val pi: double = 104348.0 / 33215.0;
+val width = 1000.0;
+val height = 1000.0;
+val trunk_len = 400.0;
+val scale_factor = 0.6;
+val start_angle = 1.5 * pi;
+val delta_angle = 0.2 * pi;
+
+val stroke = 30.0;
+val stroke_factor = 0.7;
+val recurs_limit = 1.0;  // try 0.6 for more data points
+
+proc draw_tree (f, x, y, tlen, theta, swidth) = {
+  if tlen >= recurs_limit do
+    var x2 = x + tlen * cos(theta);
+    var y2 = y + tlen * sin(theta);
+    var s = "<line x1='" + x.str + "' y1='" + y.str + "' x2='" + x2.str + "' y2='" + y2.str + "' style='stroke:white;stroke-width:" + swidth.str + "'/>\n";
+    write$ f, s; 
+    draw_tree$ (f, x2, y2, tlen * scale_factor, theta + delta_angle, swidth * stroke_factor);
+    draw_tree$ (f, x2, y2, tlen * scale_factor, theta - delta_angle, swidth * stroke_factor);
+  done
+}
+
+var foutsvg = fopen_output_text("tree.svg");
+
+write$ foutsvg, """<?xml version='1.0' encoding='utf-8' standalone='no'?>
+<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN' 'http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd'>
+<svg width='100%%' height='100%%' version='1.1' xmlns='http://www.w3.org/2000/svg'>
+<rect width="100%" height="100%" fill="black"/>\n""";
+
+draw_tree(foutsvg, 0.5 * width, height, trunk_len, start_angle, stroke);
+write$ foutsvg, "</svg>\n";
+fclose(foutsvg);

src/rosetta/function_composition.flx

@@ -0,0 +1,10 @@
+fun plus_two (a:int) : int => a + 2;
+fun minus_two (a:int) : int => a - 2;
+
+fun compose (f: (), g: ()) (x) => g(f(x));
+
+var plus_minus_two = compose$ (plus_two, minus_two);
+var add_four = compose$ (plus_two, plus_two);
+
+println$ plus_minus_two(10);
+println$ add_four(10);

src/rosetta/humble_numbers.flx

@@ -0,0 +1,103 @@
+val arr_sz = 500000;
+// 50000000 -> 50 digits 450000 -> 28 digits; 95000 -> 18 digits; 43000 -> 15 digits
+val maxdigits = 60;
+
+val zero = uint256(0);
+val one = uint256(1);
+val two = uint256(2);
+val three = uint256(3);
+val five = uint256(5);
+val seven = uint256(7);
+val ten = uint256(10);
+
+fun min4 (a: uint256, b: uint256, c: uint256, d: uint256): uint256 = {
+  var min1 = a;
+  var min2 = c;
+  if b < a perform min1 = b;
+  if d < c perform min2 = d;
+  if min1 <= min2 return min1;
+  return min2;
+}
+
+fun join (v: darray[uint256], delim: string): string = {
+  var res = "";
+  for var ind in 0 upto v.len.int - 2 do
+    res += str(v.ind) + delim;
+  done
+  return (res + delim);
+}
+
+fun humble (n: int) : darray[uint256] = {
+  var res = darray[uint256]();
+  var m = 0;
+  for m in 0 upto n.int + 1 perform 
+    res += zero;
+  set(res, 0, one);
+
+  var next2 = two;
+  var next3 = three;
+  var next5 = five;
+  var next7 = seven;
+  var i = 0;
+  var j = 0;
+  var k = 0;
+  var l = 0;
+  var smallest = zero;
+
+  for m in 1 upto n.int - 1 do
+    smallest = min4(next2, next3, next5, next7);
+    set(res, m, smallest);
+    if smallest == next2 do
+      i += 1;
+      next2 = two * res.i;
+    done
+    if smallest == next3 do
+      j += 1;
+      next3 = three * res.j;
+    done
+    if smallest == next5 do
+      k += 1;
+      next5 = five * res.k;
+    done
+    if smallest == next7 do
+      l += 1;
+      next7 = seven * res.l;
+    done
+  done
+  return res;
+}
+
+var h = humble(arr_sz);
+println$ "The first 50 Humble numbers are:\n" + join(h.(0..49), " ");
+
+var maxused = h.len.int - 1;
+var counts = darray[int]();
+// an extra two -> allows for a partial count followed by a zero count
+for var m in 0 upto maxdigits + 2 perform counts += 0;
+var digits = 1;
+var pow10 = ten;
+
+floop: for m in 0 upto maxused.int do
+  wloop: while true do
+    if h.m >= pow10 do
+      pow10 *= ten;
+      digits += 1;
+    else
+       break wloop;
+    done
+  done
+  if digits <= maxdigits do
+    set(counts, digits, counts.digits + 1);
+  else
+    break floop;
+  done
+done
+
+println$ "Of the first " + maxused.str + " Humble numbers:";
+println$ f"%9i have  1 digit" (counts.1);    
+prntlp: for m in 2 upto maxdigits do
+  // don't display the entry prior to a zero count, as it is incomplete
+  if (m + 2 <= maxdigits) and (counts.(m + 2) == 0) perform break prntlp;
+  //if counts.m == 0 perform break prntlp;
+  println$ f"%9i have %2i digits" (counts.m, m);    
+done

src/rosetta/increment_a_numerical_string.flx

@@ -0,0 +1,3 @@
+println$ 1 + int("12345");         // 12346
+println$ 100 + int("-123E+3");     // -23
+println$ f"%.3f" (10.0 + double("12345.678"));    // 12355.678

src/rosetta/pi.flx

@@ -0,0 +1,71 @@
+// translated from the Pascal version
+// Spigot algorithm
+//
+val n = 1000;
+val nlen = (10 * n) / 3;
+
+var a = darray[int]();
+
+fun one_loop (sz: int) : int = {
+  var x = 0;
+  var res = 0;
+  var rem = 0;
+  // only calc as far as needed
+  // +16 for security digits ~5 decimals
+  var i = (sz * 10) / 3 + 16;
+  if i > nlen do
+    i = nlen;
+  done
+  while i > 0 do
+    x = (10 * a.i) + (res * i);
+    var twoimin1 = 2 * i - 1;
+    res = x / twoimin1;
+    rem = x % twoimin1;
+    set(a,i,rem);  // x mod (2*i-1)
+    i -= 1;
+  done 
+  return res;
+}
+
+proc main () = {
+  var ind = 0;
+  var k = 0;
+  var j = 0;
+  var q = 0;
+  var nines = 0;
+  var predigit = 0;
+
+  for ind in 0 upto nlen do
+    a += 2;
+  done
+
+  for ind in 1 upto nlen do
+    q = one_loop(nlen - ind);
+    set(a,1, q % 10);
+    q = q / 10;
+    if q == 9 do
+      nines += 1;
+    else
+      if q == 10 do
+        print$ str(predigit + 1);
+        for k in 1 upto nines perform
+          print$ "0";
+        predigit = 0;
+        nines = 0;
+      else
+        if ind > 1 perform
+          print$ str(predigit);
+        if ind == 2 perform print$ "."; 
+        predigit = q;
+        if nines != 0 do
+          for k in 1 upto nines perform
+            print$ "9";
+          nines = 0;
+        done
+      done
+    done 
+  done
+  println$ predigit;
+}
+
+main;

src/rosetta/word_frequency.flx

@@ -0,0 +1,50 @@
+// assumes that 135-0.txt file has been downloaded from
+// https://www.gutenberg.org/files/135/135-0.txt 
+//
+
+val in_file = "135-0.txt";
+var data = "";
+var words = strdict[int] ();
+var counts = darray[int * string]();
+var w = "";
+
+proc text_only (s: &string) = {
+  // inplace modification to lower case
+  // where non-text is translated to space
+  for var k in 0uz upto s.len - 1uz do
+    var c: char = tolower((*s).[k]);
+    if isletter(c) or isdigit(c) do
+      store(s,k.int,c);
+    else
+      store(s,k.int,char ' ');
+    done
+  done
+}
+
+var f = fopen_input_text in_file;
+if valid f do 
+  data = load f;
+  fclose f;
+done
+
+text_only(&data);
+
+var i = 0;
+for w in split(data, " ") do
+  if len(w) > 1uz do
+    i = 1 + words.get_dflt(w,0);
+    words.add w i;
+  done
+done
+
+match key,value in words.iterator do
+  counts += value, key;
+done
+
+sort counts;
+
+var j = counts.len - 1uz;
+for var k in j  downto j - 20uz do
+    println$ rjust(counts.k.1.str, 7) + " occurs " + rjust(counts.k.0.str, 6) + " times";
+done
+

src/rosetta/write_float_arrays_to_text_file.flx

@@ -0,0 +1,22 @@
+val fname = "filename.txt";
+val xprecision = 3;
+val yprecision = 5;
+
+var x = list[long](1L, 2L, 3L, 100000000000L);
+var y = unbox (map (fun (i: long) => sqrt(i.double)) x);
+var z = zip2 (x) (y);
+
+var f = fopen_output_text fname;
+if valid f do
+  for sq in z do
+    writeln$ f, (f"%.*g\t%.*g" (xprecision, sq.0.double, yprecision, sq.1));
+  done
+  fclose f;
+done
+
+var finp = fopen_input_text fname;
+if valid finp do
+  println$ (load finp);
+  fclose finp;
+done
+