September 2017 Update

Task/Happy-numbers/8th/happy-numbers.8th

@@ -0,0 +1,29 @@
+: until!  "not while!" eval i;
+
+with: w
+with: n
+
+: sumsqd  \ n -- n
+    0 swap repeat
+        0; 10 /mod -rot sqr + swap
+    again ;
+
+: cycle \ n xt -- n
+    >r
+    dup r@ exec  \ -- tortoise, hare
+    repeat
+        swap r@ exec
+        swap r@ exec r@ exec
+    2dup = until!
+    rdrop drop ;
+
+: happy?  ' sumsqd cycle 1 = ;
+
+: .happy \ n --
+    1 repeat
+        dup happy? if  dup . space  swap 1- swap  then 1+
+    over 0 > while!
+    2drop cr ;
+
+;with
+;with

Task/Happy-numbers/AppleScript/happy-numbers-2.applescript

@@ -1,3 +1,5 @@
+-- HAPPY NUMBERS --------------------------------------------------------------
+
 -- isHappy :: Int -> Bool
 on isHappy(n)
 
@@ -9,64 +11,62 @@ on isHappy(n)
 
             -- digitSquared :: Int -> Int -> Int
             script digitSquared
-                on lambda(a, x)
+                on |λ|(a, x)
                     (a + (x as integer) ^ 2) as integer
-                end lambda
+                end |λ|
             end script
 
-            on lambda(n)
+            on |λ|(n)
                 foldl(digitSquared, 0, splitOn("", n as string))
-            end lambda
+            end |λ|
         end script
 
         -- [Int] -> Int -> Bool
-        on lambda(s, n)
+        on |λ|(s, n)
             if n = 1 then
                 true
             else
                 if s contains n then
                     false
                 else
-                    lambda(s & n, lambda(n) of sumOfSquaredDigits)
+                    |λ|(s & n, |λ|(n) of sumOfSquaredDigits)
                 end if
             end if
-        end lambda
+        end |λ|
     end script
 
-    endsInOne's lambda({}, n)
+    endsInOne's |λ|({}, n)
 end isHappy
 
-
--- TEST
+-- TEST -----------------------------------------------------------------------
 on run
 
     -- seriesLength :: {n:Int, xs:[Int]} -> Bool
     script seriesLength
         property target : 8
 
-        on lambda(rec)
+        on |λ|(rec)
             length of xs of rec = target of seriesLength
-        end lambda
+        end |λ|
     end script
 
     -- succTest :: {n:Int, xs:[Int]} -> {n:Int, xs:[Int]}
     script succTest
-        on lambda(rec)
-            set xs to xs of rec
-            set n to n of rec
+        on |λ|(rec)
+            tell rec to set {xs, n} to {its xs, its n}
 
             script testResult
-                on lambda(x)
+                on |λ|(x)
                     if isHappy(x) then
                         xs & x
                     else
                         xs
                     end if
-                end lambda
+                end |λ|
             end script
 
-            {n:n + 1, xs:testResult's lambda(n)}
-        end lambda
+            {n:n + 1, xs:testResult's |λ|(n)}
+        end |λ|
     end script
 
     xs of |until|(seriesLength, succTest, {n:1, xs:{}})
@@ -75,8 +75,7 @@ on run
 end run
 
 
-
--- GENERIC FUNCTIONS
+-- GENERIC FUNCTIONS ----------------------------------------------------------
 
 -- foldl :: (a -> b -> a) -> a -> [b] -> a
 on foldl(f, startValue, xs)
@@ -84,31 +83,23 @@ on foldl(f, startValue, xs)
         set v to startValue
         set lng to length of xs
         repeat with i from 1 to lng
-            set v to lambda(v, item i of xs, i, xs)
+            set v to |λ|(v, item i of xs, i, xs)
         end repeat
         return v
     end tell
 end foldl
 
--- until :: (a -> Bool) -> (a -> a) -> a -> a
-on |until|(p, f, x)
-    set mp to mReturn(p)
-    set mf to mReturn(f)
-
-    script
-        property p : mp's lambda
-        property f : mf's lambda
-
-        on lambda(v)
-            repeat until p(v)
-                set v to f(v)
-            end repeat
-            return v
-        end lambda
-    end script
-
-    result's lambda(x)
-end |until|
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
 
 -- splitOn :: Text -> Text -> [Text]
 on splitOn(strDelim, strMain)
@@ -118,14 +109,15 @@ on splitOn(strDelim, strMain)
     return xs
 end splitOn
 
--- Lift 2nd class handler function into 1st class script wrapper
--- mReturn :: Handler -> Script
-on mReturn(f)
-    if class of f is script then
-        f
-    else
-        script
-            property lambda : f
-        end script
-    end if
-end mReturn
+-- until :: (a -> Bool) -> (a -> a) -> a -> a
+on |until|(p, f, x)
+    set mp to mReturn(p)
+    set v to x
+
+    tell mReturn(f)
+        repeat until mp's |λ|(v)
+            set v to |λ|(v)
+        end repeat
+    end tell
+    return v
+end |until|

Task/Happy-numbers/Dc/happy-numbers.dc

@@ -0,0 +1,4 @@
+[lcI~rscd*+lc0<H]sH
+[0rsclHxd4<h]sh
+[lIp]s_
+0sI[lI1+dsIlhx2>_z8>s]dssx

Task/Happy-numbers/Forth/happy-numbers-2.fth

@@ -0,0 +1,10 @@
+CREATE HAPPINESS 0 C, 1 C, 0 C, 0 C, 0 C, 0 C, 0 C, 1 C, 0 C, 0 C,
+: next ( n -- n')
+   0 swap BEGIN dup WHILE 10 /mod >r  dup * +  r> REPEAT drop ;
+: happy? ( n -- t|f)
+   BEGIN dup 10 >= WHILE next REPEAT  chars HAPPINESS + C@ 0<> ;
+: happy-numbers ( n --)  >r 0
+   BEGIN r@ WHILE
+     BEGIN 1+ dup happy? UNTIL dup . r> 1- >r
+   REPEAT r> drop drop ;
+8 happy-numbers

Task/Happy-numbers/Forth/happy-numbers-3.fth

@@ -0,0 +1,5 @@
+: happy-number ( n -- n')  \ produce the nth happy number
+   >r 0  BEGIN r@ WHILE
+     BEGIN 1+ dup happy? UNTIL  r> 1- >r
+   REPEAT r> drop ;
+1000000 happy-number .  \ 7105849

Task/Happy-numbers/Haskell/happy-numbers-1.hs

@@ -3,9 +3,11 @@ import Data.Set (member, insert, empty)
 
 isHappy :: Integer -> Bool
 isHappy = p empty
-  where p _ 1 = True
-        p s n | n `member` s = False
-              | otherwise  = p (insert n s) (f n)
-        f = sum . map ((^2) . toInteger . digitToInt) . show
+  where
+    p _ 1 = True
+    p s n
+      | n `member` s = False
+      | otherwise = p (insert n s) (f n)
+    f = sum . (((^ 2) . toInteger . digitToInt) <$>) . show
 
-main = mapM_ print $ take 8 $ filter isHappy [1..]
+main = mapM_ print $ take 8 $ filter isHappy [1 ..]

Task/Happy-numbers/Haskell/happy-numbers-2.hs

@@ -1,10 +1,18 @@
 import Data.Array
 
-happy x	= if xx <= 150 then seen!xx else happy xx where
-	xx = dsum x
-	seen :: Array Int Bool
-	seen = listArray (1,150) $ True:False:False:False:(map happy [5..150])
-	dsum n	| n < 10 = n * n
-		| otherwise = let (q,r) = n `divMod` 10 in r*r + dsum q
+happy x =
+  if xx <= 150
+    then seen ! xx
+    else happy xx
+  where
+    xx = dsum x
+    seen :: Array Int Bool
+    seen =
+      listArray (1, 150) $ True : False : False : False : (happy <$> [5 .. 150])
+    dsum n
+      | n < 10 = n * n
+      | otherwise =
+        let (q, r) = n `divMod` 10
+        in r * r + dsum q
 
-main = print $ sum $ take 10000 $ filter happy [1..]
+main = print $ sum $ take 10000 $ filter happy [1 ..]

Task/Happy-numbers/JavaScript/happy-numbers-2.js

@@ -1,25 +1,60 @@
 (() => {
-    'use strict';
 
     // isHappy :: Int -> Bool
-    function isHappy(n) {
-        let f = n => n.toString()
-            .split('')
-            .reduce((a, x) => a + Math.pow(parseInt(x, 10), 2), 0),
-            p = (s, n) => n === 1 ? true : (
-                s.has(n) ? false : p(s.add(n), f(n))
+    const isHappy = n => {
+        const f = n =>
+            foldl(
+                (a, x) => a + raise(read(x), 2), // ^2
+                0,
+                splitOn('', show(n))
+            ),
+            p = (s, n) => n === 1 ? (
+                true
+            ) : member(n, s) ? (
+                false
+            ) : p(
+                insert(n, s), f(n)
             );
         return p(new Set(), n);
-    }
+    };
 
-    // TEST
+    // GENERIC FUNCTIONS ------------------------------------------------------
 
-    // range :: Int -> Int -> [Int]
-    let range = (m, n) => Array.from({
-        length: Math.floor(n - m) + 1
-    }, (_, i) => m + i);
+    // enumFromTo :: Int -> Int -> [Int]
+    const enumFromTo = (m, n) =>
+        Array.from({
+            length: Math.floor(n - m) + 1
+        }, (_, i) => m + i);
 
-    return range(1, 50)
-        .filter(isHappy)
-        .slice(0, 8);
+    // filter :: (a -> Bool) -> [a] -> [a]
+    const filter = (f, xs) => xs.filter(f);
+
+    // foldl :: (b -> a -> b) -> b -> [a] -> b
+    const foldl = (f, a, xs) => xs.reduce(f, a);
+
+    // insert :: Ord a => a -> Set a -> Set a
+    const insert = (e, s) => s.add(e);
+
+    // member :: Ord a => a -> Set a -> Bool
+    const member = (e, s) => s.has(e);
+
+    // read :: Read a => String -> a
+    const read = JSON.parse;
+
+    // show :: a -> String
+    const show = x => JSON.stringify(x);
+
+    // splitOn :: String -> String -> [String]
+    const splitOn = (cs, xs) => xs.split(cs);
+
+    // raise :: Num -> Int -> Num
+    const raise = (n, e) => Math.pow(n, e);
+
+    // take :: Int -> [a] -> [a]
+    const take = (n, xs) => xs.slice(0, n);
+
+    // TEST -------------------------------------------------------------------
+    return show(
+        take(8, filter(isHappy, enumFromTo(1, 50)))
+    );
 })()

Task/Happy-numbers/JavaScript/happy-numbers-4.js

@@ -1,35 +1,71 @@
 (() => {
-    'use strict';
 
     // isHappy :: Int -> Bool
-    let isHappy = n => {
-        let f = n => n.toString()
-            .split('')
-            .reduce((a, x) => a + Math.pow(parseInt(x, 10), 2), 0),
-            p = (s, n) => n === 1 ? true : (
-                s.has(n) ? false : p(s.add(n), f(n))
+    const isHappy = n => {
+        const f = n =>
+            foldl(
+                (a, x) => a + raise(read(x), 2), // ^2
+                0,
+                splitOn('', show(n))
+            ),
+            p = (s, n) => n === 1 ? (
+                true
+            ) : member(n, s) ? (
+                false
+            ) : p(
+                insert(n, s), f(n)
             );
         return p(new Set(), n);
-    },
+    };
+
+    // GENERIC FUNCTIONS ------------------------------------------------------
+
+    // filter :: (a -> Bool) -> [a] -> [a]
+    const filter = (f, xs) => xs.filter(f);
+
+    // foldl :: (b -> a -> b) -> b -> [a] -> b
+    const foldl = (f, a, xs) => xs.reduce(f, a);
+
+    // insert :: Ord a => a -> Set a -> Set a
+    const insert = (e, s) => s.add(e);
+
+    // member :: Ord a => a -> Set a -> Bool
+    const member = (e, s) => s.has(e);
+
+    // read :: Read a => String -> a
+    const read = JSON.parse;
+
+    // show :: a -> String
+    const show = x => JSON.stringify(x);
+
+    // splitOn :: String -> String -> [String]
+    const splitOn = (cs, xs) => xs.split(cs);
+
+    // raise :: Num -> Int -> Num
+    const raise = (n, e) => Math.pow(n, e);
 
     // until :: (a -> Bool) -> (a -> a) -> a -> a
-    until = (p, f, x) => {
+    const until = (p, f, x) => {
         let v = x;
         while (!p(v)) v = f(v);
         return v;
     };
 
-    return until(
-        m => m.xs.length === 8,
-        m => {
-            let n = m.n;
-            return {
-                n: n + 1,
-                xs: isHappy(n) ? m.xs.concat(n) : m.xs
-            };
-        }, {
-            n: 1,
-            xs: []
-        }
-    ).xs;
+    // TEST -------------------------------------------------------------------
+    return show(
+        until(
+            m => m.xs.length === 8,
+            m => {
+                const n = m.n;
+                return {
+                    n: n + 1,
+                    xs: isHappy(n) ? m.xs.concat(n) : m.xs
+                };
+            }, {
+                n: 1,
+                xs: []
+            }
+        )
+        .xs
+    );
 })();

Task/Happy-numbers/Kotlin/happy-numbers.kotlin

@@ -0,0 +1,30 @@
+// version 1.0.5-2
+
+fun isHappy(n: Int): Boolean {
+    val cache = mutableListOf<Int>()
+    var sum = 0
+    var nn = n
+    var digit: Int
+    while (nn != 1) {
+        if (nn in cache) return false
+        cache.add(nn)
+        while (nn != 0) {
+            digit = nn % 10
+            sum += digit * digit
+            nn /= 10
+        }
+        nn = sum
+        sum = 0
+    }
+    return true
+}
+
+fun main(args: Array<String>) {
+    var num = 1
+    val happyNums = mutableListOf<Int>()
+    while (happyNums.size < 8) {
+        if (isHappy(num)) happyNums.add(num)
+        num++
+    }
+    println("First 8 happy numbers : " + happyNums.joinToString(", "))
+}

Task/Happy-numbers/OoRexx/happy-numbers.rexx

@@ -0,0 +1,28 @@
+count = 0
+say "First 8 happy numbers are:"
+loop i = 1 while count < 8
+    if happyNumber(i) then do
+        count += 1
+        say i
+    end
+end
+
+::routine happyNumber
+  use strict arg number
+
+  -- use to trace previous cycle results
+  previous = .set~new
+  loop forever
+      -- stop when we hit the target
+      if number = 1 then return .true
+      -- stop as soon as we start cycling
+      if previous[number] \== .nil then return .false
+      previous~put(number)
+      next = 0
+      -- loop over all of the digits
+      loop digit over number~makearray('')
+          next += digit * digit
+      end
+      -- and repeat the cycle
+      number = next
+  end

Task/Happy-numbers/Zkl/happy-numbers-1.zkl

@@ -0,0 +1,9 @@
+fcn happyNumbers{  // continously spew happy numbers
+   foreach N in ([1..]){
+       n:=N; while(1){
+	 n=n.split().reduce(fcn(p,n){ p + n*n },0);
+	 if(n==1) { vm.yield(N); break; }
+	 if(n==4) break;  // unhappy cycle
+      }
+   }
+}

Task/Happy-numbers/Zkl/happy-numbers-2.zkl

@@ -0,0 +1,2 @@
+h:=Utils.Generator(happyNumbers);
+h.walk(8).println();

Task/Happy-numbers/Zkl/happy-numbers-3.zkl

@@ -0,0 +1 @@
+Utils.Generator(happyNumbers).drop(0d1_000_000-1).next().println();