Egyptian division: Difference between revisions
→{{header|AppleScript}}: Added an Applescript version (unfoldr to make rows, foldr to sum relevant rows)
m (→JS ES6) |
(→{{header|AppleScript}}: Added an Applescript version (unfoldr to make rows, foldr to sum relevant rows)) |
||
Line 308:
* Functions should be clear interpretations of the algorithm.
* Use the function to divide 580 by 34 and show the answer '''here, on this page'''.
=={{header|AppleScript}}==
Unfold to derive rows, fold to sum quotient and remainder
<lang AppleScript>-- EGYPTIAN DIVISION ---------------------------------------------------------
on egyptianQuotRem(m, n)
script doubledRows
script double
on |λ|(x)
x + x
end |λ|
end script
on |λ|(ix)
set v to ix
if item 2 of v > m then
{nothing:true}
else
{just:v, new:map(double, v), nothing:false}
end if
end |λ|
end script
set rows to unfoldr(doubledRows, [1, n])
script quotientSum
on |λ|(ix, qr)
set {i, x} to ix
set {q, r} to qr
if x < r then
{q + i, r - x}
else
{q, r}
end if
end |λ|
end script
foldr(quotientSum, {0, m}, rows)
end egyptianQuotRem
-- TEST ----------------------------------------------------------------------
on run
egyptianQuotRem(580, 34)
end run
-- GENERIC FUNCTIONS ---------------------------------------------------------
-- foldr :: (a -> b -> a) -> a -> [b] -> a
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
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- 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
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
set mf to mReturn(f)
set lst to {}
set recM to {nothing:false, new:v}
repeat while (not (nothing of recM))
set recM to mf's |λ|(new of recM)
if not nothing of recM then set end of lst to just of recM
end repeat
lst
end unfoldr</lang>
{{Out}}
<pre>{17, 2}</pre>
=={{header|C}}==
| |||