Tree datastructures: Difference between revisions
Content added Content deleted
(→Procedural: golf->troll) |
m (Withdrew the examples which use other sample outlines. I don't feel comfortable reproducing jokes about mocking and trolling.) |
||
Line 39: | Line 39: | ||
Show all output on this page. |
Show all output on this page. |
||
=={{header|AppleScript}}== |
|||
{{incorrect|AppleScript|"Strayed" from task example. (Task example updated as you are right).}} |
|||
The 'mocking' task example seems a little unpleasant. Perhaps an alternative ? |
|||
<lang applescript>use AppleScript version "2.4" |
|||
use framework "Foundation" |
|||
use scripting additions |
|||
on run |
|||
set strOutline to ¬ |
|||
"The Rosetta stone\n" & ¬ |
|||
" is a granodiorite stele\n" & ¬ |
|||
" engraved\n" & ¬ |
|||
" with Greek and Egyptian texts\n" & ¬ |
|||
" in different scripts.\n" & ¬ |
|||
" which, in the 19c, shed new light\n" & ¬ |
|||
" on various homologies." |
|||
set forestA to ¬ |
|||
forestFromNestLevels(indentLevelsFromLines(paragraphs of strOutline)) |
|||
set indentLevels to nestLevelsFromForest(forestA) |
|||
set forestB to forestFromNestLevels(indentLevels) |
|||
-- Logged to Messages panel of macOS Script Editor |
|||
log intercalate(linefeed & linefeed, {¬ |
|||
"Outline:", ¬ |
|||
strOutline, ¬ |
|||
"Forest from outline:", ¬ |
|||
forestJSON(forestA), ¬ |
|||
"Nesting levels from forest:", ¬ |
|||
toJSON(indentLevels), ¬ |
|||
"Forest rebuilt from nesting levels", ¬ |
|||
forestJSON(forestB), ¬ |
|||
"Equality test:", ¬ |
|||
"(forestA = forestB) -> " & (forestA = forestB)}) |
|||
end run |
|||
-- TREES ⇄ LEVEL TUPLES ---------------------------------- |
|||
-- forestFromNestLevels :: [(Int, a)] -> [Tree a] |
|||
on forestFromNestLevels(tuples) |
|||
-- A list of trees derived from a list of values paired |
|||
-- with integers giving their levels of indentation. |
|||
script go |
|||
on |λ|(xs) |
|||
if 0 < length of xs then |
|||
set lineOne to item 1 of xs |
|||
set {intIndent, v} to {fst(lineOne), snd(lineOne)} |
|||
set {firstTreeLines, remainingLines} to ¬ |
|||
listFromTuple(|λ|(rest of xs) of ¬ |
|||
span(compose(lt(intIndent), my fst))) |
|||
{Node(v, |λ|(firstTreeLines) of go)} & |λ|(remainingLines) of go |
|||
else |
|||
{} |
|||
end if |
|||
end |λ| |
|||
end script |
|||
|λ|(tuples) of go |
|||
end forestFromNestLevels |
|||
-- nestLevelsFromForest :: [Tree a] -> [(Int, a)] |
|||
on nestLevelsFromForest(trees) |
|||
-- A flat list of (nest level, value) tuples, |
|||
-- representing a series of trees. |
|||
script go |
|||
on |λ|(level) |
|||
script |
|||
on |λ|(tree) |
|||
{{level, root of tree}} & ¬ |
|||
concatMap(|λ|(1 + level) of go, nest of tree) |
|||
end |λ| |
|||
end script |
|||
end |λ| |
|||
end script |
|||
concatMap(|λ|(0) of go, trees) |
|||
end nestLevelsFromForest |
|||
-- INDENT LEVELS FROM OUTLINE ---------------------------- |
|||
--indentLevelsFromLines :: [String] -> [(Int, String)] |
|||
on indentLevelsFromLines(xs) |
|||
set tuples to map(compose(firstArrow(my |length|), ¬ |
|||
span(my isSpace)), xs) |
|||
script minimumIndent |
|||
on |λ|(a, tpl) |
|||
set n to fst(tpl) |
|||
bool(a, n, n < a and 0 < n) |
|||
end |λ| |
|||
end script |
|||
set indentUnit to foldl(minimumIndent, 100, tuples) |
|||
map(firstArrow(flipDiv(indentUnit)), tuples) |
|||
end indentLevelsFromLines |
|||
-- JSON SERIALISATIONS ------------------------------------ |
|||
-- forestJSON :: [Tree a] -> JSON String |
|||
on forestJSON(trees) |
|||
toJSON(forestAsNestedPairs(trees)) |
|||
end forestJSON |
|||
-- forestAsNestedPairs :: [Tree a] -> NestedPair [(a, [NestedPair])] |
|||
on forestAsNestedPairs(xs) |
|||
--A simple nested pair representation of a tree. |
|||
script go |
|||
on |λ|(tree) |
|||
{root of tree, map(go, nest of tree)} |
|||
end |λ| |
|||
end script |
|||
map(go, xs) |
|||
end forestAsNestedPairs |
|||
-- toJSON :: Show a => a -> String |
|||
on toJSON(a) |
|||
set blnAtom to {list, record} does not contain class of a |
|||
if blnAtom then |
|||
set obj to {a} |
|||
else |
|||
set obj to a |
|||
end if |
|||
set ca to current application |
|||
try |
|||
set {v, e} to ca's NSJSONSerialization's ¬ |
|||
dataWithJSONObject:obj options:0 |error|:(reference) |
|||
on error |
|||
return ("(Not representatable as JSON)") |
|||
end try |
|||
set strJSON to ca's NSString's alloc()'s initWithData:v ¬ |
|||
encoding:(ca's NSUTF8StringEncoding) |
|||
if blnAtom then |
|||
text 2 thru -2 of (strJSON as string) |
|||
else |
|||
strJSON as string |
|||
end if |
|||
end toJSON |
|||
-- GENERIC ------------------------------------------------ |
|||
-- Node :: a -> [Tree a] -> Tree a |
|||
on Node(v, xs) |
|||
{type:"Node", root:v, nest:xs} |
|||
end Node |
|||
-- Tuple (,) :: a -> b -> (a, b) |
|||
on Tuple(a, b) |
|||
-- Constructor for a pair of values, possibly of two different types. |
|||
{type:"Tuple", |1|:a, |2|:b, length:2} |
|||
end Tuple |
|||
-- bool :: a -> a -> Bool -> a |
|||
on bool(f, t, p) |
|||
if p then |
|||
set v to t |
|||
else |
|||
set v to f |
|||
end if |
|||
-- Delayed evaluation, if needed. |
|||
if handler is class of v then |
|||
|λ|() of mReturn(v) |
|||
else |
|||
v |
|||
end if |
|||
end bool |
|||
-- 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 |
|||
-- concatMap :: (a -> [b]) -> [a] -> [b] |
|||
on concatMap(f, xs) |
|||
set lng to length of xs |
|||
set acc to {} |
|||
tell mReturn(f) |
|||
repeat with i from 1 to lng |
|||
set acc to acc & (|λ|(item i of xs, i, xs)) |
|||
end repeat |
|||
end tell |
|||
return acc |
|||
end concatMap |
|||
-- flipDiv:: Int -> Int -> Int |
|||
on flipDiv(a) |
|||
-- Integer division, with arguments reversed |
|||
script |
|||
on |λ|(b) |
|||
b div a |
|||
end |λ| |
|||
end script |
|||
end flipDiv |
|||
-- Lift a simple function to one which applies to a tuple, |
|||
-- transforming only the first item of the tuple |
|||
-- firstArrow :: (a -> b) -> ((a, c) -> (b, c)) |
|||
on firstArrow(f) |
|||
script |
|||
on |λ|(xy) |
|||
Tuple(mReturn(f)'s |λ|(|1| of xy), |2| of xy) |
|||
end |λ| |
|||
end script |
|||
end firstArrow |
|||
-- 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 str to xs as text |
|||
set my text item delimiters to dlm |
|||
str |
|||
end intercalate |
|||
-- isSpace :: Char -> Bool |
|||
on isSpace(c) |
|||
set i to id of c |
|||
32 = i or (9 ≤ i and 13 ≥ i) |
|||
end isSpace |
|||
-- 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| |
|||
-- listFromTuple :: (a, a ...) -> [a] |
|||
on listFromTuple(tpl) |
|||
items 2 thru -2 of (tpl as list) |
|||
end listFromTuple |
|||
-- lt :: Ord a => a -> a -> Bool |
|||
on lt(x) |
|||
script |
|||
on |λ|(y) |
|||
x < y |
|||
end |λ| |
|||
end script |
|||
end lt |
|||
-- 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 |
|||
-- 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 |
|||
-- 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 |
|||
-- 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 |
|||
-- 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 i < lng and |λ|(item (i + 1) of xs) |
|||
set i to i + 1 |
|||
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 |
|||
Tuple(items 1 thru n of xs as text, ¬ |
|||
items (n + 1) thru -1 of xs as text) |
|||
else |
|||
Tuple(items 1 thru n of xs, items (n + 1) thru -1 of xs) |
|||
end if |
|||
else |
|||
if n < 1 then |
|||
Tuple({}, xs) |
|||
else |
|||
Tuple(xs, {}) |
|||
end if |
|||
end if |
|||
end splitAt</lang> |
|||
{{Out}} |
|||
<pre>Outline: |
|||
The Rosetta stone |
|||
is a granodiorite stele |
|||
engraved |
|||
with Greek and Egyptian texts |
|||
in different scripts. |
|||
which, in the 19c, shed new light |
|||
on various homologies. |
|||
Forest from outline: |
|||
[["The Rosetta stone",[["is a granodiorite stele",[["engraved",[["with Greek and Egyptian texts",[]]]],["in different scripts.",[]]]],["which, in the 19c, shed new light",[["on various homologies.",[]]]]]]] |
|||
Nesting levels from forest: |
|||
[[0,"The Rosetta stone"],[1,"is a granodiorite stele"],[2,"engraved"],[3,"with Greek and Egyptian texts"],[2,"in different scripts."],[1,"which, in the 19c, shed new light"],[2,"on various homologies."]] |
|||
Forest rebuilt from nesting levels |
|||
[["The Rosetta stone",[["is a granodiorite stele",[["engraved",[["with Greek and Egyptian texts",[]]]],["in different scripts.",[]]]],["which, in the 19c, shed new light",[["on various homologies.",[]]]]]]] |
|||
Equality test: |
|||
(forestA = forestB) -> true</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
Line 535: | Line 145: | ||
</pre> |
</pre> |
||
=={{header|Haskell}}== |
|||
Using the rose tree constructor in the standard Data.Tree module. |
|||
Parses the initial tree from outline text, and writes out the flat |
|||
and nested structures in a JSON format: |
|||
<lang haskell>{-# LANGUAGE OverloadedStrings #-} |
|||
import qualified Data.Text.Lazy.Encoding as E |
|||
import qualified Data.Text.Lazy.IO as T |
|||
import qualified Data.Text.Lazy as T |
|||
import Control.Arrow (first) |
|||
import Data.Char (isSpace) |
|||
import Data.Bool (bool) |
|||
import Data.Tree |
|||
import Data.Aeson |
|||
import Data.Aeson.Text |
|||
import Control.Arrow ((***)) |
|||
-- TREES <-> LIST OF LEVELS <-> TREES ----------------------- |
|||
nestLevelsFromForest :: [Tree a] -> [(Int, a)] |
|||
nestLevelsFromForest xs = |
|||
let go level node = |
|||
(level, rootLabel node) : (subForest node >>= go (succ level)) |
|||
in xs >>= go 0 |
|||
forestFromNestLevels |
|||
:: Ord t |
|||
=> [(t, a)] -> Forest a |
|||
forestFromNestLevels pairs = |
|||
let go [] = [] |
|||
go ((n, s):xs) = |
|||
uncurry (:) $ (Node s . go *** go) (span ((n <) . fst) xs) |
|||
in go pairs |
|||
-- INITIAL PARSE TREE OF OUTLINE -------------------------- |
|||
nestLevelsFromLines xs = |
|||
let pairs = T.span isSpace <$> xs |
|||
indentUnit = |
|||
foldr |
|||
(\x a -> |
|||
let w = (T.length . fst) x |
|||
in bool a w (w < a && 0 < w)) |
|||
maxBound |
|||
pairs |
|||
in first (flip div indentUnit . T.length) <$> pairs |
|||
-- DISPLAY OF JSON SERIALISATION -------------------------- |
|||
showJSON |
|||
:: ToJSON a |
|||
=> a -> T.Text |
|||
showJSON = E.decodeUtf8 . encode . toJSON |
|||
-- TEST --------------------------------------------------- |
|||
forestA :: Forest T.Text |
|||
forestA = (forestFromNestLevels . nestLevelsFromLines) (T.lines outline) |
|||
nestLevels :: [(Int, T.Text)] |
|||
nestLevels = nestLevelsFromForest forestA |
|||
forestB :: [Tree T.Text] |
|||
forestB = forestFromNestLevels nestLevels |
|||
main :: IO () |
|||
main = do |
|||
mapM_ |
|||
T.putStrLn |
|||
[ "Initial parse tree from outline:\n" |
|||
, showJSON forestA |
|||
, "\nFlat list of nesting levels from parse tree:\n" |
|||
, showJSON nestLevels |
|||
, "\nTree rebuilt from nest levels:\n" |
|||
, showJSON forestB |
|||
] |
|||
putStrLn $ |
|||
"\n\n(Reconstructed tree == parsed tree) -> " ++ show (forestA == forestB) |
|||
outline :: T.Text |
|||
outline = |
|||
"RosettaCode\n\ |
|||
\ rocks\n\ |
|||
\ code\n\ |
|||
\ comparison\n\ |
|||
\ wiki\n\ |
|||
\ knocks\n\ |
|||
\ golfing"</lang> |
|||
{{Out}} |
|||
<pre>Initial parse tree from outline: |
|||
[["RosettaCode",[["rocks",[["code",[]],["comparison",[]],["wiki",[]]]],["knocks",[["golfing",[]]]]]]] |
|||
Flat list of nesting levels from parse tree: |
|||
[[0,"RosettaCode"],[1,"rocks"],[2,"code"],[2,"comparison"],[2,"wiki"],[1,"knocks"],[2,"golfing"]] |
|||
Tree rebuilt from nest levels: |
|||
[["RosettaCode",[["rocks",[["code",[]],["comparison",[]],["wiki",[]]]],["knocks",[["golfing",[]]]]]]] |
|||
(Reconstructed tree == parsed tree) -> True</pre> |
|||
=={{header|JavaScript}}== |
|||
Parses the initial tree from outline text, and writes out the flat and nested structures in a minimal JSON format: |
|||
<lang javascript>(() => { |
|||
'use strict'; |
|||
// main :: IO () |
|||
const main = () => { |
|||
// (INDENT, STRING) PAIRS FROM OUTLINE ------------ |
|||
const |
|||
indentLevelTuplesA = indentLevelsFromLines( |
|||
lines(strOutlineB) |
|||
); |
|||
// LIST OF TREES FROM LIST OF (INDENT, STRING) PAIRS |
|||
const |
|||
forestA = forestFromIndentLevels( |
|||
indentLevelTuplesA |
|||
); |
|||
// (INDENT, STRING) PAIRS FROM LIST OF TREES ------ |
|||
const |
|||
indentLevelTuplesB = indentLevelsFromForest(forestA); |
|||
// LIST OF TREES FROM SECONDARY (INDENT, STRING) PAIRS |
|||
const forestB = forestFromIndentLevels( |
|||
indentLevelTuplesB |
|||
); |
|||
// JSON OUTPUT OF FORESTS AND INDENT TUPLES ------- |
|||
console.log('Tree structure from outline:\n') |
|||
console.log(jsonFromForest(forestA)); |
|||
console.log('\n\nIndent levels from tree structure:\n') |
|||
console.log(jsonFromIndentLevels(indentLevelTuplesB)); |
|||
console.log('\nTree structure from indent levels:\n') |
|||
console.log(jsonFromForest(forestB)); |
|||
console.log( |
|||
'(Reconstructed tree === parsed tree) -> ' + |
|||
Boolean(eq(forestA)(forestB)) |
|||
); |
|||
}; |
|||
// CONVERSIONS BETWEEN OUTLINES, TREES, AND (LEVEL, VALUE) PAIRS |
|||
// indentLevelsFromLines :: [String] -> [(Int, String)] |
|||
const indentLevelsFromLines = xs => { |
|||
const |
|||
indentTextPairs = xs.map(compose( |
|||
firstArrow(length), span(isSpace) |
|||
)), |
|||
indentUnit = minimum(indentTextPairs.flatMap(pair => { |
|||
const w = fst(pair); |
|||
return 0 < w ? [w] : []; |
|||
})); |
|||
return indentTextPairs.map( |
|||
firstArrow(flip(div)(indentUnit)) |
|||
); |
|||
}; |
|||
// forestFromIndentLevels :: [(Int, String)] -> [Tree String] |
|||
const forestFromIndentLevels = tuples => { |
|||
const go = xs => |
|||
0 < xs.length ? (() => { |
|||
const [n, s] = Array.from(xs[0]); |
|||
return uncurry(cons)( |
|||
splitArrow(compose(Node(s), go))(go)( |
|||
span(compose(lt(n), fst))( |
|||
xs.slice(1) |
|||
) |
|||
) |
|||
); |
|||
})() : []; |
|||
return go(tuples); |
|||
}; |
|||
// indentLevelsFromForest :: [Tree a] -> [(Int, a)] |
|||
const indentLevelsFromForest = trees => { |
|||
const go = n => node => [ |
|||
[n, node.root] |
|||
] |
|||
.concat(node.nest.flatMap(go(1 + n))) |
|||
return trees.flatMap(go(0)); |
|||
}; |
|||
// JSON RENDERING OF NESTED LINES AND (LEVEL, VALUE) PAIRS |
|||
// jsonFromForest :: [Tree a] -> JSON String |
|||
const jsonFromForest = trees => |
|||
JSON.stringify( |
|||
nestedListsFromForest(trees), |
|||
null, 2 |
|||
); |
|||
// nestedListsFromForest :: [Tree a] -> NestedList a |
|||
const nestedListsFromForest = xs => { |
|||
const go = node => [node.root, node.nest.map(go)]; |
|||
return xs.map(go); |
|||
}; |
|||
// jsonFromIndentLevels :: [(Int, String)] -> JSON String |
|||
const jsonFromIndentLevels = xs => |
|||
JSON.stringify( |
|||
xs.map(x => Array.from(x)), |
|||
null, 2 |
|||
); |
|||
// GENERIC FUNCTIONS ---------------------------- |
|||
// Node :: a -> [Tree a] -> Tree a |
|||
const Node = v => xs => ({ |
|||
type: 'Node', |
|||
root: v, // any type of value (consistent across tree) |
|||
nest: xs || [] |
|||
}); |
|||
// Tuple (,) :: a -> b -> (a, b) |
|||
const Tuple = a => b => ({ |
|||
type: 'Tuple', |
|||
'0': a, |
|||
'1': b, |
|||
length: 2 |
|||
}); |
|||
// compose (<<<) :: (b -> c) -> (a -> b) -> a -> c |
|||
const compose = (...fs) => |
|||
x => fs.reduceRight((a, f) => f(a), x); |
|||
// cons :: a -> [a] -> [a] |
|||
const cons = x => |
|||
xs => [x].concat(xs) |
|||
// div :: Int -> Int -> Int |
|||
const div = x => y => Math.floor(x / y); |
|||
// eq (==) :: Eq a => a -> a -> Bool |
|||
const eq = a => b => { |
|||
const t = typeof a; |
|||
return t !== typeof b ? ( |
|||
false |
|||
) : 'object' !== t ? ( |
|||
'function' !== t ? ( |
|||
a === b |
|||
) : a.toString() === b.toString() |
|||
) : (() => { |
|||
const kvs = Object.entries(a); |
|||
return kvs.length !== Object.keys(b).length ? ( |
|||
false |
|||
) : kvs.every(([k, v]) => eq(v)(b[k])); |
|||
})(); |
|||
}; |
|||
// firstArrow :: (a -> b) -> ((a, c) -> (b, c)) |
|||
const firstArrow = f => xy => Tuple(f(xy[0]))( |
|||
xy[1] |
|||
); |
|||
// flip :: (a -> b -> c) -> b -> a -> c |
|||
const flip = f => |
|||
1 < f.length ? ( |
|||
(a, b) => f(b, a) |
|||
) : (x => y => f(y)(x)); |
|||
// foldl1 :: (a -> a -> a) -> [a] -> a |
|||
const foldl1 = f => xs => |
|||
1 < xs.length ? xs.slice(1) |
|||
.reduce(uncurry(f), xs[0]) : xs[0]; |
|||
// fst :: (a, b) -> a |
|||
const fst = tpl => tpl[0]; |
|||
// isSpace :: Char -> Bool |
|||
const isSpace = c => /\s/.test(c); |
|||
// Returns Infinity over objects without finite length. |
|||
// This enables zip and zipWith to choose the shorter |
|||
// argument when one is non-finite, like cycle, repeat etc |
|||
// length :: [a] -> Int |
|||
const length = xs => |
|||
(Array.isArray(xs) || 'string' === typeof xs) ? ( |
|||
xs.length |
|||
) : Infinity; |
|||
// lines :: String -> [String] |
|||
const lines = s => s.split(/[\r\n]/); |
|||
// lt (<) :: Ord a => a -> a -> Bool |
|||
const lt = a => b => a < b; |
|||
// minimum :: Ord a => [a] -> a |
|||
const minimum = xs => |
|||
0 < xs.length ? ( |
|||
foldl1(a => x => x < a ? x : a)(xs) |
|||
) : undefined; |
|||
// showLog :: a -> IO () |
|||
const showLog = (...args) => |
|||
console.log( |
|||
args |
|||
.map(JSON.stringify) |
|||
.join(' -> ') |
|||
); |
|||
// span :: (a -> Bool) -> [a] -> ([a], [a]) |
|||
const span = p => xs => { |
|||
const iLast = xs.length - 1; |
|||
return splitAt( |
|||
until(i => iLast < i || !p(xs[i]))( |
|||
succ |
|||
)(0) |
|||
)(xs); |
|||
}; |
|||
// Compose a function (from a tuple to a tuple), |
|||
// (with separate transformations for fst and snd) |
|||
// splitArrow (***) :: (a -> b) -> (c -> d) -> ((a, c) -> (b, d)) |
|||
const splitArrow = f => g => |
|||
tpl => Tuple(f(tpl[0]))( |
|||
g(tpl[1]) |
|||
); |
|||
// splitAt :: Int -> [a] -> ([a], [a]) |
|||
const splitAt = n => xs => |
|||
Tuple(xs.slice(0, n))( |
|||
xs.slice(n) |
|||
); |
|||
// succ :: Enum a => a -> a |
|||
const succ = x => 1 + x; |
|||
// uncurry :: (a -> b -> c) -> ((a, b) -> c) |
|||
const uncurry = f => |
|||
function() { |
|||
const |
|||
args = Array.from(arguments), |
|||
a = 1 < args.length ? ( |
|||
args |
|||
) : args[0]; |
|||
return f(a[0])(a[1]); |
|||
}; |
|||
// until :: (a -> Bool) -> (a -> a) -> a -> a |
|||
const until = p => f => x => { |
|||
let v = x; |
|||
while (!p(v)) v = f(v); |
|||
return v; |
|||
}; |
|||
// SAMPLE OUTLINES ------------------------------------ |
|||
const strOutlineA = `Heilmeier catechism |
|||
Objectives and benefits |
|||
What are you trying to do? |
|||
Articulate your objectives using absolutely no jargon. |
|||
What are the problems you address ? |
|||
How is it done today, |
|||
and what are the limits of current practice? |
|||
What is your solution ? |
|||
What is new in your approach |
|||
and why do you think it will be successful? |
|||
Who cares? If you are successful, what difference will it make? |
|||
Costs |
|||
What are the risks? |
|||
How much will it cost? |
|||
How long will it take? |
|||
Indicators |
|||
What are the mid-term and final “exams” to check for success?`; |
|||
const strOutlineB = `Rosetta stone |
|||
is a granodiorite stele |
|||
engraved |
|||
with Greek and Egyptian texts |
|||
in different scripts. |
|||
which shed new light |
|||
on various homologies.`; |
|||
// MAIN --- |
|||
return main(); |
|||
})();</lang> |
|||
{{Out}} |
|||
<pre>Tree structure from outline: |
|||
[ |
|||
[ |
|||
"Rosetta stone", |
|||
[ |
|||
[ |
|||
"is a granodiorite stele", |
|||
[ |
|||
[ |
|||
"engraved", |
|||
[ |
|||
[ |
|||
"with Greek and Egyptian texts", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"in different scripts.", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"which shed new light", |
|||
[ |
|||
[ |
|||
"on various homologies.", |
|||
[] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
Indent levels from tree structure: |
|||
[ |
|||
[ |
|||
0, |
|||
"Rosetta stone" |
|||
], |
|||
[ |
|||
1, |
|||
"is a granodiorite stele" |
|||
], |
|||
[ |
|||
2, |
|||
"engraved" |
|||
], |
|||
[ |
|||
3, |
|||
"with Greek and Egyptian texts" |
|||
], |
|||
[ |
|||
2, |
|||
"in different scripts." |
|||
], |
|||
[ |
|||
1, |
|||
"which shed new light" |
|||
], |
|||
[ |
|||
2, |
|||
"on various homologies." |
|||
] |
|||
] |
|||
Tree structure from indent levels: |
|||
[ |
|||
[ |
|||
"Rosetta stone", |
|||
[ |
|||
[ |
|||
"is a granodiorite stele", |
|||
[ |
|||
[ |
|||
"engraved", |
|||
[ |
|||
[ |
|||
"with Greek and Egyptian texts", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"in different scripts.", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"which shed new light", |
|||
[ |
|||
[ |
|||
"on various homologies.", |
|||
[] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
(Reconstructed tree === parsed tree) -> true</pre> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Procedural=== |
|||
Just arranges the standard lists and tuples for the datastructures allowing pprint to show the different arrangement of storage. |
Just arranges the standard lists and tuples for the datastructures allowing pprint to show the different arrangement of storage. |
||
Line 1,106: | Line 219: | ||
('mocks', |
('mocks', |
||
[('trolling', [])])])</pre> |
[('trolling', [])])])</pre> |
||
===Functional=== |
|||
Using a Node constructor with '''root''' and '''nest''' keys for the value and sub-forest of each tree node, and serialising both trees and nesting-level lists to JSON-compatible formats. |
|||
Functional composition, as an alternative to '''.append()''' and '''.pop()''' mutations. |
|||
(Initial tree constructed as the parse of an outline text) |
|||
{{Works with|Python|3.7}} |
|||
<lang python>'''Tree data structures''' |
|||
from itertools import chain, takewhile |
|||
import json |
|||
# Node :: a -> [Tree a] -> Tree a |
|||
def Node(v): |
|||
'''Constructor for a Tree node which connects a |
|||
value of some kind to a list of zero or |
|||
more child trees. |
|||
''' |
|||
return lambda xs: {'type': 'Tree', 'root': v, 'nest': xs} |
|||
# forestFromNestLevels :: [(Int, a)] -> [Tree a] |
|||
def forestFromNestLevels(tuples): |
|||
'''A list of trees derived from a list of values paired |
|||
with integers giving their levels of indentation. |
|||
''' |
|||
def go(xs): |
|||
if xs: |
|||
(intIndent, v) = xs[0] |
|||
(firstTreeLines, rest) = span( |
|||
lambda x: intIndent < x[0] |
|||
)(xs[1:]) |
|||
return [Node(v)(go(firstTreeLines))] + go(rest) |
|||
else: |
|||
return [] |
|||
return go(tuples) |
|||
# nestLevelsFromForest :: [Tree a] -> [(Int, a)] |
|||
def nestLevelsFromForest(xs): |
|||
'''A flat list of (nest level, value) tuples, |
|||
representing a series of trees. |
|||
''' |
|||
def go(level): |
|||
return lambda node: [(level, node['root'])] + concatMap( |
|||
go(1 + level) |
|||
)(node['nest']) |
|||
return concatMap(go(0))(xs) |
|||
# TEST ---------------------------------------------------- |
|||
# main :: IO () |
|||
def main(): |
|||
'''Conversion from trees to flat lists of nest levels, |
|||
and back again, with each stage shown as a JSON |
|||
string. |
|||
''' |
|||
forestA = forestFromNestLevels( |
|||
indentLevelsFromLines(OUTLINE.splitlines()) |
|||
) |
|||
nestLevels = nestLevelsFromForest(forestA) |
|||
forestB = forestFromNestLevels(nestLevels) |
|||
for x in [ |
|||
'Parse tree from outline text:\n', |
|||
forestJSON(forestA), |
|||
'\nNesting level list from tree:\n', |
|||
json.dumps(nestLevels, indent=2), |
|||
'\nTree rebuilt from nesting level list:\n', |
|||
forestJSON(forestB), |
|||
]: |
|||
print(x) |
|||
print( |
|||
'(Reconstructed forest == parsed forest) -> ' + |
|||
str(forestA == forestB) |
|||
) |
|||
# INITIAL TREE FROM PARSE OF OUTLINE TEXT ----------------- |
|||
# indentLevelsFromLines :: [String] -> [(Int, String)] |
|||
def indentLevelsFromLines(xs): |
|||
'''Each input line stripped of leading |
|||
white space, and tupled with a preceding integer |
|||
giving its level of indentation from 0 upwards. |
|||
''' |
|||
indentTextPairs = [ |
|||
(n, s[n:]) for (n, s) |
|||
in ((len(list(takewhile(isSpace, x))), x) for x in xs) |
|||
] |
|||
indentUnit = min(concatMap( |
|||
lambda x: [x[0]] if x[0] else [] |
|||
)(indentTextPairs)) |
|||
return [ |
|||
(x[0] // indentUnit, x[1]) |
|||
for x in indentTextPairs |
|||
] |
|||
# JSON SERIALISATION -------------------------------------- |
|||
# forestJSON :: [Tree a] -> JSON String |
|||
def forestJSON(trees): |
|||
'''A simple JSON serialisation of a list of trees, with |
|||
each tree node represented as a [value, nodes] pair. |
|||
''' |
|||
return json.dumps( |
|||
forestAsNestedPairs(trees), |
|||
indent=2 |
|||
) |
|||
# forestAsNestedPairs :: [Tree a] -> NestedPair [(a, [NestedPair])] |
|||
def forestAsNestedPairs(xs): |
|||
'''A simple nested pair representation of a tree.''' |
|||
def go(node): |
|||
return [node['root'], [go(x) for x in node['nest']]] |
|||
return [go(x) for x in xs] |
|||
# GENERIC ------------------------------------------------- |
|||
# concatMap :: (a -> [b]) -> [a] -> [b] |
|||
def concatMap(f): |
|||
'''A concatenated list or string over which a function f |
|||
has been mapped. |
|||
The list monad can be derived by using an (a -> [b]) |
|||
function which wraps its output in a list (using an |
|||
empty list to represent computational failure). |
|||
''' |
|||
return lambda xs: (''.join if isinstance(xs, str) else list)( |
|||
chain.from_iterable(map(f, xs)) |
|||
) |
|||
# isSpace :: Char -> Bool |
|||
# isSpace :: String -> Bool |
|||
def isSpace(s): |
|||
'''True if s is not empty, and |
|||
contains only white space. |
|||
''' |
|||
return s.isspace() |
|||
# span :: (a -> Bool) -> [a] -> ([a], [a]) |
|||
def span(p): |
|||
'''The longest (possibly empty) prefix of xs |
|||
that contains only elements satisfying p, |
|||
tupled with the remainder of xs. |
|||
span p xs is equivalent to (takeWhile p xs, dropWhile p xs). |
|||
''' |
|||
def go(xs): |
|||
prefix = list(takewhile(p, xs)) |
|||
return (prefix, xs[len(prefix):]) |
|||
return lambda xs: go(xs) |
|||
# MAIN --- |
|||
if __name__ == '__main__': |
|||
OUTLINE = '''Rosetta stone |
|||
is a granodiorite stele |
|||
engraved |
|||
with Greek and Egyptian texts |
|||
in different scripts. |
|||
which shed new light |
|||
on various homologies.''' |
|||
main()</lang> |
|||
{{Out}} |
|||
<pre>Parse tree from outline text: |
|||
[ |
|||
[ |
|||
"Rosetta stone", |
|||
[ |
|||
[ |
|||
"is a granodiorite stele", |
|||
[ |
|||
[ |
|||
"engraved", |
|||
[ |
|||
[ |
|||
"with Greek and Egyptian texts", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"in different scripts.", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"which shed new light", |
|||
[ |
|||
[ |
|||
"on various homologies.", |
|||
[] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
Nesting level list from tree: |
|||
[ |
|||
[ |
|||
0, |
|||
"Rosetta stone" |
|||
], |
|||
[ |
|||
1, |
|||
"is a granodiorite stele" |
|||
], |
|||
[ |
|||
2, |
|||
"engraved" |
|||
], |
|||
[ |
|||
3, |
|||
"with Greek and Egyptian texts" |
|||
], |
|||
[ |
|||
2, |
|||
"in different scripts." |
|||
], |
|||
[ |
|||
1, |
|||
"which shed new light" |
|||
], |
|||
[ |
|||
2, |
|||
"on various homologies." |
|||
] |
|||
] |
|||
Tree rebuilt from nesting level list: |
|||
[ |
|||
[ |
|||
"Rosetta stone", |
|||
[ |
|||
[ |
|||
"is a granodiorite stele", |
|||
[ |
|||
[ |
|||
"engraved", |
|||
[ |
|||
[ |
|||
"with Greek and Egyptian texts", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"in different scripts.", |
|||
[] |
|||
] |
|||
] |
|||
], |
|||
[ |
|||
"which shed new light", |
|||
[ |
|||
[ |
|||
"on various homologies.", |
|||
[] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
] |
|||
(Reconstructed forest == parsed forest) -> True</pre> |