September Morn Update

Task/Knuths-algorithm-S/00META.yaml

@@ -0,0 +1 @@
+--- {}

Task/Knuths-algorithm-S/Elena/knuths-algorithm-s.elena

@@ -1,49 +1,52 @@
-import system'dynamic.
-import extensions.
-import system'routines.
-import system'collections.
+import system'dynamic;
+import extensions;
+import system'routines;
+import system'collections;
 
 extension algorithmOp
 {
-    s_of_n
-    [
-        var counter := Integer new.
-        var n := self.
+    s_of_n()
+    {
+        var counter := new Integer();
+        var n := self;
 
-        ^ ArrayList new; mixInto:
+        ^ new ArrayList().mixInto(
+        {
+            eval(i)
             {
-                eval : i
-                [
-                    counter append:1.
+                counter.append:1;
 
-                    if (self length < n)
-                        [ self append:i ];
-                        [
-                            if(randomGenerator eval:counter < n)
-                                [ self[randomGenerator eval:n] := i ].
-                        ].
+                if (__target.Length < n)
+                {
+                    __target.append:i
+                }
+                else
+                {
+                    if(randomGenerator.nextInt:counter < n)
+                        { __target[randomGenerator.nextInt:n] := i }
+                };
 
-                    ^ self array
-                ]
-            }.
-    ]
+                ^ __target.Value
+            }
+        })
+    }
 }
 
-program =
-[
-    var bin := Array new:10; populate(:n)( Integer new ).
-    0 till:10000 do(:trial)
-    [
-        var s_of_n := 3 s_of_n.
+public program()
+{
+    var bin := Array.allocate(10).populate:(n => new Integer());
+    for(int trial := 0, trial < 10000, trial += 1)
+    {
+        var s_of_n := 3.s_of_n();
 
-        0 till:10 do(:n)
-        [
-            var sample := s_of_n eval:n.
+        for(int n := 0, n < 10, n += 1)
+        {
+            var sample := s_of_n.eval:n;
 
             if (n == 9)
-                [ sample forEach(:i) [ bin[i] append:1 ] ]
-        ]
-    ].
+                { sample.forEach:(i){ bin[i].append:1 } }
+        }
+    };
 
-    console printLine:bin; readChar.
-].
+    console.printLine:bin.readChar()
+}

Task/Knuths-algorithm-S/Haskell/knuths-algorithm-s.hs

@@ -0,0 +1,48 @@
+import Control.Monad.Random
+import Control.Monad.State
+import qualified Data.Map as M
+import System.Random
+
+-- s_of_n_creator :: Int -> a -> RandT StdGen (State (Int, [a])) [a]
+s_of_n_creator :: Int -> a -> StateT (Int, [a]) (Rand StdGen) [a]
+s_of_n_creator n v = do
+  (i, vs) <- get
+  let i' = i + 1
+  if i' <= n
+    then do
+      let vs' = v : vs
+      put (i', vs')
+      pure vs'
+    else do
+      j <- getRandomR (1, i')
+      if j > n
+        then do
+          put (i', vs)
+          pure vs
+        else do
+          k <- getRandomR (0, n - 1)
+          let (f, (_ : b)) = splitAt k vs
+              vs' = v : f ++ b
+          put (i', vs')
+          pure vs'
+
+sample :: Int -> Rand StdGen [Int]
+sample n =
+  let s_of_n = s_of_n_creator n
+   in snd <$> execStateT (traverse s_of_n [0 .. 9 :: Int]) (0, [])
+
+incEach :: (Ord a, Num b) => M.Map a b -> [a] -> M.Map a b
+incEach m ks = foldl (\m' k -> M.insertWith (+) k 1 m') m ks
+
+sampleInc :: Int -> M.Map Int Double -> Rand StdGen (M.Map Int Double)
+sampleInc n m = do
+  s <- sample n
+  pure $ incEach m s
+
+main :: IO ()
+main = do
+  let counts = M.empty :: M.Map Int Double
+      n = 100000
+  gen <- getStdGen
+  counts <- evalRandIO $ foldM (\c _ -> sampleInc 3 c) M.empty [1 .. n]
+  print (fmap (/ n) counts)