Data commit

Task/Egyptian-division/AppleScript/egyptian-division.applescript

@@ -0,0 +1,93 @@
+-- EGYPTIAN DIVISION ------------------------------------
+
+-- eqyptianQuotRem :: Int -> Int -> (Int, Int)
+on egyptianQuotRem(m, n)
+    script expansion
+        on |λ|(ix)
+            set {i, x} to ix
+            if x > m then
+                Nothing()
+            else
+                Just({ix, {i + i, x + x}})
+            end if
+        end |λ|
+    end script
+
+    script collapse
+        on |λ|(ix, qr)
+            set {i, x} to ix
+            set {q, r} to qr
+            if x < r then
+                {q + i, r - x}
+            else
+                qr
+            end if
+        end |λ|
+    end script
+
+    return foldr(collapse, {0, m}, ¬
+        unfoldr(expansion, {1, n}))
+end egyptianQuotRem
+
+
+-- TEST -------------------------------------------------
+on run
+    egyptianQuotRem(580, 34)
+end run
+
+-- GENERIC FUNCTIONS ------------------------------------
+
+-- Just :: a -> Maybe a
+on Just(x)
+    {type:"Maybe", Nothing:false, Just:x}
+end Just
+
+-- Nothing :: Maybe a
+on Nothing()
+    {type:"Maybe", Nothing:true}
+end Nothing
+
+-- foldr :: (a -> b -> b) -> b -> [a] -> b
+on foldr(f, startValue, xs)
+    tell mReturn(f)
+        set v to startValue
+        set lng to length of xs
+        repeat with i from lng to 1 by -1
+            set v to |λ|(item i of xs, v, i, xs)
+        end repeat
+        return v
+    end tell
+end foldr
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: First-class m => (a -> b) -> m (a -> b)
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
+
+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
+-- > [10,9,8,7,6,5,4,3,2,1]
+-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
+on unfoldr(f, v)
+    set xr to {v, v} -- (value, remainder)
+    set xs to {}
+    tell mReturn(f)
+        repeat -- Function applied to remainder.
+            set mb to |λ|(item 2 of xr)
+            if Nothing of mb then
+                exit repeat
+            else -- New (value, remainder) tuple,
+                set xr to Just of mb
+                -- and value appended to output list.
+                set end of xs to item 1 of xr
+            end if
+        end repeat
+    end tell
+    return xs
+end unfoldr