Tree from nesting levels

From Rosetta Code
Task
Tree from nesting levels
You are encouraged to solve this task according to the task description, using any language you may know.

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[edit]

Iterative[edit]

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
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}}}"

Recursive[edit]

Same task code and output as above.

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


Functional[edit]

Mapping from the sparse list format to a generic tree structure, and using both:

  1. a generic forestFromNestLevels function to map from a normalised input list to a generic tree, and
  2. 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.
----------------- 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|
                   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++[edit]

Uses C++20

#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";
    }
}
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]]]

Fōrmulæ[edit]

Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.

Programs in Fōrmulæ are created/edited online in its website, However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.

In this page you can see the program(s) related to this task and their results.

Go[edit]

Iterative[edit]

Translation of: Python
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)
    }
}
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[edit]

Translation of: Python
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)
    }
}
Output:
Same as iterative version.

Guile[edit]

;; helper function that finds the rest that are less than or equal
(define (rest-less-eq x ls)
    (cond
      ((null? ls) #f)
      ((<= (car ls) x) ls)
      (else (rest-less-eq x (cdr ls)))))

;; nest the input as a tree
(define (make-tree input depth)
  (cond
   ((null? input) '())
   ((eq? input #f ) '())
   ((= depth (car input))
    (cons (car input)(make-tree(cdr input) depth)))
   ((< depth (car input))
    (cons (make-tree input (+ depth 1))
	  (make-tree (rest-less-eq depth input) depth))) 
   (#t '())
   ))

(define examples
  '(()
    (1 2 4)
    (3 1 3 1)
    (1 2 3 1)
    (3 2 1 3)
    (3 3 3 1 1 3 3 3)))

(define (run-examples x)
  (if (null? x) '()
      (begin
	(display (car x))(display " -> ")
	(display (make-tree(car x) 1))(display "\n")
	(run-examples (cdr x)))))

(run-examples examples)
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)))

Haskell[edit]

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:

{-# 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)
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]

J[edit]

Without any use cases for these trees, it's difficult to know if any implementation is correct.

As a side note here, the notation used to describe these trees has some interesting consequences in the context of J:

   [[[3]], 1, [[3]], 1
1 1
   [[[3]], 1, [[3]], 1]
|syntax error

But, on a related note, there are type issues to consider -- in J's type system, a box (which is what we would use here to represent a tree node) cannot exist in a tuple with an integer. A box can, however, contain an integer. This makes a literal interpretation of the task somewhat... difficult. We might, hypothetically, say that we are working with boxes containing integers and that it's these boxes which must achieve a specific nesting level. (If we fail to make this distinction then we wind up with a constraint which forces some tree nodes to be structured different from what appears to be the task specification. Whether or not this is an important issue is difficult to determine without use cases. So, for now, let's assume that this is an important distinction.)

Anyways, here's an interpretation which might be close enough to the task description:

NB. first we nest each integer to the required depth, independently
NB. then we recursively merge deep boxes
NB. for consistency, if there are no integers, we box that empty list
dtree=: {{
  <^:(0=L.) merge <^:]each y
}}

merge=: {{
  if.(0=#$y)+.2>L.y do.y return.end.   NB. done if no deep boxes left
  shallow=. 2 > L."0 y                 NB. locate shallow boxes
  group=. shallow} (+/\ shallow),:-#\y NB. find groups of adjacent deep boxes
  merge each group ,each//. y          NB. combine them and recursively merge their contents
}}

Task example:

   dtree ''
┌┐
││
└┘
   dtree 1 2 4
┌─────────────┐
│┌─┬─────────┐│
││1│┌─┬─────┐││
││ ││2│┌───┐│││
││ ││ ││┌─┐││││
││ ││ │││4│││││
││ ││ ││└─┘││││
││ ││ │└───┘│││
││ │└─┴─────┘││
│└─┴─────────┘│
└─────────────┘
   dtree 3 1 3 1
┌─────────────────┐
│┌─────┬─┬─────┬─┐│
││┌───┐│1│┌───┐│1││
│││┌─┐││ ││┌─┐││ ││
││││3│││ │││3│││ ││
│││└─┘││ ││└─┘││ ││
││└───┘│ │└───┘│ ││
│└─────┴─┴─────┴─┘│
└─────────────────┘
   dtree 1 2 3 1
┌─────────────┐
│┌─┬───────┬─┐│
││1│┌─┬───┐│1││
││ ││2│┌─┐││ ││
││ ││ ││3│││ ││
││ ││ │└─┘││ ││
││ │└─┴───┘│ ││
│└─┴───────┴─┘│
└─────────────┘
   dtree 3 2 1 3
┌─────────────────┐
│┌───────┬─┬─────┐│
││┌───┬─┐│1│┌───┐││
│││┌─┐│2││ ││┌─┐│││
││││3││ ││ │││3││││
│││└─┘│ ││ ││└─┘│││
││└───┴─┘│ │└───┘││
│└───────┴─┴─────┘│
└─────────────────┘
   dtree 3 3 3 1 1 3 3 3
┌─────────────────────────┐
│┌─────────┬─┬─┬─────────┐│
││┌───────┐│11│┌───────┐││
│││┌─┬─┬─┐││  ││┌─┬─┬─┐│││
││││333│││  │││333││││
│││└─┴─┴─┘││  ││└─┴─┴─┘│││
││└───────┘│  │└───────┘││
│└─────────┴─┴─┴─────────┘│
└─────────────────────────┘

Note that merge does not concern itself with the contents of boxes, only their nesting depth. This means that we could replace the implementation of dtree with some similar mechanism if we wished to use this approach with something else. For example:

   t=: ;:'(a b c) d (e f g)'
   p=: ;:'()'
   d=: +/\-/p=/t
   k=: =/p=/t
   merge d <@]^:[&.>&(k&#) t
┌───────┬─┬───────┐
│┌─┬─┬─┐│d│┌─┬─┬─┐│
││abc││ ││efg││
│└─┴─┴─┘│ │└─┴─┴─┘│
└───────┴─┴───────┘

Or, generalizing:

pnest=: {{
   t=. ;:y                   NB. tokens
   p=. (;:'()')=/t           NB. paren token matches
   d=: +/\-/p                NB. paren token depths
   k=: =/p                   NB. keep non-paren tokens
   merge d <@]^:[&.>&(k&#) t NB. exercise task
}}

Example use:

   pnest '((a b) c (d e) f) g (h i)'
┌─────────────────┬─┬─────┐
│┌─────┬─┬─────┬─┐│g│┌─┬─┐│
││┌─┬─┐│c│┌─┬─┐│f││ ││hi││
│││ab││ ││de││ ││ │└─┴─┘│
││└─┴─┘│ │└─┴─┘│ ││      
│└─────┴─┴─────┴─┘│      
└─────────────────┴─┴─────┘

Julia[edit]

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
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]]]

Nim[edit]

In a strongly and statically typed language as Nim, there is no way to mix integer values and lists. So, we have defined a variant type Node able to contain either an integer value or a list of Node objects, depending on the value of a discriminator. The procedure newTree converts a list of levels into a list of nodes with the appropriate nesting.

import sequtils, strutils

type
  Kind = enum kValue, kList
  Node = ref object
    case kind: Kind
    of kValue: value: int
    of kList: list: seq[Node]


proc newTree(s: varargs[int]): Node =
  ## Build a tree from a list of level values.
  var level = 1
  result = Node(kind: kList)
  var stack = @[result]
  for n in s:
    if n <= 0:
      raise newException(ValueError, "expected a positive integer, got " & $n)
    let node = Node(kind: kValue, value: n)
    if n < level:
      # Unstack lists.
      stack.setLen(n)
      level = n
    else:
      while n > level:
        # Create intermediate lists.
        let newList = Node(kind: kList)
        stack[^1].list.add newList
        stack.add newList
        inc level
    # Add value.
    stack[^1].list.add node


proc `$`(node: Node): string =
  ## Display a tree using a nested lists representation.
  if node.kind == kValue: $node.value
  else: '[' & node.list.mapIt($it).join(", ") & ']'


for list in [newSeq[int](),   # Empty list (== @[]).
             @[1, 2, 4],
             @[3, 1, 3, 1],
             @[1, 2, 3, 1],
             @[3, 2, 1, 3],
             @[3, 3, 3, 1, 1, 3, 3, 3]]:
  echo ($list).align(25), " → ", newTree(list)
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]]]

OxygenBasic[edit]

uses console
declare DemoTree(string src)
DemoTree "[]"
DemoTree "[1, 2, 4]"
DemoTree "[3, 1, 3, 1]"
DemoTree "[1, 2, 3, 1]"
DemoTree "[3, 2, 1, 3]"
DemoTree "[3, 3, 3, 1, 1, 3, 3, 3]"
pause
end

/*
RESULTS:
========

[]
[]

[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]]]
*/



sub DemoTree(string src)
========================

string tree=nuls 1000   'TREE OUTPUT
int i=1                 'src char iterator
int j=1                 'tree char iterator
byte bs at strptr src   'src bytes
byte bt at strptr tree  'tree bytes
int bl=len src          'end of src
int lvl                 'current tree level
int olv                 'prior tree level
int v                   'number value
string vs               'number in string form

do
  exit if i>bl
  select bs[i]
  case 91 '['
    i++
  case 93 ']'
    if i=bl
      gosub writex
    endif
    i++
  case 44 ','
    i++
    gosub writex
  case 0 to 32 'white space
    i++
    'bt[j]=" " : j++
  case 48 to 57 '0..9'
    gosub ReadDigits
  case else
    i++
  end select
loop
tree=left(tree,j-1)
output src cr
output tree cr cr
exit sub

'SUBROUTINES OF DEMOTREE:
=========================

writex:
=======
olv=lvl
  if i>=bl
    if v=0 and olv=0
      tree="[]" : j=3
      ret
    endif
  endif
  if v<olv
    gosub WriteRbr
  endif
  if olv
    gosub WriteComma
  endif
  if v>olv
    gosub WriteLbr
  endif
  gosub WriteDigits '3]]'
  if i>=bl
    v=0
    gosub WriteRbr
  endif
ret

ReadDigits:
===========
v=0
while i<=bl
  select bs[i]
  case 48 to 57 '1..9
    v*=10 : v+=bs[i]-48 'digit
  case else
    exit while
  end select
  i++
wend
ret
'
WriteDigits:
============
vs=" "+str(v) : mid(tree,j,vs) : j+=len vs
ret

WriteLbr:
=========
while v>lvl
  bt[j]=91 : j++ : lvl++
wend
ret

WriteRbr:
=========
while v<lvl
  bt[j]=93 : j++ : lvl--
wend
ret

WriteComma:
===========
bt[j]=44 : j++ ','
ret

end sub

Perl[edit]

String Eval[edit]

#!/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 };
  }
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[edit]

Translation of: Raku
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;
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[edit]

I was thinking along the same lines but admit I had a little peek at the (recursive) python solution..

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
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[edit]

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 &= {{ii}}
                    subnest = true
                else
                    output[$] &= {ii}
                end if
            end for
            input = output
        end for
    end if
    return input
end function

Same output (using nest instead of test)

Python[edit]

Python: Procedural[edit]

Python: Recursive[edit]

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)
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[edit]

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
Output:

Using the same main block it produces the same output as the recursive case above.

Python: Functional[edit]

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:

  1. a generic tree-drawing (drawTree) function, and
  2. a generic catamorphism over trees (foldTree) for:
the generation of a bracket-nest from an underlying tree, and
a return-trip regeneration of the sparse level list from the same tree.

Each node in the underlying tree structure is a tuple of a value (None or an integer), and list of child nodes:

Node (None|Int) :: ((None|Int), [Node])
'''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 None.
    '''
    return Node(None)(
        forestFromLevels(
            rooted(normalized(levelList))
        )
    )


# 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)


# bracketNest :: Maybe Int -> Nest -> Nest
def bracketNest(maybeLevel):
    '''An arbitrary nest of bracketed
       lists and sublists.
    '''
    def go(xs):
        subNest = concat(xs)
        return [subNest] if None is maybeLevel else (
            [maybeLevel, subNest] if subNest else (
                [maybeLevel]
            )
        )
    return go


# showTree :: Tree Maybe Int -> String
def showTree(tree):
    '''A string representation of
       a Maybe Int tree.
    '''
    return drawTree(
        fmapTree(repr)(tree)
    )


# 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 (
            None is x
        ) else [x] + concat(xs)
    return foldTree(go)(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('Through tuple nest:'),
            print(repr(tree)),
            print('\nTree:'),
            print(showTree(tree)),
            print('\nto bracket nest:'),
            print(
                repr(
                    root(foldTree(bracketNest)(tree))
                )
            ),
            print(
                'and 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, x)]
        return h if 1 == len(xs) else (
            h + [(1 + x, None)] 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: (v, 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(root(x))
        )([go(v) for v in nest(x)])
    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[1]


# root :: Tree a -> a
def root(t):
    '''Accessor function for data of tree node.'''
    return t[0]


# -------------------- GENERIC OTHER ---------------------

# Nothing :: () -> Maybe a
def Nothing():
    '''Constructor for an empty Maybe (option type) value.
       Empty wrapper returned where a computation is not possible.
    '''
    return None


# 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 []


# 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()
Output:
From: []
Through tuple nest:
(None, [])

Tree:
None

to bracket nest:
[]
and back to: []

From: [1, 2, 4]
Through tuple nest:
(None, [(1, [(2, [(None, [(4, [])])])])])

Tree:
None
|
└─ 1
   |
   └─ 2
      |
      └─ None
         |
         └─ 4

to bracket nest:
[1, [2, [[4]]]]
and back to: [1, 2, 4]

From: [3, 1, 3, 1]
Through tuple nest:
(None, [(None, [(None, [(3, [])])]), (1, [(None, [(3, [])])]), (1, [])])

Tree:
None
|
├─ None
│  |
│  └─ None
│     |
│     └─ 3
|
├─ 1
│  |
│  └─ None
│     |
│     └─ 3
|
└─ 1

to bracket nest:
[[[3]], 1, [[3]], 1]
and back to: [3, 1, 3, 1]

From: [1, 2, 3, 1]
Through tuple nest:
(None, [(1, [(2, [(3, [])])]), (1, [])])

Tree:
None
|
├─ 1
│  |
│  └─ 2
│     |
│     └─ 3
|
└─ 1

to bracket nest:
[1, [2, [3]], 1]
and back to: [1, 2, 3, 1]

From: [3, 2, 1, 3]
Through tuple nest:
(None, [(None, [(None, [(3, [])]), (2, [])]), (1, [(None, [(3, [])])])])

Tree:
None
|
├─ None
│  |
│  ├─ None
│  │  |
│  │  └─ 3
│  |
│  └─ 2
|
└─ 1
   |
   └─ None
      |
      └─ 3

to bracket nest:
[[[3], 2], 1, [[3]]]
and back to: [3, 2, 1, 3]

From: [3, 3, 3, 1, 1, 3, 3, 3]
Through tuple nest:
(None, [(None, [(None, [(3, []), (3, []), (3, [])])]), (1, []), (1, [(None, [(3, []), (3, []), (3, [])])])])

Tree:
None
|
├─ None
│  |
│  └─ None
│     |
│     ├─ 3
│     |
│     ├─ 3
│     |
│     └─ 3
|
├─ 1
|
└─ 1
   |
   └─ None
      |
      ├─ 3
      |
      ├─ 3
      |
      └─ 3

to bracket nest:
[[[3, 3, 3]], 1, 1, [[3, 3, 3]]]
and back to: [3, 3, 3, 1, 1, 3, 3, 3]

Quackery[edit]

  [ stack ]                       is prev     (   --> s )

  [ temp take
    swap join
    temp put ]                    is add$     ( x -->   )

  [ dup [] = if done
    0 prev put
    $ "' " temp put
    witheach
      [ dup prev take -
        over prev put
        dup 0 > iff
          [ times
              [ $ "[ " add$ ] ]
        else
          [ abs times
              [ $ "] " add$ ] ]
        number$ space join add$ ]
    prev take times
      [ $ "] " add$ ]
    temp take quackery ]          is nesttree ( [ --> [ )

  ' [ [ ]
      [ 1 2 4 ]
      [ 3 1 3 1 ]
      [ 1 2 3 1 ]
      [ 3 2 1 3 ]
      [ 3 3 3 1 1 3 3 3 ] ]

  witheach
    [ dup echo say " --> "
      nesttree echo cr cr ]
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 ] ] ]

Raku[edit]

Iterative[edit]

Translation of: Python
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;
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[edit]

Translation of: Python
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;
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[edit]

Translation of: Perl
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;
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[edit]

Iterative[edit]

Translation of: Python
Library: Wren-seq
Library: Wren-fmt
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)
}
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[edit]

Translation of: Python
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])
}
Output:
Same as iterative version.