Tree from nesting levels
Given a flat list of integers greater than zero, representing object nesting
levels, e.g. [1, 2, 4]
,
generate a tree formed from nested lists of those nesting level integers where:
- Every int appears, in order, at its depth of nesting.
- If the next level int is greater than the previous then it appears in a sub-list of the list containing the previous item
The generated tree data structure should ideally be in a languages nested list format that can
be used for further calculations rather than something just calculated for printing.
An input of [1, 2, 4]
should produce the equivalent of: [1, [2, [[4]]]]
where 1 is at depth1, 2 is two deep and 4 is nested 4 deep.
[1, 2, 4, 2, 2, 1]
should produce [1, [2, [[4]], 2, 2], 1]
.
All the nesting integers are in the same order but at the correct nesting
levels.
Similarly [3, 1, 3, 1]
should generate [[[3]], 1, [[3]], 1]
- Task
Generate and show here the results for the following inputs:
[]
[1, 2, 4]
[3, 1, 3, 1]
[1, 2, 3, 1]
[3, 2, 1, 3]
[3, 3, 3, 1, 1, 3, 3, 3]
AppleScript
Iterative
<lang applescript>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</lang>
- Output:
<lang applescript>"{} nests to: {} {1, 2, 4} nests to: {1, {2, Template:4}} {3, 1, 3, 1} nests to: {Template:3, 1, Template:3, 1} {1, 2, 3, 1} nests to: {1, {2, {3}}, 1} {3, 2, 1, 3} nests to: {{{3}, 2}, 1, Template:3} {3, 3, 3, 1, 1, 3, 3, 3} nests to: {Template:3, 3, 3, 1, 1, Template:3, 3, 3}"</lang>
Recursive
Same task code and output as above. <lang applescript>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</lang>
Functional
Mapping from the sparse list format to a generic tree structure, and using both:
- a generic forestFromNestLevels function to map from a normalised input list to a generic tree, and
- a standard catamorphism over trees (foldTree) to generate both the nested list format, and the round-trip regeneration of a sparse list from the generic tree.
<lang applescript>----------------- 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 Template:"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 Template:X, x if 1 = length of xs then h else if 1 < ((item 2 of xs) - x) then set ys to h & Template: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|</lang>
INPUT -> NESTED -> ROUND-TRIP [] -> [] -> [] [1, 2, 4] -> [1, [2, [[4]]]] -> [1, 2, 4] [3, 1, 3, 1] -> [[[3]], 1, [[3]], 1] -> [3, 1, 3, 1] [1, 2, 3, 1] -> [1, [2, [3]], 1] -> [1, 2, 3, 1] [3, 2, 1, 3] -> [[[3], 2], 1, [[3]]] -> [3, 2, 1, 3] [3, 3, 3, 1, 1, 3, 3, 3] -> [[[3, 3, 3]], 1, 1, [[3, 3, 3]]] -> [3, 3, 3, 1, 1, 3, 3, 3]
C++
Uses C++20 <lang cpp>#include <any>
- include <iostream>
- include <iterator>
- include <vector>
using namespace std;
// Make a tree that is a vector of either values or other trees vector<any> MakeTree(input_iterator auto first, input_iterator auto last, int depth = 1) {
vector<any> tree; while (first < last && depth <= *first) { if(*first == depth) { // add a single value tree.push_back(*first); ++first; } else // (depth < *b) { // add a subtree tree.push_back(MakeTree(first, last, depth + 1)); first = find(first + 1, last, depth); } } return tree;
}
// Print an input vector or tree void PrintTree(input_iterator auto first, input_iterator auto last) {
cout << "["; for(auto it = first; it != last; ++it) { if(it != first) cout << ", "; if constexpr (is_integral_v<remove_reference_t<decltype(*first)>>) { // for printing the input vector cout << *it; } else { // for printing the tree if(it->type() == typeid(unsigned int)) { // a single value cout << any_cast<unsigned int>(*it); } else { // a subtree const auto& subTree = any_cast<vector<any>>(*it); PrintTree(subTree.begin(), subTree.end()); } } } cout << "]";
}
int main(void) {
auto execises = vector<vector<unsigned int>> { {}, {1, 2, 4}, {3, 1, 3, 1}, {1, 2, 3, 1}, {3, 2, 1, 3}, {3, 3, 3, 1, 1, 3, 3, 3} }; for(const auto& e : execises) { auto tree = MakeTree(e.begin(), e.end()); PrintTree(e.begin(), e.end()); cout << " Nests to:\n"; PrintTree(tree.begin(), tree.end()); cout << "\n\n"; }
} </lang>
- Output:
[] 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]]]
Go
Iterative
<lang go>package main
import "fmt"
type any = interface{}
func toTree(list []int) any {
s := []any{[]any{}} for _, n := range list { for n != len(s) { if n > len(s) { inner := []any{} s[len(s)-1] = append(s[len(s)-1].([]any), inner) s = append(s, inner) } else { s = s[0 : len(s)-1] } } s[len(s)-1] = append(s[len(s)-1].([]any), n) for i := len(s) - 2; i >= 0; i-- { le := len(s[i].([]any)) s[i].([]any)[le-1] = s[i+1] } } return s[0]
}
func main() {
tests := [][]int{ {}, {1, 2, 4}, {3, 1, 3, 1}, {1, 2, 3, 1}, {3, 2, 1, 3}, {3, 3, 3, 1, 1, 3, 3, 3}, } for _, test := range tests { nest := toTree(test) fmt.Printf("%17s => %v\n", fmt.Sprintf("%v", test), nest) }
}</lang>
- Output:
[] => [] [1 2 4] => [1 [2 [[4]]]] [3 1 3 1] => [[[3]] 1 [[3]] 1] [1 2 3 1] => [1 [2 [3]] 1] [3 2 1 3] => [[[3] 2] 1 [[3]]] [3 3 3 1 1 3 3 3] => [[[3 3 3]] 1 1 [[3 3 3]]]
Recursive
<lang go>package main
import "fmt"
type any = interface{}
func toTree(list []int, index, depth int) (int, []any) {
var soFar []any for index < len(list) { t := list[index] if t == depth { soFar = append(soFar, t) } else if t > depth { var deeper []any index, deeper = toTree(list, index, depth+1) soFar = append(soFar, deeper) } else { index = index - 1 break } index = index + 1 } if depth > 1 { return index, soFar } return -1, soFar
}
func main() {
tests := [][]int{ {}, {1, 2, 4}, {3, 1, 3, 1}, {1, 2, 3, 1}, {3, 2, 1, 3}, {3, 3, 3, 1, 1, 3, 3, 3}, } for _, test := range tests { _, nest := toTree(test, 0, 1) fmt.Printf("%17s => %v\n", fmt.Sprintf("%v", test), nest) }
}</lang>
- Output:
Same as iterative version.
Haskell
The output notation shown here would be rejected by Haskell because of the inconsistency of the types in each 'list' – sometime integer, sometimes list of integer, sometimes list of list of integer etc.
For the task description's format that can be used for further calculations we can turn to Haskell's Data.Tree types, which give us a Forest (a consistently-typed list of Trees), where a single Tree combines some node value with a Forest of Trees.
The node value will have to be a sum type like `Maybe Int`, where implicit Tree nodes (that have no explicit Int value) have a `Nothing` value.
For display purposes, we can either show the list of Tree records directly, or use the drawForest and drawTree functions defined in the standard Data.Tree module.
We can reverse the translation, from tree back to sparse list, without loss of information, by using a standard fold. See sparseLevelsFromTree below:
<lang haskell>{-# LANGUAGE TupleSections #-}
import Data.Bifunctor (bimap) import Data.Tree (Forest, Tree (..), drawTree, foldTree)
TREE FROM NEST LEVELS (AND BACK) -----------
treeFromSparseLevels :: [Int] -> Tree (Maybe Int) treeFromSparseLevels =
Node Nothing . forestFromNestLevels . rooted . normalised
sparseLevelsFromTree :: Tree (Maybe Int) -> [Int] sparseLevelsFromTree = foldTree go
where go Nothing xs = concat xs go (Just x) xs = x : concat xs
forestFromNestLevels :: [(Int, a)] -> Forest a forestFromNestLevels = go
where go [] = [] go ((n, v) : xs) = uncurry (:) $ bimap (Node v . go) go (span ((n <) . fst) xs)
TEST AND DISPLAY -------------------
main :: IO () main =
mapM_ ( \xs -> putStrLn ("From: " <> show xs) >> let tree = treeFromSparseLevels xs in putStrLn ((drawTree . fmap show) tree) >> putStrLn ( "Back to: " <> show (sparseLevelsFromTree tree) <> "\n\n" ) ) [ [], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3] ]
MAPPING TO A STRICTER DATA STRUCTURE ---------
-- Path from the virtual root to the first explicit node. rooted :: [(Int, Maybe Int)] -> [(Int, Maybe Int)] rooted [] = [] rooted xs = go $ filter ((1 <=) . fst) xs
where go xs@((1, mb) : _) = xs go xs@((n, mb) : _) = fmap (,Nothing) [1 .. pred n] <> xs
-- Representation of implicit nodes. normalised [] = [] normalised [x] = [(x, Just x)] normalised (x : y : xs)
| 1 < (y - x) = (x, Just x) : (succ x, Nothing) : normalised (y : xs) | otherwise = (x, Just x) : normalised (y : xs)</lang>
- Output:
From: [] Nothing Back to: [] From: [1,2,4] Nothing | `- Just 1 | `- Just 2 | `- Nothing | `- Just 4 Back to: [1,2,4] From: [3,1,3,1] Nothing | +- Nothing | | | `- Nothing | | | `- Just 3 | +- Just 1 | | | `- Nothing | | | `- Just 3 | `- Just 1 Back to: [3,1,3,1] From: [1,2,3,1] Nothing | +- Just 1 | | | `- Just 2 | | | `- Just 3 | `- Just 1 Back to: [1,2,3,1] From: [3,2,1,3] Nothing | +- Nothing | | | +- Nothing | | | | | `- Just 3 | | | `- Just 2 | `- Just 1 | `- Nothing | `- Just 3 Back to: [3,2,1,3] From: [3,3,3,1,1,3,3,3] Nothing | +- Nothing | | | `- Nothing | | | +- Just 3 | | | +- Just 3 | | | `- Just 3 | +- Just 1 | `- Just 1 | `- Nothing | +- Just 3 | +- Just 3 | `- Just 3 Back to: [3,3,3,1,1,3,3,3]
Julia
<lang julia>function makenested(list)
nesting = 0 str = isempty(list) ? "[]" : "" for n in list if n > nesting str *= "["^(n - nesting) nesting = n elseif n < nesting str *= "]"^(nesting - n) * ", " nesting = n end str *= "$n, " end str *= "]"^nesting return eval(Meta.parse(str))
end
for test in [[], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3]]
result = "$test => $(makenested(test))" println(replace(result, "Any" => ""))
end
</lang>
- Output:
[] => [] [1, 2, 4] => [1, [2, [[4]]]] [3, 1, 3, 1] => [[[3]], 1, [[3]], 1] [1, 2, 3, 1] => [1, [2, [3]], 1] [3, 2, 1, 3] => [[[3], 2], 1, [[3]]] [3, 3, 3, 1, 1, 3, 3, 3] => [[[3, 3, 3]], 1, 1, [[3, 3, 3]]]
Perl
String Eval
<lang perl>#!/usr/bin/perl
use strict; use warnings; use Data::Dump qw(dd pp);
my @tests =
( [] ,[1, 2, 4] ,[3, 1, 3, 1] ,[1, 2, 3, 1] ,[3, 2, 1, 3] ,[3, 3, 3, 1, 1, 3, 3, 3] );
for my $before ( @tests )
{ dd { before => $before }; local $_ = (pp $before) =~ s/\d+/ '['x($&-1) . $& . ']'x($&-1) /ger; 1 while s/\](,\s*)\[/$1/; my $after = eval; dd { after => $after }; }</lang>
- Output:
{ before => [] } { after => [] } { before => [1, 2, 4] } { after => [1, [2, [[4]]]] } { before => [3, 1, 3, 1] } { after => [[[3]], 1, [[3]], 1] } { before => [1, 2, 3, 1] } { after => [1, [2, [3]], 1] } { before => [3, 2, 1, 3] } { after => [[[3], 2], 1, [[3]]] } { before => [3, 3, 3, 1, 1, 3, 3, 3] } { after => [[[3, 3, 3]], 1, 1, [[3, 3, 3]]] }
Iterative
<lang perl>use 5.020_000; # Also turns on `strict` use warnings; use experimental qw<signatures>; use Data::Dump qw<pp>;
sub new_level ( $stack ) {
my $e = []; push @{ $stack->[-1] }, $e; push @{ $stack }, $e;
} sub to_tree_iterative ( @xs ) {
my $nested = []; my $stack = [$nested];
for my $x (@xs) { new_level($stack) while $x > @{$stack}; pop @{$stack} while $x < @{$stack}; push @{$stack->[-1]},$x; }
return $nested;
} my @tests = ([],[1,2,4],[3,1,3,1],[1,2,3,1],[3,2,1,3],[3,3,3,1,1,3,3,3]); say sprintf('%15s => ', join(' ', @{$_})), pp(to_tree_iterative(@{$_})) for @tests;</lang>
- Output:
=> [] 1 2 4 => [1, [2, [[4]]]] 3 1 3 1 => [[[3]], 1, [[3]], 1] 1 2 3 1 => [1, [2, [3]], 1] 3 2 1 3 => [[[3], 2], 1, [[3]]] 3 3 3 1 1 3 3 3 => [[[3, 3, 3]], 1, 1, [[3, 3, 3]]]
Phix
I was thinking along the same lines but admit I had a little peek at the (recursive) python solution.. <lang Phix>function test(sequence s, integer level=1, idx=1)
sequence res = {}, part while idx<=length(s) do switch compare(s[idx],level) do case +1: {idx,part} = test(s,level+1,idx) res = append(res,part) case 0: res &= s[idx] case -1: idx -= 1 exit end switch idx += 1 end while return iff(level=1?res:{idx,res})
end function
constant tests = {{},
{1, 2, 4},
-- {1, 2, 4, 2, 2, 1}, -- (fine too)
{3, 1, 3, 1}, {1, 2, 3, 1}, {3, 2, 1, 3}, {3, 3, 3, 1, 1, 3, 3, 3}}
for i=1 to length(tests) do
sequence ti = tests[i], res = test(ti), rpp = ppf(res,{pp_Nest,3,pp_Indent,4}) printf(1,"%v nests to %v\n or %s\n",{ti,res,rpp})
end for</lang>
- Output:
{} nests to {} or {} {1,2,4} nests to {1,{2,{{4}}}} or {1, {2, {{4}}}} {3,1,3,1} nests to {{{3}},1,{{3}},1} or {{{3}}, 1, {{3}}, 1} {1,2,3,1} nests to {1,{2,{3}},1} or {1, {2, {3}}, 1} {3,2,1,3} nests to {{{3},2},1,{{3}}} or {{{3}, 2}, 1, {{3}}} {3,3,3,1,1,3,3,3} nests to {{{3,3,3}},1,1,{{3,3,3}}} or {{{3, 3, 3}}, 1, 1, {{3, 3, 3}}}
iterative
<lang Phix>function nest(sequence input)
if length(input) then for level=max(input) to 2 by -1 do sequence output = {} bool subnest = false for i=1 to length(input) do object ii = input[i] if integer(ii) and ii<level then subnest = false output &= ii elsif not subnest then output &= Template:Ii subnest = true else output[$] &= {ii} end if end for input = output end for end if return input
end function</lang> Same output (using nest instead of test)
Python
Python: Procedural
Python: Recursive
<lang python>def to_tree(x, index=0, depth=1):
so_far = [] while index < len(x): this = x[index] if this == depth: so_far.append(this) elif this > depth: index, deeper = to_tree(x, index, depth + 1) so_far.append(deeper) else: # this < depth: index -=1 break index += 1 return (index, so_far) if depth > 1 else so_far
if __name__ == "__main__":
from pprint import pformat
def pnest(nest:list, width: int=9) -> str: text = pformat(nest, width=width).replace('\n', '\n ') print(f" OR {text}\n")
exercises = [ [], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3], ] for flat in exercises: nest = to_tree(flat) print(f"{flat} NESTS TO: {nest}") pnest(nest)</lang>
- Output:
[] NESTS TO: [] OR [] [1, 2, 4] NESTS TO: [1, [2, [[4]]]] OR [1, [2, [[4]]]] [3, 1, 3, 1] NESTS TO: [[[3]], 1, [[3]], 1] OR [[[3]], 1, [[3]], 1] [1, 2, 3, 1] NESTS TO: [1, [2, [3]], 1] OR [1, [2, [3]], 1] [3, 2, 1, 3] NESTS TO: [[[3], 2], 1, [[3]]] OR [[[3], 2], 1, [[3]]] [3, 3, 3, 1, 1, 3, 3, 3] NESTS TO: [[[3, 3, 3]], 1, 1, [[3, 3, 3]]] OR [[[3, 3, 3]], 1, 1, [[3, 3, 3]]]
Python: Iterative
<lang python>def to_tree(x: list) -> list:
nested = [] stack = [nested] for this in x: while this != len(stack): if this > len(stack): innermost = [] # new level stack[-1].append(innermost) # nest it stack.append(innermost) # push it else: # this < stack: stack.pop(-1) stack[-1].append(this)
return nested
</lang>
- Output:
Using the same main block it produces the same output as the recursive case above.
Python: Functional
A translation of the sparse level-lists to a stricter generic data structure gives us access to standard tree-walking functions,
allowing for simpler top-level functions, and higher levels of code reuse.
Here, for example, we apply:
- a generic tree-drawing function
- for the return trip from tree to list, a generic catamorphism over trees (foldTree).
<lang python>Tree from nesting levels
from itertools import chain, repeat from operator import add
- treeFromSparseLevels :: [Int] -> Tree Maybe Int
def treeFromSparseLevels(levelList):
A Forest (list of Trees) of (Maybe Int) values, in which implicit nodes have the value Nothing. return Node(Nothing())( forestFromLevels( rooted(normalized(levelList)) ) )
- sparseLevelsFromTree :: Tree (Maybe Int) -> [Int]
def sparseLevelsFromTree(tree):
Sparse representation of the tree a list of nest level integers. def go(x): return lambda xs: concat(xs) if ( x.get('Nothing', False) ) else [x.get('Just', 0)] + concat(xs) return foldTree(go)(tree)
- forestFromLevels :: [(Int, a)] -> [Tree a]
def forestFromLevels(nvs):
A list of generic trees derived from a list of values paired with integers representing nesting depths. def go(xs): if xs: level, v = xs[0] children, rest = span( lambda x: level < x[0] )(xs[1:]) return [Node(v)(go(children))] + go(rest) else: return [] return go(nvs)
- showTree :: Tree Maybe Int -> String
def showTree(tree):
A string representation of a Maybe Int tree. return drawTree( fmapTree(showMaybe)(tree) )
- ------------------------- TEST -------------------------
- main :: IO ()
def main():
Test the building and display of normalized forests from level integers. for xs in [ [], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3] ]: tree = treeFromSparseLevels(xs) ( print('From: ' + repr(xs)), print(showTree(tree)), print( 'Back to: ' + ( repr(sparseLevelsFromTree(tree)) ) ), print() )
- ------ TRANSLATION TO A CONSISTENT DATA STRUCTURE ------
- normalized :: [Int] -> [(Int, Maybe Int)]
def normalized(xs):
Explicit representation of implicit nodes. if xs: x = xs[0] h = [(x, Just(x))] return h if 1 == len(xs) else ( h + [(1 + x, Nothing())] if ( 1 < (xs[1] - x) ) else h ) + normalized(xs[1:]) else: return []
- rooted :: [(Int, Maybe Int)] -> [(Int, Maybe Int)]
def rooted(pairs):
Path from the virtual root to the first explicit node. def go(xs): n = xs[0][0] return xs if 1 == n else ( [(x, Nothing()) for x in range(1, n)] + xs ) return go([ x for x in pairs if 1 <= x[0] ]) if pairs else []
- ---------------- GENERIC TREE FUNCTIONS ----------------
- 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}
- draw :: Tree a -> [String]
def draw(node):
List of the lines of an ASCII diagram of a tree. def shift_(h, other, xs): return list(map( add, chain( [h], ( repeat(other, len(xs) - 1) ) ), xs ))
def drawSubTrees(xs): return ( ( ['|'] + shift_( '├─ ', '│ ', draw(xs[0]) ) + drawSubTrees(xs[1:]) ) if 1 < len(xs) else ['|'] + shift_( '└─ ', ' ', draw(xs[0]) ) ) if xs else []
return (root(node)).splitlines() + ( drawSubTrees(nest(node)) )
- drawForest :: [Tree String] -> String
def drawForest(trees):
A simple unicode character representation of a list of trees. return '\n'.join(map(drawTree, trees))
- drawTree :: Tree a -> String
def drawTree(tree):
ASCII diagram of a tree. return '\n'.join(draw(tree))
- fmapTree :: (a -> b) -> Tree a -> Tree b
def fmapTree(f):
A new tree holding the results of an application of f to each root in the existing tree. def go(x): return Node( f(x['root']) )([go(v) for v in x['nest']]) return go
- foldTree :: (a -> [b] -> b) -> Tree a -> b
def foldTree(f):
The catamorphism on trees. A summary value defined by a depth-first fold. def go(node): return f(root(node))([ go(x) for x in nest(node) ]) return go
- nest :: Tree a -> [Tree a]
def nest(t):
Accessor function for children of tree node. return t.get('nest')
- root :: Tree a -> a
def root(t):
Accessor function for data of tree node. return t.get('root')
- -------------------- GENERIC OTHER ---------------------
- Just :: a -> Maybe a
def Just(x):
Constructor for an inhabited Maybe (option type) value. Wrapper containing the result of a computation. return {'type': 'Maybe', 'Nothing': False, 'Just': x}
- Nothing :: () -> Maybe a
def Nothing():
Constructor for an empty Maybe (option type) value. Empty wrapper returned where a computation is not possible. return {'type': 'Maybe', 'Nothing': True}
- concat :: a -> [a]
- concat :: [String] -> String
def concat(xs):
The concatenation of all the elements in a list or iterable. def f(ys): zs = list(chain(*ys)) return .join(zs) if isinstance(ys[0], str) else zs
return ( f(xs) if isinstance(xs, list) else ( chain.from_iterable(xs) ) ) if xs else []
- showMaybe :: Maybe a -> String
def showMaybe(mb):
Stringification of a Maybe value. return 'Nothing' if ( mb.get('Nothing') ) else 'Just ' + repr(mb.get('Just'))
- 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 match(ab): b = ab[1] return not b or not p(b[0])
def f(ab): a, b = ab return a + [b[0]], b[1:]
def go(xs): return until(match)(f)(([], xs)) return go
- until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
The result of repeatedly applying f until p holds. The initial seed value is x. def go(f): def g(x): v = x while not p(v): v = f(v) return v return g return go
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
From: [] Nothing Back to: [] From: [1, 2, 4] Nothing | └─ Just 1 | └─ Just 2 | └─ Nothing | └─ Just 4 Back to: [1, 2, 4] From: [3, 1, 3, 1] Nothing | ├─ Nothing │ | │ └─ Nothing │ | │ └─ Just 3 | ├─ Just 1 │ | │ └─ Nothing │ | │ └─ Just 3 | └─ Just 1 Back to: [3, 1, 3, 1] From: [1, 2, 3, 1] Nothing | ├─ Just 1 │ | │ └─ Just 2 │ | │ └─ Just 3 | └─ Just 1 Back to: [1, 2, 3, 1] From: [3, 2, 1, 3] Nothing | ├─ Nothing │ | │ ├─ Nothing │ │ | │ │ └─ Just 3 │ | │ └─ Just 2 | └─ Just 1 | └─ Nothing | └─ Just 3 Back to: [3, 2, 1, 3] From: [3, 3, 3, 1, 1, 3, 3, 3] Nothing | ├─ Nothing │ | │ └─ Nothing │ | │ ├─ Just 3 │ | │ ├─ Just 3 │ | │ └─ Just 3 | ├─ Just 1 | └─ Just 1 | └─ Nothing | ├─ Just 3 | ├─ Just 3 | └─ Just 3 Back to: [3, 3, 3, 1, 1, 3, 3, 3]
Raku
Iterative
<lang perl6>sub new_level ( @stack --> Nil ) {
my $e = []; push @stack.tail, $e; push @stack, $e;
} sub to_tree_iterative ( @xs --> List ) {
my $nested = []; my @stack = $nested;
for @xs -> Int $x { new_level(@stack) while $x > @stack; pop @stack while $x < @stack; push @stack.tail, $x; }
return $nested;
} my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3); say .Str.fmt( '%15s => ' ), .&to_tree_iterative for @tests;</lang>
- Output:
=> [] 1 2 4 => [1 [2 [[4]]]] 3 1 3 1 => [[[3]] 1 [[3]] 1] 1 2 3 1 => [1 [2 [3]] 1] 3 2 1 3 => [[[3] 2] 1 [[3]]] 3 3 3 1 1 3 3 3 => [[[3 3 3]] 1 1 [[3 3 3]]]
Recursive
<lang perl6>sub to_tree_recursive ( @list, $index is copy, $depth ) {
my @so_far = gather while $index <= @list.end { my $t = @list[$index];
given $t <=> $depth { when Order::Same { take $t; } when Order::More { ( $index, my $n1 ) = to_tree_recursive( @list, $index, $depth+1 ); take $n1; } when Order::Less { $index--; last; } } $index++; }
my $i = ($depth > 1) ?? $index !! -1; return $i, @so_far;
} my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3); say .Str.fmt( '%15s => ' ), to_tree_recursive( $_, 0, 1 ).[1] for @tests;</lang>
- Output:
=> [] 1 2 4 => [1 [2 [[4]]]] 3 1 3 1 => [[[3]] 1 [[3]] 1] 1 2 3 1 => [1 [2 [3]] 1] 3 2 1 3 => [[[3] 2] 1 [[3]]] 3 3 3 1 1 3 3 3 => [[[3 3 3]] 1 1 [[3 3 3]]]
String Eval
<lang perl6>use MONKEY-SEE-NO-EVAL; sub to_tree_string_eval ( @xs --> Array ) {
my @gap = [ |@xs, 0 ] Z- [ 0, |@xs ];
my @open = @gap.map( '[' x * ); my @close = @gap.map( ']' x -* );
my @wrapped = [Z~] @open, @xs, @close.skip;
return EVAL @wrapped.join(',').subst(:g, ']]', '],]') || '[]';
} my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3); say .Str.fmt( '%15s => ' ), .&to_tree_string_eval for @tests;</lang>
- Output:
=> [] 1 2 4 => [1 [2 [[4]]]] 3 1 3 1 => [[[3]] 1 [[3]] 1] 1 2 3 1 => [1 [2 [3]] 1] 3 2 1 3 => [[[3] 2] 1 [[3]]] 3 3 3 1 1 3 3 3 => [[[3 3 3]] 1 1 [[3 3 3]]]
Wren
Iterative
<lang ecmascript>import "/seq" for Stack import "/fmt" for Fmt
var toTree = Fn.new { |list|
var nested = [] var s = Stack.new() s.push(nested) for (n in list) { while (n != s.count) { if (n > s.count) { var inner = [] s.peek().add(inner) s.push(inner) } else { s.pop() } } s.peek().add(n) } return nested
}
var tests = [
[], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3]
] for (test in tests) {
var nest = toTree.call(test) Fmt.print("$24n => $n", test, nest)
}</lang>
- Output:
[] => [] [1, 2, 4] => [1, [2, [[4]]]] [3, 1, 3, 1] => [[[3]], 1, [[3]], 1] [1, 2, 3, 1] => [1, [2, [3]], 1] [3, 2, 1, 3] => [[[3], 2], 1, [[3]]] [3, 3, 3, 1, 1, 3, 3, 3] => [[[3, 3, 3]], 1, 1, [[3, 3, 3]]]
Recursive
<lang ecmascript>import "/fmt" for Fmt
var toTree // recursive toTree = Fn.new { |list, index, depth|
var soFar = [] while (index < list.count) { var t = list[index] if (t == depth) { soFar.add(t) } else if (t > depth) { var n = toTree.call(list, index, depth+1) index = n[0] soFar.add(n[1]) } else { index = index - 1 break } index = index + 1 } if (depth > 1) return [index, soFar] return [-1, soFar]
}
var tests = [
[], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3]
] for (test in tests) {
var n = toTree.call(test, 0, 1) Fmt.print("$24n => $n", test, n[1])
}</lang>
- Output:
Same as iterative version.