Just another update

Task/Average-loop-length/D/average-loop-length.d

@@ -1,7 +1,7 @@
-import std.stdio, std.random, std.math, std.algorithm, std.range;
+import std.stdio, std.random, std.math, std.algorithm, std.range, std.format;
 
-real analytical(in int n) /*pure nothrow*/ {
-    enum aux = (int k)=> reduce!q{a * b}(1.0L, iota(n - k + 1, n + 1));
+real analytical(in int n) pure nothrow @safe /*@nogc*/ {
+    enum aux = (int k) => reduce!q{a * b}(1.0L, iota(n - k + 1, n + 1));
     return iota(1, n + 1)
            .map!(k => (aux(k) * k ^^ 2) / (real(n) ^^ (k + 1)))
            .sum;

Task/Average-loop-length/Haskell/average-loop-length.hs

@@ -0,0 +1,54 @@
+import System.Random
+import qualified Data.Set as S
+import Text.Printf
+
+findRep :: (Random a, Integral a, RandomGen b) => a -> b -> (a, b)
+findRep n gen = findRep' (S.singleton 1) 1 gen
+    where
+      findRep' seen len gen'
+          | S.member fx seen = (len, gen'')
+          | otherwise        = findRep' (S.insert fx seen) (len + 1) gen''
+          where
+            (fx, gen'') = randomR (1, n) gen'
+
+statistical :: (Integral a, Random b, Integral b, RandomGen c, Fractional d) =>
+               a -> b -> c -> (d, c)
+statistical samples size gen =
+    let (total, gen') = sar samples gen 0
+    in ((fromIntegral total) / (fromIntegral samples), gen')
+    where
+      sar 0        gen' acc = (acc, gen')
+      sar samples' gen' acc =
+          let (len, gen'') = findRep size gen'
+          in sar (samples' - 1) gen'' (acc + len)
+
+factorial :: (Integral a) => a -> a
+factorial n = foldl (*) 1 [1..n]
+
+analytical :: (Integral a, Fractional b) => a -> b
+analytical n = sum [fromIntegral num /
+                    fromIntegral (factorial (n - i)) /
+                    fromIntegral (n ^ i) |
+                    i <- [1..n]]
+    where num = factorial n
+
+test :: (Integral a, Random b, Integral b, PrintfArg b, RandomGen c) =>
+        a -> [b] -> c -> IO c
+test _       []     gen = return gen
+test samples (x:xs) gen = do
+  let (st, gen') = statistical samples x gen
+      an         = analytical x
+      err        = abs (st - an) / st * 100.0
+      str        = printf "%3d  %9.4f  %12.4f  (%6.2f%%)\n"
+                   x (st :: Float) (an :: Float) (err :: Float)
+  putStr str
+  test samples xs gen'
+
+main :: IO ()
+main = do
+  putStrLn " N    average    analytical    (error)"
+  putStrLn "===  =========  ============  ========="
+  let samples = 10000 :: Integer
+      range   = [1..20] :: [Integer]
+  _ <- test samples range $ mkStdGen 0
+  return ()

Task/Average-loop-length/PicoLisp/average-loop-length.l

@@ -0,0 +1,42 @@
+(scl 4)
+(seed (in "/dev/urandom" (rd 8)))
+
+(de fact (N)
+   (if (=0 N) 1 (apply * (range 1 N))) )
+
+(de analytical (N)
+   (sum
+      '((I)
+         (/
+            (* (fact N) 1.0)
+            (** N I)
+            (fact (- N I)) ) )
+      (range 1 N) ) )
+
+(de testing (N)
+   (let (C 0  N (dec N)  X 0  B 0  I 1000000)
+      (do I
+         (zero B)
+         (one X)
+         (while (=0 (& B X))
+            (inc 'C)
+            (setq
+               B (| B X)
+               X (** 2 (rand 0 N)) ) ) )
+      (*/ C 1.0 I) ) )
+
+(let F (2 8 8 6)
+   (tab F "N" "Avg" "Exp" "Diff")
+   (for I 20
+      (let (A (testing I)  B (analytical I))
+         (tab F
+            I
+            (round A 4)
+            (round B 4)
+            (round
+               (*
+                  (abs (- (*/ A 1.0 B) 1.0))
+                  100 )
+               2 ) ) ) ) )
+
+(bye)

Task/Average-loop-length/REXX/average-loop-length.rexx

@@ -1,4 +1,4 @@
-/*REXX pgmm computes avg loop length mapping a random field 1..N to 1..N*/
+/*REXX pgm computes avg loop length mapping a random field 1..N  to 1..N*/
 parse arg runs tests seed .
 if  runs ==','  |   runs ==''  then runs  =      40     /*num of runs.  */
 if tests ==','  |  tests ==''  then tests = 1000000     /*num of trials.*/

Task/Average-loop-length/Seed7/average-loop-length.seed7

@@ -0,0 +1,64 @@
+$ include "seed7_05.s7i";
+  include "float.s7i";
+
+const integer: TESTS is 1000000;
+
+const func float: factorial (in integer: number) is func
+  result
+    var float: factorial is 1.0;
+  local
+    var integer: i is 0;
+  begin
+    for i range 2 to number do
+      factorial *:= flt(i);
+    end for;
+  end func;
+
+const func float: analytical (in integer: number) is func
+  result
+    var float: sum is 0.0;
+  local
+    var integer: i is 0;
+  begin
+    for i range 1 to number do
+      sum +:= factorial(number) / factorial(number - i) / flt(number)**i;
+    end for;
+  end func;
+
+const func float: experimental (in integer: number) is func
+  result
+    var float: experimental is 0.0;
+  local
+    var integer: run is 0;
+    var set of integer: seen is EMPTY_SET;
+    var integer: current is 1;
+    var integer: count is 0;
+  begin
+    for run range 1 to TESTS do
+      current := 1;
+      seen := EMPTY_SET;
+      while current not in seen do
+        incr(count);
+        incl(seen, current);
+        current := rand(1, number);
+      end while;
+    end for;
+    experimental := flt(count) / flt(TESTS);
+  end func;
+
+const proc: main is func
+  local
+    var integer: number is 0;
+    var float: analytical is 0.0;
+    var float: experimental is 0.0;
+    var float: err is 0.0;
+  begin
+    writeln(" N  avg    calc   %diff");
+    for number range 1 to 20 do
+      analytical := analytical(number);
+      experimental := experimental(number);
+      err := abs(experimental - analytical) / analytical * 100.0;
+      writeln(number lpad 2 <& experimental digits 4 lpad 7 <&
+              analytical digits 4 lpad 7 <& err digits 3 lpad 7);
+    end for;
+  end func;