Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
304
Task/Map-range/AppleScript/map-range.applescript
Normal file
304
Task/Map-range/AppleScript/map-range.applescript
Normal file
|
|
@ -0,0 +1,304 @@
|
|||
------------------------ MAP RANGE -----------------------
|
||||
|
||||
-- rangeMap :: (Num, Num) -> (Num, Num) -> Num -> Num
|
||||
on rangeMap(a, b)
|
||||
script
|
||||
on |λ|(s)
|
||||
set {a1, a2} to a
|
||||
set {b1, b2} to b
|
||||
b1 + ((s - a1) * (b2 - b1)) / (a2 - a1)
|
||||
end |λ|
|
||||
end script
|
||||
end rangeMap
|
||||
|
||||
|
||||
--------------------------- TEST -------------------------
|
||||
on run
|
||||
set mapping to rangeMap({0, 10}, {-1, 0})
|
||||
|
||||
set xs to enumFromTo(0, 10)
|
||||
set ys to map(mapping, xs)
|
||||
set zs to map(approxRatio(0), ys)
|
||||
|
||||
unlines(zipWith3(formatted, xs, ys, zs))
|
||||
end run
|
||||
|
||||
|
||||
------------------------- DISPLAY ------------------------
|
||||
|
||||
-- formatted :: Int -> Float -> Ratio -> String
|
||||
on formatted(x, m, r)
|
||||
set fract to showRatio(r)
|
||||
set {n, d} to splitOn("/", fract)
|
||||
|
||||
(justifyRight(2, space, x as string) & " -> " & ¬
|
||||
justifyRight(4, space, m as string)) & " = " & ¬
|
||||
justifyRight(2, space, n) & "/" & d
|
||||
end formatted
|
||||
|
||||
|
||||
-------------------- GENERIC FUNCTIONS -------------------
|
||||
|
||||
-- Absolute value.
|
||||
-- abs :: Num -> Num
|
||||
on abs(x)
|
||||
if 0 > x then
|
||||
-x
|
||||
else
|
||||
x
|
||||
end if
|
||||
end abs
|
||||
|
||||
|
||||
-- approxRatio :: Real -> Real -> Ratio
|
||||
on approxRatio(epsilon)
|
||||
script
|
||||
on |λ|(n)
|
||||
if {real, integer} contains (class of epsilon) and 0 < epsilon then
|
||||
set e to epsilon
|
||||
else
|
||||
set e to 1 / 10000
|
||||
end if
|
||||
|
||||
script gcde
|
||||
on |λ|(e, x, y)
|
||||
script _gcd
|
||||
on |λ|(a, b)
|
||||
if b < e then
|
||||
a
|
||||
else
|
||||
|λ|(b, a mod b)
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|λ|(abs(x), abs(y)) of _gcd
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set c to |λ|(e, 1, n) of gcde
|
||||
ratio((n div c), (1 div c))
|
||||
end |λ|
|
||||
end script
|
||||
end approxRatio
|
||||
|
||||
|
||||
-- enumFromTo :: Int -> Int -> [Int]
|
||||
on enumFromTo(m, n)
|
||||
if m ≤ n then
|
||||
set lst to {}
|
||||
repeat with i from m to n
|
||||
set end of lst to i
|
||||
end repeat
|
||||
return lst
|
||||
else
|
||||
return {}
|
||||
end if
|
||||
end enumFromTo
|
||||
|
||||
|
||||
-- gcd :: Int -> Int -> Int
|
||||
on gcd(a, b)
|
||||
set x to abs(a)
|
||||
set y to abs(b)
|
||||
repeat until y = 0
|
||||
if x > y then
|
||||
set x to x - y
|
||||
else
|
||||
set y to y - x
|
||||
end if
|
||||
end repeat
|
||||
return x
|
||||
end gcd
|
||||
|
||||
|
||||
-- justifyLeft :: Int -> Char -> String -> String
|
||||
on justifyLeft(n, cFiller, strText)
|
||||
if n > length of strText then
|
||||
text 1 thru n of (strText & replicate(n, cFiller))
|
||||
else
|
||||
strText
|
||||
end if
|
||||
end justifyLeft
|
||||
|
||||
|
||||
-- justifyRight :: Int -> Char -> String -> String
|
||||
on justifyRight(n, cFiller, strText)
|
||||
if n > length of strText then
|
||||
text -n thru -1 of ((replicate(n, cFiller) as text) & strText)
|
||||
else
|
||||
strText
|
||||
end if
|
||||
end justifyRight
|
||||
|
||||
|
||||
-- length :: [a] -> Int
|
||||
on |length|(xs)
|
||||
set c to class of xs
|
||||
if list is c or string is c then
|
||||
length of xs
|
||||
else
|
||||
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
|
||||
end if
|
||||
end |length|
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- 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
|
||||
|
||||
|
||||
-- minimum :: Ord a => [a] -> a
|
||||
on minimum(xs)
|
||||
set lng to length of xs
|
||||
if lng < 1 then return missing value
|
||||
set m to item 1 of xs
|
||||
repeat with x in xs
|
||||
set v to contents of x
|
||||
if v < m then set m to v
|
||||
end repeat
|
||||
return m
|
||||
end minimum
|
||||
|
||||
|
||||
-- ratio :: Int -> Int -> Ratio Int
|
||||
on ratio(x, y)
|
||||
script go
|
||||
on |λ|(x, y)
|
||||
if 0 ≠ y then
|
||||
if 0 ≠ x then
|
||||
set d to gcd(x, y)
|
||||
{type:"Ratio", n:(x div d), d:(y div d)}
|
||||
else
|
||||
{type:"Ratio", n:0, d:1}
|
||||
end if
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
go's |λ|(x * (signum(y)), abs(y))
|
||||
end ratio
|
||||
|
||||
|
||||
-- Egyptian multiplication - progressively doubling a list, appending
|
||||
-- stages of doubling to an accumulator where needed for binary
|
||||
-- assembly of a target length
|
||||
-- replicate :: Int -> a -> [a]
|
||||
on replicate(n, a)
|
||||
set out to {}
|
||||
if n < 1 then return out
|
||||
set dbl to {a}
|
||||
|
||||
repeat while (n > 1)
|
||||
if (n mod 2) > 0 then set out to out & dbl
|
||||
set n to (n div 2)
|
||||
set dbl to (dbl & dbl)
|
||||
end repeat
|
||||
return out & dbl
|
||||
end replicate
|
||||
|
||||
|
||||
-- showRatio :: Ratio -> String
|
||||
on showRatio(r)
|
||||
(n of r as string) & "/" & (d of r as string)
|
||||
end showRatio
|
||||
|
||||
|
||||
-- signum :: Num -> Num
|
||||
on signum(x)
|
||||
if x < 0 then
|
||||
-1
|
||||
else if x = 0 then
|
||||
0
|
||||
else
|
||||
1
|
||||
end if
|
||||
end signum
|
||||
|
||||
|
||||
-- splitOn :: String -> String -> [String]
|
||||
on splitOn(pat, src)
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, pat}
|
||||
set xs to text items of src
|
||||
set my text item delimiters to dlm
|
||||
return xs
|
||||
end splitOn
|
||||
|
||||
|
||||
-- take :: Int -> [a] -> [a]
|
||||
-- take :: Int -> String -> String
|
||||
on take(n, xs)
|
||||
set c to class of xs
|
||||
if list is c then
|
||||
if 0 < n then
|
||||
items 1 thru min(n, length of xs) of xs
|
||||
else
|
||||
{}
|
||||
end if
|
||||
else if string is c then
|
||||
if 0 < n then
|
||||
text 1 thru min(n, length of xs) of xs
|
||||
else
|
||||
""
|
||||
end if
|
||||
else if script is c then
|
||||
set ys to {}
|
||||
repeat with i from 1 to n
|
||||
set v to xs's |λ|()
|
||||
if missing value is v then
|
||||
return ys
|
||||
else
|
||||
set end of ys to v
|
||||
end if
|
||||
end repeat
|
||||
return ys
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end take
|
||||
|
||||
|
||||
-- unlines :: [String] -> String
|
||||
on unlines(xs)
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, linefeed}
|
||||
set str to xs as text
|
||||
set my text item delimiters to dlm
|
||||
str
|
||||
end unlines
|
||||
|
||||
|
||||
-- zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
|
||||
on zipWith3(f, xs, ys, zs)
|
||||
set lng to minimum({length of xs, length of ys, length of zs})
|
||||
if 1 > lng then return {}
|
||||
set lst to {}
|
||||
tell mReturn(f)
|
||||
repeat with i from 1 to lng
|
||||
set end of lst to |λ|(item i of xs, item i of ys, item i of zs)
|
||||
end repeat
|
||||
return lst
|
||||
end tell
|
||||
end zipWith3
|
||||
Loading…
Add table
Add a link
Reference in a new issue