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
|
|
@ -0,0 +1,47 @@
|
|||
on treeFromNestingLevels(input)
|
||||
set maxLevel to 0
|
||||
repeat with thisLevel in input
|
||||
if (thisLevel > maxLevel) then set maxLevel to thisLevel
|
||||
end repeat
|
||||
if (maxLevel < 2) then return input
|
||||
|
||||
set emptyList to {}
|
||||
repeat with testLevel from maxLevel to 2 by -1
|
||||
set output to {}
|
||||
set subnest to {}
|
||||
repeat with thisLevel in input
|
||||
set thisLevel to thisLevel's contents
|
||||
if ((thisLevel's class is integer) and (thisLevel < testLevel)) then
|
||||
if (subnest ≠ emptyList) then set subnest to {}
|
||||
set end of output to thisLevel
|
||||
else
|
||||
if (subnest = emptyList) then set end of output to subnest
|
||||
set end of subnest to thisLevel
|
||||
end if
|
||||
end repeat
|
||||
set input to output
|
||||
end repeat
|
||||
|
||||
return output
|
||||
end treeFromNestingLevels
|
||||
|
||||
-- Task code:
|
||||
local output, astid, input, part1, errMsg
|
||||
set output to {}
|
||||
set astid to AppleScript's text item delimiters
|
||||
repeat with input in {{}, {1, 2, 4}, {3, 1, 3, 1}, {1, 2, 3, 1}, {3, 2, 1, 3}, {3, 3, 3, 1, 1, 3, 3, 3}}
|
||||
set input to input's contents
|
||||
set AppleScript's text item delimiters to ", "
|
||||
set part1 to "{" & input & "} nests to: {"
|
||||
-- It's a pain having to parse nested lists to text, so throw a deliberate error and parse the error message instead.
|
||||
try
|
||||
|| of treeFromNestingLevels(input)
|
||||
on error errMsg
|
||||
set AppleScript's text item delimiters to {"{", "}"}
|
||||
set end of output to part1 & ((text from text item 2 to text item -2 of errMsg) & "}")
|
||||
end try
|
||||
end repeat
|
||||
set AppleScript's text item delimiters to linefeed
|
||||
set output to output as text
|
||||
set AppleScript's text item delimiters to astid
|
||||
return output
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
"{} nests to: {}
|
||||
{1, 2, 4} nests to: {1, {2, {{4}}}}
|
||||
{3, 1, 3, 1} nests to: {{{3}}, 1, {{3}}, 1}
|
||||
{1, 2, 3, 1} nests to: {1, {2, {3}}, 1}
|
||||
{3, 2, 1, 3} nests to: {{{3}, 2}, 1, {{3}}}
|
||||
{3, 3, 3, 1, 1, 3, 3, 3} nests to: {{{3, 3, 3}}, 1, 1, {{3, 3, 3}}}"
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
on treeFromNestingLevels(input)
|
||||
script recursion
|
||||
property emptyList : {}
|
||||
|
||||
on recurse(input, currentLevel)
|
||||
set output to {}
|
||||
set subnest to {}
|
||||
repeat with thisLevel in input
|
||||
set thisLevel to thisLevel's contents
|
||||
if (thisLevel > currentLevel) then
|
||||
set end of subnest to thisLevel
|
||||
else
|
||||
if (subnest ≠ emptyList) then
|
||||
set end of output to recurse(subnest, currentLevel + 1)
|
||||
set subnest to {}
|
||||
end if
|
||||
set end of output to thisLevel
|
||||
end if
|
||||
end repeat
|
||||
if (subnest ≠ emptyList) then set end of output to recurse(subnest, currentLevel + 1)
|
||||
|
||||
return output
|
||||
end recurse
|
||||
end script
|
||||
|
||||
return recursion's recurse(input, 1)
|
||||
end treeFromNestingLevels
|
||||
|
|
@ -0,0 +1,456 @@
|
|||
----------------- FOREST FROM NEST LEVELS ----------------
|
||||
|
||||
-- forestFromNestLevels :: [(Int, a)] -> [Tree a]
|
||||
on forestFromNestLevels(pairs)
|
||||
script go
|
||||
on |λ|(xs)
|
||||
if {} ≠ xs then
|
||||
set {n, v} to item 1 of xs
|
||||
|
||||
script deeper
|
||||
on |λ|(x)
|
||||
n < item 1 of x
|
||||
end |λ|
|
||||
end script
|
||||
set {descendants, rs} to ¬
|
||||
|λ|(rest of xs) of span(deeper)
|
||||
|
||||
{Node(v, |λ|(descendants))} & |λ|(rs)
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|λ|(pairs) of go
|
||||
end forestFromNestLevels
|
||||
|
||||
|
||||
-- nestedList :: Maybe Int -> Nest -> Nest
|
||||
on nestedList(maybeLevel, xs)
|
||||
set subTree to concat(xs)
|
||||
if maybeLevel ≠ missing value then
|
||||
if {} ≠ subTree then
|
||||
{maybeLevel, subTree}
|
||||
else
|
||||
{maybeLevel}
|
||||
end if
|
||||
else
|
||||
{subTree}
|
||||
end if
|
||||
end nestedList
|
||||
|
||||
|
||||
-- treeFromSparseLevelList :: [Int] -> Tree Maybe Int
|
||||
on treeFromSparseLevelList(xs)
|
||||
{missing value, ¬
|
||||
forestFromNestLevels(rooted(normalized(xs)))}
|
||||
end treeFromSparseLevelList
|
||||
|
||||
-------------------------- TESTS -------------------------
|
||||
on run
|
||||
set tests to {¬
|
||||
{}, ¬
|
||||
{1, 2, 4}, ¬
|
||||
{3, 1, 3, 1}, ¬
|
||||
{1, 2, 3, 1}, ¬
|
||||
{3, 2, 1, 3}, ¬
|
||||
{3, 3, 3, 1, 1, 3, 3, 3}}
|
||||
|
||||
script translate
|
||||
on |λ|(ns)
|
||||
set tree to treeFromSparseLevelList(ns)
|
||||
|
||||
set bracketNest to root(foldTree(my nestedList, tree))
|
||||
|
||||
set returnTrip to foldTree(my levelList, tree)
|
||||
|
||||
map(my showList, {ns, bracketNest, returnTrip})
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set testResults to {{"INPUT", "NESTED", "ROUND-TRIP"}} & map(translate, tests)
|
||||
|
||||
set {firstColWidth, secondColWidth} to map(widest(testResults), {fst, snd})
|
||||
|
||||
script display
|
||||
on |λ|(triple)
|
||||
intercalate(" -> ", ¬
|
||||
{justifyRight(firstColWidth, space, item 1 of triple)} & ¬
|
||||
{justifyLeft(secondColWidth, space, item 2 of triple)} & ¬
|
||||
{item 3 of triple})
|
||||
end |λ|
|
||||
end script
|
||||
linefeed & unlines(map(display, testResults))
|
||||
end run
|
||||
|
||||
|
||||
-- widest :: ((a, a) -> a) -> [String] -> Int
|
||||
on widest(xs)
|
||||
script
|
||||
on |λ|(f)
|
||||
maximum(map(compose(my |length|, mReturn(f)), xs))
|
||||
end |λ|
|
||||
end script
|
||||
end widest
|
||||
|
||||
|
||||
-------------- FROM TREE BACK TO SPARSE LIST -------------
|
||||
|
||||
-- levelListFromNestedList :: Maybe a -> NestedList -> [a]
|
||||
on levelList(maybeLevel, xs)
|
||||
if maybeLevel ≠ missing value then
|
||||
concat(maybeLevel & xs)
|
||||
else
|
||||
concat(xs)
|
||||
end if
|
||||
end levelList
|
||||
|
||||
|
||||
----- NORMALIZED TO A STRICTER GENERIC DATA STRUCTURE ----
|
||||
|
||||
-- normalized :: [Int] -> [(Int, Maybe Int)]
|
||||
on normalized(xs)
|
||||
-- Explicit representation of implicit nodes.
|
||||
|
||||
if {} ≠ xs then
|
||||
set x to item 1 of xs
|
||||
if 1 > x then
|
||||
normalized(rest of xs)
|
||||
else
|
||||
set h to {{x, x}}
|
||||
if 1 = length of xs then
|
||||
h
|
||||
else
|
||||
if 1 < ((item 2 of xs) - x) then
|
||||
set ys to h & {{1 + x, missing value}}
|
||||
else
|
||||
set ys to h
|
||||
end if
|
||||
ys & normalized(rest of xs)
|
||||
end if
|
||||
end if
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end normalized
|
||||
|
||||
|
||||
-- rooted :: [(Int, Maybe Int)] -> [(Int, Maybe Int)]
|
||||
on rooted(pairs)
|
||||
-- Path from the virtual root to the first explicit node.
|
||||
if {} ≠ pairs then
|
||||
set {n, _} to item 1 of pairs
|
||||
if 1 ≠ n then
|
||||
script go
|
||||
on |λ|(x)
|
||||
{x, missing value}
|
||||
end |λ|
|
||||
end script
|
||||
map(go, enumFromTo(1, n - 1)) & pairs
|
||||
else
|
||||
pairs
|
||||
end if
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end rooted
|
||||
|
||||
------------------ GENERIC TREE FUNCTIONS ----------------
|
||||
|
||||
-- Node :: a -> [Tree a] -> Tree a
|
||||
on Node(v, xs)
|
||||
-- {type:"Node", root:v, nest:xs}
|
||||
{v, xs}
|
||||
end Node
|
||||
|
||||
|
||||
-- foldTree :: (a -> [b] -> b) -> Tree a -> b
|
||||
on foldTree(f, tree)
|
||||
script go
|
||||
property g : mReturn(f)
|
||||
on |λ|(tree)
|
||||
tell g to |λ|(root(tree), map(go, nest(tree)))
|
||||
end |λ|
|
||||
end script
|
||||
|λ|(tree) of go
|
||||
end foldTree
|
||||
|
||||
|
||||
-- nest :: Tree a -> [a]
|
||||
on nest(oTree)
|
||||
item 2 of oTree
|
||||
-- nest of oTree
|
||||
end nest
|
||||
|
||||
|
||||
-- root :: Tree a -> a
|
||||
on root(oTree)
|
||||
item 1 of oTree
|
||||
-- root of oTree
|
||||
end root
|
||||
|
||||
|
||||
---------------------- OTHER GENERIC ---------------------
|
||||
|
||||
-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
|
||||
on compose(f, g)
|
||||
script
|
||||
property mf : mReturn(f)
|
||||
property mg : mReturn(g)
|
||||
on |λ|(x)
|
||||
mf's |λ|(mg's |λ|(x))
|
||||
end |λ|
|
||||
end script
|
||||
end compose
|
||||
|
||||
|
||||
-- concat :: [[a]] -> [a]
|
||||
on concat(xs)
|
||||
set lng to length of xs
|
||||
set acc to {}
|
||||
repeat with i from 1 to lng
|
||||
set acc to acc & item i of xs
|
||||
end repeat
|
||||
acc
|
||||
end concat
|
||||
|
||||
|
||||
-- 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
|
||||
lst
|
||||
else
|
||||
{}
|
||||
end if
|
||||
end enumFromTo
|
||||
|
||||
|
||||
-- foldl :: (a -> b -> a) -> a -> [b] -> a
|
||||
on foldl(f, startValue, xs)
|
||||
tell mReturn(f)
|
||||
set v to startValue
|
||||
set lng to length of xs
|
||||
repeat with i from 1 to lng
|
||||
set v to |λ|(v, item i of xs, i, xs)
|
||||
end repeat
|
||||
return v
|
||||
end tell
|
||||
end foldl
|
||||
|
||||
|
||||
-- fst :: (a, b) -> a
|
||||
on fst(tpl)
|
||||
if class of tpl is record then
|
||||
|1| of tpl
|
||||
else
|
||||
item 1 of tpl
|
||||
end if
|
||||
end fst
|
||||
|
||||
|
||||
-- intercalate :: String -> [String] -> String
|
||||
on intercalate(delim, xs)
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, delim}
|
||||
set s to xs as text
|
||||
set my text item delimiters to dlm
|
||||
s
|
||||
end intercalate
|
||||
|
||||
|
||||
-- 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|
|
||||
|
||||
|
||||
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
|
||||
on mReturn(f)
|
||||
-- 2nd class handler function lifted into 1st class script wrapper.
|
||||
if script is class of f then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
|
||||
-- map :: (a -> b) -> [a] -> [b]
|
||||
on map(f, xs)
|
||||
-- The list obtained by applying f
|
||||
-- to each element of 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
|
||||
|
||||
|
||||
-- maximum :: Ord a => [a] -> a
|
||||
on maximum(xs)
|
||||
script
|
||||
on |λ|(a, b)
|
||||
if a is missing value or b > a then
|
||||
b
|
||||
else
|
||||
a
|
||||
end if
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
foldl(result, missing value, xs)
|
||||
end maximum
|
||||
|
||||
|
||||
-- Egyptian multiplication - progressively doubling a list, appending
|
||||
-- stages of doubling to an accumulator where needed for binary
|
||||
-- assembly of a target length
|
||||
-- replicate :: Int -> String -> String
|
||||
on replicate(n, s)
|
||||
-- Egyptian multiplication - progressively doubling a list,
|
||||
-- appending stages of doubling to an accumulator where needed
|
||||
-- for binary assembly of a target length
|
||||
script p
|
||||
on |λ|({n})
|
||||
n ≤ 1
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
script f
|
||||
on |λ|({n, dbl, out})
|
||||
if (n mod 2) > 0 then
|
||||
set d to out & dbl
|
||||
else
|
||||
set d to out
|
||||
end if
|
||||
{n div 2, dbl & dbl, d}
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set xs to |until|(p, f, {n, s, ""})
|
||||
item 2 of xs & item 3 of xs
|
||||
end replicate
|
||||
|
||||
|
||||
-- snd :: (a, b) -> b
|
||||
on snd(tpl)
|
||||
if class of tpl is record then
|
||||
|2| of tpl
|
||||
else
|
||||
item 2 of tpl
|
||||
end if
|
||||
end snd
|
||||
|
||||
|
||||
-- showList :: [a] -> String
|
||||
on showList(xs)
|
||||
"[" & intercalate(", ", map(my show, xs)) & "]"
|
||||
end showList
|
||||
|
||||
|
||||
on show(v)
|
||||
if list is class of v then
|
||||
showList(v)
|
||||
else
|
||||
v as text
|
||||
end if
|
||||
end show
|
||||
|
||||
|
||||
-- span :: (a -> Bool) -> [a] -> ([a], [a])
|
||||
on span(f)
|
||||
-- The longest (possibly empty) prefix of xs
|
||||
-- that contains only elements satisfying p,
|
||||
-- tupled with the remainder of xs.
|
||||
-- span(p, xs) eq (takeWhile(p, xs), dropWhile(p, xs))
|
||||
script
|
||||
on |λ|(xs)
|
||||
set lng to length of xs
|
||||
set i to 0
|
||||
tell mReturn(f)
|
||||
repeat while lng > i and |λ|(item (1 + i) of xs)
|
||||
set i to 1 + i
|
||||
end repeat
|
||||
end tell
|
||||
splitAt(i, xs)
|
||||
end |λ|
|
||||
end script
|
||||
end span
|
||||
|
||||
|
||||
-- splitAt :: Int -> [a] -> ([a], [a])
|
||||
on splitAt(n, xs)
|
||||
if n > 0 and n < length of xs then
|
||||
if class of xs is text then
|
||||
{items 1 thru n of xs as text, ¬
|
||||
items (n + 1) thru -1 of xs as text}
|
||||
else
|
||||
{items 1 thru n of xs, items (n + 1) thru -1 of xs}
|
||||
end if
|
||||
else
|
||||
if n < 1 then
|
||||
{{}, xs}
|
||||
else
|
||||
{xs, {}}
|
||||
end if
|
||||
end if
|
||||
end splitAt
|
||||
|
||||
|
||||
-- unlines :: [String] -> String
|
||||
on unlines(xs)
|
||||
-- A single string formed by the intercalation
|
||||
-- of a list of strings with the newline character.
|
||||
set {dlm, my text item delimiters} to ¬
|
||||
{my text item delimiters, linefeed}
|
||||
set s to xs as text
|
||||
set my text item delimiters to dlm
|
||||
s
|
||||
end unlines
|
||||
|
||||
|
||||
-- until :: (a -> Bool) -> (a -> a) -> a -> a
|
||||
on |until|(p, f, x)
|
||||
set v to x
|
||||
set mp to mReturn(p)
|
||||
set mf to mReturn(f)
|
||||
repeat until mp's |λ|(v)
|
||||
set v to mf's |λ|(v)
|
||||
end repeat
|
||||
v
|
||||
end |until|
|
||||
Loading…
Add table
Add a link
Reference in a new issue