aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Task/Visualize-a-tree/00META.yaml Normal file
View file

@ -0,0 +1 @@
--- {}

571
Task/Visualize-a-tree/AppleScript/visualize-a-tree.applescript Normal file
View file

@ -0,0 +1,571 @@
-- Vertically centered textual tree using UTF8 monospaced
-- box-drawing characters, with options for compacting
-- and pruning.
-- ┌── Gamma
-- ┌─ Beta ┼── Delta
-- │ └ Epsilon
-- Alpha ┼─ Zeta ───── Eta
-- │ ┌─── Iota
-- └ Theta ┼── Kappa
-- └─ Lambda
-- TESTS --------------------------------------------------
on run
set tree to Node(1, ¬
{Node(2, ¬
{Node(4, {Node(7, {})}), ¬
Node(5, {})}), ¬
Node(3, ¬
{Node(6, ¬
{Node(8, {}), Node(9, {})})})})
set tree2 to Node("Alpha", ¬
{Node("Beta", ¬
{Node("Gamma", {}), ¬
Node("Delta", {}), ¬
Node("Epsilon", {})}), ¬
Node("Zeta", {Node("Eta", {})}), ¬
Node("Theta", ¬
{Node("Iota", {}), Node("Kappa", {}), ¬
Node("Lambda", {})})})
set strTrees to unlines({"(NB – view in mono-spaced font)\n\n", ¬
"Compacted (not all parents vertically centered):\n", ¬
drawTree2(true, false, tree), ¬
"\nFully expanded and vertically centered:\n", ¬
drawTree2(false, false, tree2), ¬
"\nVertically centered, with nodeless lines pruned out:\n", ¬
drawTree2(false, true, tree2)})
set the clipboard to strTrees
strTrees
end run
-- drawTree2 :: Bool -> Bool -> Tree String -> String
on drawTree2(blnCompressed, blnPruned, tree)
-- Tree design and algorithm inspired by the Haskell snippet at:
-- https://doisinkidney.com/snippets/drawing-trees.html
script measured
on |λ|(t)
script go
on |λ|(x)
set s to " " & x & " "
Tuple(length of s, s)
end |λ|
end script
fmapTree(go, t)
end |λ|
end script
set measuredTree to |λ|(tree) of measured
script levelMax
on |λ|(a, level)
a & maximum(map(my fst, level))
end |λ|
end script
set levelWidths to foldl(levelMax, {}, ¬
init(levels(measuredTree)))
-- Lefts, Mid, Rights
script lmrFromStrings
on |λ|(xs)
set {ls, rs} to items 2 thru -2 of ¬
(splitAt((length of xs) div 2, xs) as list)
Tuple3(ls, item 1 of rs, rest of rs)
end |λ|
end script
script stringsFromLMR
on |λ|(lmr)
script add
on |λ|(a, x)
a & x
end |λ|
end script
foldl(add, {}, items 2 thru -2 of (lmr as list))
end |λ|
end script
script fghOverLMR
on |λ|(f, g, h)
script
property mg : mReturn(g)
on |λ|(lmr)
set {ls, m, rs} to items 2 thru -2 of (lmr as list)
Tuple3(map(f, ls), |λ|(m) of mg, map(h, rs))
end |λ|
end script
end |λ|
end script
script lmrBuild
on leftPad(n)
script
on |λ|(s)
replicateString(n, space) & s
end |λ|
end script
end leftPad
-- lmrBuild main
on |λ|(w, f)
script
property mf : mReturn(f)
on |λ|(wsTree)
set xs to nest of wsTree
set lng to length of xs
set {nChars, x} to items 2 thru -2 of ¬
((root of wsTree) as list)
set _x to replicateString(w - nChars, "─") & x
-- LEAF NODE ------------------------------------
if 0 = lng then
Tuple3({}, _x, {})
else if 1 = lng then
-- NODE WITH SINGLE CHILD ---------------------
set indented to leftPad(1 + w)
script lineLinked
on |λ|(z)
_x & "─" & z
end |λ|
end script
|λ|(|λ|(item 1 of xs) of mf) of ¬
(|λ|(indented, lineLinked, indented) of ¬
fghOverLMR)
else
-- NODE WITH CHILDREN -------------------------
script treeFix
on cFix(x)
script
on |λ|(xs)
x & xs
end |λ|
end script
end cFix
on |λ|(l, m, r)
compose(stringsFromLMR, ¬
|λ|(cFix(l), cFix(m), cFix(r)) of ¬
fghOverLMR)
end |λ|
end script
script linked
on |λ|(s)
set c to text 1 of s
set t to tail(s)
if "┌" = c then
_x & "┬" & t
else if "│" = c then
_x & "┤" & t
else if "├" = c then
_x & "┼" & t
else
_x & "┴" & t
end if
end |λ|
end script
set indented to leftPad(w)
set lmrs to map(f, xs)
if blnCompressed then
set sep to {}
else
set sep to {"│"}
end if
tell lmrFromStrings
set tupleLMR to |λ|(intercalate(sep, ¬
{|λ|(item 1 of lmrs) of ¬
(|λ|(" ", "┌", "│") of treeFix)} & ¬
map(|λ|("│", "├", "│") of treeFix, ¬
init(tail(lmrs))) & ¬
{|λ|(item -1 of lmrs) of ¬
(|λ|("│", "└", " ") of treeFix)}))
end tell
|λ|(tupleLMR) of ¬
(|λ|(indented, linked, indented) of fghOverLMR)
end if
end |λ|
end script
end |λ|
end script
set treeLines to |λ|(|λ|(measuredTree) of ¬
foldr(lmrBuild, 0, levelWidths)) of stringsFromLMR
if blnPruned then
script notEmpty
on |λ|(s)
script isData
on |λ|(c)
"│ " does not contain c
end |λ|
end script
any(isData, characters of s)
end |λ|
end script
set xs to filter(notEmpty, treeLines)
else
set xs to treeLines
end if
unlines(xs)
end drawTree2
-- 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
-- Tuple3 (,,) :: a -> b -> c -> (a, b, c)
on Tuple3(x, y, z)
{type:"Tuple3", |1|:x, |2|:y, |3|:z, length:3}
end Tuple3
-- Applied to a predicate and a list,
-- |any| returns true if at least one element of the
-- list satisfies the predicate.
-- any :: (a -> Bool) -> [a] -> Bool
on any(f, xs)
tell mReturn(f)
set lng to length of xs
repeat with i from 1 to lng
if |λ|(item i of xs) then return true
end repeat
false
end tell
end any
-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
script
property mf : mReturn(f)
property mg : mReturn(g)
on |λ|(x)
|λ|(|λ|(x) of mg) of mf
end |λ|
end script
end compose
-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
set lng to length of xs
if 0 < lng and string is class of (item 1 of xs) then
set acc to ""
else
set acc to {}
end if
repeat with i from 1 to lng
set acc to acc & item i of xs
end repeat
acc
end concat
-- 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
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if |λ|(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- fmapTree :: (a -> b) -> Tree a -> Tree b
on fmapTree(f, tree)
script go
property g : |λ| of mReturn(f)
on |λ|(x)
set xs to nest of x
if xs ≠ {} then
set ys to map(go, xs)
else
set ys to xs
end if
Node(g(root of x), ys)
end |λ|
end script
|λ|(tree) of go
end fmapTree
-- 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
-- foldr :: (a -> b -> b) -> b -> [a] -> b
on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from lng to 1 by -1
set v to |λ|(item i of xs, v, i, xs)
end repeat
return v
end tell
end foldr
-- 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
-- identity :: a -> a
on identity(x)
-- The argument unchanged.
x
end identity
-- init :: [a] -> [a]
-- init :: [String] -> [String]
on init(xs)
set blnString to class of xs = string
set lng to length of xs
if lng > 1 then
if blnString then
text 1 thru -2 of xs
else
items 1 thru -2 of xs
end if
else if lng > 0 then
if blnString then
""
else
{}
end if
else
missing value
end if
end init
-- intercalate :: [a] -> [[a]] -> [a]
-- intercalate :: String -> [String] -> String
on intercalate(sep, xs)
concat(intersperse(sep, xs))
end intercalate
-- intersperse(0, [1,2,3]) -> [1, 0, 2, 0, 3]
-- intersperse :: a -> [a] -> [a]
-- intersperse :: Char -> String -> String
on intersperse(sep, xs)
set lng to length of xs
if lng > 1 then
set acc to {item 1 of xs}
repeat with i from 2 to lng
set acc to acc & {sep, item i of xs}
end repeat
if class of xs is string then
concat(acc)
else
acc
end if
else
xs
end if
end intersperse
-- isNull :: [a] -> Bool
-- isNull :: String -> Bool
on isNull(xs)
if class of xs is string then
"" = xs
else
{} = xs
end if
end isNull
-- iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
on iterateUntil(p, f, x)
script
property mp : mReturn(p)'s |λ|
property mf : mReturn(f)'s |λ|
property lst : {x}
on |λ|(v)
repeat until mp(v)
set v to mf(v)
set end of lst to v
end repeat
return lst
end |λ|
end script
|λ|(x) of result
end iterateUntil
-- levels :: Tree a -> [[a]]
on levels(tree)
script nextLayer
on |λ|(xs)
script
on |λ|(x)
nest of x
end |λ|
end script
concatMap(result, xs)
end |λ|
end script
script roots
on |λ|(xs)
script
on |λ|(x)
root of x
end |λ|
end script
map(result, xs)
end |λ|
end script
map(roots, iterateUntil(my isNull, nextLayer, {tree}))
end levels
-- 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
-- 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
-- replicateString :: Int -> String -> String
on replicateString(n, s)
set out to ""
if n < 1 then return out
set dbl to s
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicateString
-- 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
-- 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
-- tail :: [a] -> [a]
on tail(xs)
set blnText to text is class of xs
if blnText then
set unit to ""
else
set unit to {}
end if
set lng to length of xs
if 1 > lng then
missing value
else if 2 > lng then
unit
else
if blnText then
text 2 thru -1 of xs
else
rest of xs
end if
end if
end tail
-- 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 str to xs as text
set my text item delimiters to dlm
str
end unlines

89
Task/Visualize-a-tree/Elena/visualize-a-tree.elena
View file

@ -1,67 +1,64 @@
import system'routines.
import extensions.
import system'routines;
import extensions;
class Node
{
object theValue.
object theChildren.
string theValue;
Node[] theChildren;
constructor new : value children:children
[
theValue := value.
constructor new(string value, Node[] children)
{
theValue := value;
theChildren := children toArray.
]
theChildren := children;
}
constructor new : value
<= new:value children:nil.
constructor new(string value)
<= new(value, new Node[](0));
constructor new children:children
<= new:emptyLiteralValue children:children.
constructor new(Node[] children)
<= new(emptyString, children);
constructor new : value child:child
<= new:value children(Array new object:child).
get() = theValue;
get = theValue.
children = theChildren.
Children = theChildren;
}
extension treeOp
{
writeTree : node : prefix : childrenProp
[
var children := node~childrenProp get.
var length := children length.
writeTree(node, prefix)
{
var children := node.Children;
var length := children.Length;
children zip(RangeEnumerator new from:1 to:length) forEach(:child:index)
[
self printLine(prefix,"|").
self printLine(prefix,"+---",child get).
children.zipForEach(new Range(1, length), (child,index)
{
self.printLine(prefix,"|");
self.printLine(prefix,"+---",child.get());
var nodeLine := prefix + (index==length)iif(" ","| ").
var nodeLine := prefix + (index==length).iif(" ","| ");
self writeTree(child,nodeLine,childrenProp).
].
self.writeTree(child,nodeLine);
});
^ self.
]
^ self
}
writeTree : node : childrenProp
= self~treeOp writeTree(node,"",childrenProp).
writeTree(node)
= self.writeTree(node,"");
}
program =
[
var tree := Node new children:
(
Node new:"a" children:
(
Node new:"b" child:(Node new:"c"),
Node new:"d"
),
Node new:"e"
).
public program()
{
var tree := Node.new(
new Node[]{
Node.new("a", new Node[]
{
Node.new("b", new Node[]{Node.new("c")}),
Node.new("d")
}),
Node.new("e")
});
console writeTree(tree, %children); readChar.
].
console.writeTree(tree).readChar()
}

6
Task/Visualize-a-tree/Factor/visualize-a-tree-1.factor Normal file
View file

@ -0,0 +1,6 @@
USE: literals
CONSTANT: mammals { "mammals" { "deer" "gorilla" "dolphin" } }
CONSTANT: reptiles { "reptiles" { "turtle" "lizard" "snake" } }
{ "animals" ${ mammals reptiles } } dup . 10 margin set .

2
Task/Visualize-a-tree/Factor/visualize-a-tree-2.factor Normal file
View file

@ -0,0 +1,2 @@
USE: trees.avl
AVL{ { 1 2 } { 9 19 } { 3 4 } { 5 6 } } .

0
Task/Visualize-a-tree/Haskell/visualize-a-tree.hs → Task/Visualize-a-tree/Haskell/visualize-a-tree-1.hs
View file

12
Task/Visualize-a-tree/Haskell/visualize-a-tree-2.hs Normal file
View file

@ -0,0 +1,12 @@
import Data.Tree (Tree(..), drawTree)
tree :: Tree Int
tree =
Node
1
[ Node 2 [Node 4 [Node 7 []], Node 5 []]
, Node 3 [Node 6 [Node 8 [], Node 9 []]]
]
main :: IO ()
main = (putStrLn . drawTree . fmap show) tree

0
Task/Visualize-a-tree/JavaScript/visualize-a-tree.js → Task/Visualize-a-tree/JavaScript/visualize-a-tree-1.js
View file

300
Task/Visualize-a-tree/JavaScript/visualize-a-tree-2.js Normal file
View file

@ -0,0 +1,300 @@
(() => {
'use strict';
// UTF8 character-drawn tree, with options for compacting vs
// centering parents, and for pruning out nodeless lines.
const example = `
┌ Epsilon
┌─ Beta ┼─── Zeta
│ └──── Eta
Alpha ┼ Gamma ─── Theta
│ ┌─── Iota
└ Delta ┼── Kappa
└─ Lambda`
// drawTree2 :: Bool -> Bool -> Tree String -> String
const drawTree2 = blnCompact => blnPruned => tree => {
// Tree design and algorithm inspired by the Haskell snippet at:
// https://doisinkidney.com/snippets/drawing-trees.html
const
// Lefts, Middle, Rights
lmrFromStrings = xs => {
const [ls, rs] = Array.from(splitAt(
Math.floor(xs.length / 2),
xs
));
return Tuple3(ls, rs[0], rs.slice(1));
},
stringsFromLMR = lmr =>
Array.from(lmr).reduce((a, x) => a.concat(x), []),
fghOverLMR = (f, g, h) => lmr => {
const [ls, m, rs] = Array.from(lmr);
return Tuple3(ls.map(f), g(m), rs.map(h));
};
const lmrBuild = (f, w) => wsTree => {
const
leftPad = n => s => ' '.repeat(n) + s,
xs = wsTree.nest,
lng = xs.length,
[nChars, x] = Array.from(wsTree.root);
// LEAF NODE --------------------------------------
return 0 === lng ? (
Tuple3([], '─'.repeat(w - nChars) + x, [])
// NODE WITH SINGLE CHILD -------------------------
) : 1 === lng ? (() => {
const indented = leftPad(1 + w);
return fghOverLMR(
indented,
z => '─'.repeat(w - nChars) + x + '─' + z,
indented
)(f(xs[0]));
// NODE WITH CHILDREN -----------------------------
})() : (() => {
const
cFix = x => xs => x + xs,
treeFix = (l, m, r) => compose(
stringsFromLMR,
fghOverLMR(cFix(l), cFix(m), cFix(r))
),
_x = '─'.repeat(w - nChars) + x,
indented = leftPad(w),
lmrs = xs.map(f);
return fghOverLMR(
indented,
s => _x + ({
'┌': '┬',
'├': '┼',
'│': '┤',
'└': '┴'
})[s[0]] + s.slice(1),
indented
)(lmrFromStrings(
intercalate(
blnCompact ? [] : ['│'],
[treeFix(' ', '┌', '│')(lmrs[0])]
.concat(init(lmrs.slice(1)).map(
treeFix('│', '├', '│')
))
.concat([treeFix('│', '└', ' ')(
lmrs[lmrs.length - 1]
)])
)
));
})();
};
const
measuredTree = fmapTree(
v => {
const s = ' ' + v + ' ';
return Tuple(s.length, s)
}, tree
),
levelWidths = init(levels(measuredTree))
.reduce(
(a, level) => a.concat(maximum(level.map(fst))),
[]
),
treeLines = stringsFromLMR(
levelWidths.reduceRight(
lmrBuild, x => x
)(measuredTree)
);
return unlines(
blnPruned ? (
treeLines.filter(
s => s.split('')
.some(c => !' │'.includes(c))
)
) : treeLines
);
};
// TESTS ----------------------------------------------
const main = () => {
// tree :: Tree String
const tree = Node(
'Alpha', [
Node('Beta', [
Node('Epsilon', []),
Node('Zeta', []),
Node('Eta', [])
]),
Node('Gamma', [Node('Theta', [])]),
Node('Delta', [
Node('Iota', []),
Node('Kappa', []),
Node('Lambda', [])
])
]);
// tree2 :: Tree Int
const tree2 = Node(
1,
[
Node(2, [
Node(4, []),
Node(5, [Node(7, [])])
]),
Node(3, [
Node(6, [
Node(8, []),
Node(9, [])
])
])
]
);
// strTrees :: String
const strTrees = ([
'Compacted (parents not all vertically centered):',
drawTree2(true)(false)(tree2),
'Fully expanded, with vertical centering:',
drawTree2(false)(false)(tree),
'Vertically centered, with nodeless lines pruned out:',
drawTree2(false)(true)(tree),
].join('\n\n'));
return (
console.log(strTrees),
strTrees
);
};
// 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
});
// Tuple3 (,,) :: a -> b -> c -> (a, b, c)
const Tuple3 = (a, b, c) => ({
type: 'Tuple3',
'0': a,
'1': b,
'2': c,
length: 3
});
// compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
const compose = (f, g) => x => f(g(x));
// concat :: [[a]] -> [a]
// concat :: [String] -> String
const concat = xs =>
0 < xs.length ? (() => {
const unit = 'string' !== typeof xs[0] ? (
[]
) : '';
return unit.concat.apply(unit, xs);
})() : [];
// fmapTree :: (a -> b) -> Tree a -> Tree b
const fmapTree = (f, tree) => {
const go = node => Node(
f(node.root),
node.nest.map(go)
);
return go(tree);
};
// fst :: (a, b) -> a
const fst = tpl => tpl[0];
// identity :: a -> a
const identity = x => x;
// init :: [a] -> [a]
const init = xs =>
0 < xs.length ? (
xs.slice(0, -1)
) : undefined;
// intercalate :: [a] -> [[a]] -> [a]
// intercalate :: String -> [String] -> String
const intercalate = (sep, xs) =>
0 < xs.length && 'string' === typeof sep &&
'string' === typeof xs[0] ? (
xs.join(sep)
) : concat(intersperse(sep, xs));
// intersperse(0, [1,2,3]) -> [1, 0, 2, 0, 3]
// intersperse :: a -> [a] -> [a]
// intersperse :: Char -> String -> String
const intersperse = (sep, xs) => {
const bln = 'string' === typeof xs;
return xs.length > 1 ? (
(bln ? concat : x => x)(
(bln ? (
xs.split('')
) : xs)
.slice(1)
.reduce((a, x) => a.concat([sep, x]), [xs[0]])
)) : xs;
};
// iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
const iterateUntil = (p, f, x) => {
const vs = [x];
let h = x;
while (!p(h))(h = f(h), vs.push(h));
return vs;
};
// 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;
// levels :: Tree a -> [[a]]
const levels = tree =>
iterateUntil(
xs => 1 > xs.length,
ys => [].concat(...ys.map(nest)),
[tree]
).map(xs => xs.map(root));
// maximum :: Ord a => [a] -> a
const maximum = xs =>
0 < xs.length ? (
xs.slice(1).reduce((a, x) => x > a ? x : a, xs[0])
) : undefined;
// nest :: Tree a -> [a]
const nest = tree => tree.nest;
// root :: Tree a -> a
const root = tree => tree.root;
// splitAt :: Int -> [a] -> ([a], [a])
const splitAt = (n, xs) =>
Tuple(xs.slice(0, n), xs.slice(n));
// unlines :: [String] -> String
const unlines = xs => xs.join('\n');
// MAIN ---
return main();
})();

130
Task/Visualize-a-tree/JavaScript/visualize-a-tree-3.js Normal file
View file

@ -0,0 +1,130 @@
(() => {
'use strict';
// drawTree :: Bool -> Tree String -> String
const drawTree = blnCompact => tree => {
// Simple decorated-outline style of ascii tree drawing,
// with nodeless lines pruned out if blnCompact is True.
const xs = draw(tree);
return unlines(
blnCompact ? (
xs.filter(
s => s.split('')
.some(c => !' │'.includes(c))
)
) : xs
);
};
// draw :: Tree String -> [String]
const draw = node => {
// shift :: String -> String -> [String] -> [String]
const shift = (first, other, xs) =>
zipWith(
append,
cons(first, replicate(xs.length - 1, other)),
xs
);
// drawSubTrees :: [Tree String] -> [String]
const drawSubTrees = xs => {
const lng = xs.length;
return 0 < lng ? (
1 < lng ? append(
cons(
'│',
shift('├─ ', '│ ', draw(xs[0]))
),
drawSubTrees(xs.slice(1))
) : cons('│', shift('└─ ', ' ', draw(xs[0])))
) : [];
};
return append(
lines(node.root.toString()),
drawSubTrees(node.nest)
);
};
// TEST -----------------------------------------------
const main = () => {
const tree = Node(
'Alpha', [
Node('Beta', [
Node('Epsilon', []),
Node('Zeta', []),
Node('Eta', [])
]),
Node('Gamma', [Node('Theta', [])]),
Node('Delta', [
Node('Iota', []),
Node('Kappa', []),
Node('Lambda', [])
])
]);
return [true, false]
.map(blnCompact => drawTree(blnCompact)(tree))
.join('\n\n');
};
// 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 || []
});
// append (++) :: [a] -> [a] -> [a]
// append (++) :: String -> String -> String
const append = (xs, ys) => xs.concat(ys);
// chars :: String -> [Char]
const chars = s => s.split('');
// cons :: a -> [a] -> [a]
const cons = (x, xs) => [x].concat(xs);
// 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]/);
// replicate :: Int -> a -> [a]
const replicate = (n, x) =>
Array.from({
length: n
}, () => x);
// take :: Int -> [a] -> [a]
const take = (n, xs) =>
xs.slice(0, n);
// unlines :: [String] -> String
const unlines = xs => xs.join('\n');
// Use of `take` and `length` here allows zipping with non-finite lists
// i.e. generators like cycle, repeat, iterate.
// zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
const zipWith = (f, xs, ys) => {
const
lng = Math.min(length(xs), length(ys)),
as = take(lng, xs),
bs = take(lng, ys);
return Array.from({
length: lng
}, (_, i) => f(as[i], bs[i], i));
};
// MAIN ---
return main();
})();

4
Task/Visualize-a-tree/Julia/visualize-a-tree.julia Normal file
View file

@ -0,0 +1,4 @@
using Gadfly, LightGraphs, GraphPlot
gx = kronecker(5, 12, 0.57, 0.19, 0.19)
gplot(gx)

331
Task/Visualize-a-tree/Python/visualize-a-tree-5.py Normal file
View file

@ -0,0 +1,331 @@
'''Textually visualized tree, with vertically-centered parent nodes'''
from functools import reduce
from itertools import (chain, takewhile)
'''
┌ Epsilon
├─── Zeta
┌─ Beta ┼──── Eta
│ │ ┌───── Mu
│ └── Theta ┤
Alpha ┤ └───── Nu
├ Gamma ────── Xi ─ Omicron
│ ┌─── Iota
└ Delta ┼── Kappa
└─ Lambda
'''
# Tree style and algorithm inspired by the Haskell snippet at:
# https://doisinkidney.com/snippets/drawing-trees.html
# drawTree2 :: Bool -> Bool -> Tree a -> String
def drawTree2(blnCompact):
'''Monospaced UTF8 left-to-right text tree in a
compact or expanded format, with any lines
containing no nodes optionally pruned out.
'''
def go(blnPruned, tree):
# measured :: a -> (Int, String)
def measured(x):
'''Value of a tree node
tupled with string length.
'''
s = ' ' + str(x) + ' '
return len(s), s
# lmrFromStrings :: [String] -> ([String], String, [String])
def lmrFromStrings(xs):
'''Lefts, Mid, Rights.'''
i = len(xs) // 2
ls, rs = xs[0:i], xs[i:]
return ls, rs[0], rs[1:]
# stringsFromLMR :: ([String], String, [String]) -> [String]
def stringsFromLMR(lmr):
ls, m, rs = lmr
return ls + [m] + rs
# fghOverLMR
# :: (String -> String)
# -> (String -> String)
# -> (String -> String)
# -> ([String], String, [String])
# -> ([String], String, [String])
def fghOverLMR(f, g, h):
def go(lmr):
ls, m, rs = lmr
return (
[f(x) for x in ls],
g(m),
[h(x) for x in rs]
)
return lambda lmr: go(lmr)
# leftPad :: Int -> String -> String
def leftPad(n):
return lambda s: (' ' * n) + s
# treeFix :: (Char, Char, Char) -> ([String], String, [String])
# -> [String]
def treeFix(l, m, r):
def cfix(x):
return lambda xs: x + xs
return compose(stringsFromLMR)(
fghOverLMR(cfix(l), cfix(m), cfix(r))
)
def lmrBuild(w, f):
def go(wsTree):
nChars, x = wsTree['root']
_x = ('─' * (w - nChars)) + x
xs = wsTree['nest']
lng = len(xs)
# linked :: String -> String
def linked(s):
c = s[0]
t = s[1:]
return _x + '┬' + t if '┌' == c else (
_x + '┤' + t if '│' == c else (
_x + '┼' + t if '├' == c else (
_x + '┴' + t
)
)
)
# LEAF ------------------------------------
if 0 == lng:
return ([], _x, [])
# SINGLE CHILD ----------------------------
elif 1 == lng:
def lineLinked(z):
return _x + '─' + z
rightAligned = leftPad(1 + w)
return fghOverLMR(
rightAligned,
lineLinked,
rightAligned
)(f(xs[0]))
# CHILDREN --------------------------------
else:
rightAligned = leftPad(w)
lmrs = [f(x) for x in xs]
return fghOverLMR(
rightAligned,
linked,
rightAligned
)(
lmrFromStrings(
intercalate([] if blnCompact else ['│'])(
[treeFix(' ', '┌', '│')(lmrs[0])] + [
treeFix('│', '├', '│')(x) for x
in lmrs[1:-1]
] + [treeFix('│', '└', ' ')(lmrs[-1])]
)
)
)
return lambda wsTree: go(wsTree)
measuredTree = fmapTree(measured)(tree)
levelWidths = reduce(
lambda a, xs: a + [max(x[0] for x in xs)],
levels(measuredTree),
[]
)
treeLines = stringsFromLMR(
foldr(lmrBuild)(None)(levelWidths)(
measuredTree
)
)
return [
s for s in treeLines
if any(c not in '│ ' for c in s)
] if (not blnCompact and blnPruned) else treeLines
return lambda blnPruned: (
lambda tree: '\n'.join(go(blnPruned, tree))
)
# TEST ----------------------------------------------------
# main :: IO ()
def main():
'''Trees drawn in varying formats'''
# tree1 :: Tree Int
tree1 = Node(1)([
Node(2)([
Node(4)([
Node(7)([])
]),
Node(5)([])
]),
Node(3)([
Node(6)([
Node(8)([]),
Node(9)([])
])
])
])
# tree :: Tree String
tree2 = Node('Alpha')([
Node('Beta')([
Node('Epsilon')([]),
Node('Zeta')([]),
Node('Eta')([]),
Node('Theta')([
Node('Mu')([]),
Node('Nu')([])
])
]),
Node('Gamma')([
Node('Xi')([Node('Omicron')([])])
]),
Node('Delta')([
Node('Iota')([]),
Node('Kappa')([]),
Node('Lambda')([])
])
])
print(
'\n\n'.join([
'Fully compacted (parents not all centered):',
drawTree2(True)(False)(
tree1
),
'Expanded with vertically centered parents:',
drawTree2(False)(False)(
tree2
),
'Centered parents with nodeless lines pruned out:',
drawTree2(False)(True)(
tree2
)
])
)
# GENERIC -------------------------------------------------
# Node :: a -> [Tree a] -> Tree a
def Node(v):
'''Contructor 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}
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
'''Right to left function composition.'''
return lambda f: lambda x: g(f(x))
# concatMap :: (a -> [b]) -> [a] -> [b]
def concatMap(f):
'''A concatenated list over which a function has been mapped.
The list monad can be derived by using a function f which
wraps its output in a list,
(using an empty list to represent computational failure).
'''
return lambda xs: list(
chain.from_iterable(map(f, xs))
)
# fmapTree :: (a -> b) -> Tree a -> Tree b
def fmapTree(f):
'''A new tree holding the results of
applying f to each root in
the existing tree.
'''
def go(x):
return Node(f(x['root']))(
[go(v) for v in x['nest']]
)
return lambda tree: go(tree)
# foldr :: (a -> b -> b) -> b -> [a] -> b
def foldr(f):
'''Right to left reduction of a list,
using the binary operator f, and
starting with an initial accumulator value.
'''
def g(x, a):
return f(a, x)
return lambda acc: lambda xs: reduce(
g, xs[::-1], acc
)
# intercalate :: [a] -> [[a]] -> [a]
# intercalate :: String -> [String] -> String
def intercalate(x):
'''The concatenation of xs
interspersed with copies of x.
'''
return lambda xs: x.join(xs) if isinstance(x, str) else list(
chain.from_iterable(
reduce(lambda a, v: a + [x, v], xs[1:], [xs[0]])
)
) if xs else []
# iterate :: (a -> a) -> a -> Gen [a]
def iterate(f):
'''An infinite list of repeated
applications of f to x.
'''
def go(x):
v = x
while True:
yield v
v = f(v)
return lambda x: go(x)
# levels :: Tree a -> [[a]]
def levels(tree):
'''A list of the nodes at each level of the tree.'''
return list(
map_(map_(root))(
takewhile(
bool,
iterate(concatMap(nest))(
[tree]
)
)
)
)
# map :: (a -> b) -> [a] -> [b]
def map_(f):
'''The list obtained by applying f
to each element of xs.
'''
return lambda xs: list(map(f, xs))
# nest :: Tree a -> [Tree a]
def nest(t):
'''Accessor function for children of tree node.'''
return t['nest'] if 'nest' in t else None
# root :: Tree a -> a
def root(t):
'''Accessor function for data of tree node.'''
return t['root'] if 'root' in t else None
# MAIN ---
if __name__ == '__main__':
main()

93
Task/Visualize-a-tree/Python/visualize-a-tree-6.py Normal file
View file

@ -0,0 +1,93 @@
'''Visualize a tree'''
from itertools import (repeat, starmap)
from operator import (add)
# drawTree :: Tree a -> String
def drawTree(tree):
'''ASCII diagram of a tree.'''
return '\n'.join(draw(tree))
# draw :: Tree a -> [String]
def draw(node):
'''List of the lines of an ASCII
diagram of a tree.'''
def shift(first, other, xs):
return list(starmap(
add,
zip(
[first] + list(
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 (str(root(node))).splitlines() + (
drawSubTrees(nest(node))
)
# TEST ----------------------------------------------------
# main :: IO ()
def main():
'''Test'''
# tree :: Tree Int
tree = Node(1)([
Node(2)([
Node(4)([
Node(7)([])
]),
Node(5)([])
]),
Node(3)([
Node(6)([
Node(8)([]),
Node(9)([])
])
])
])
print(drawTree(tree))
# GENERIC -------------------------------------------------
# Node :: a -> [Tree a] -> Tree a
def Node(v):
'''Contructor for a Tree node which connects a
value of some kind to a list of zero or
more child trees.'''
return lambda xs: {'type': 'Node', 'root': v, 'nest': xs}
# nest :: Tree a -> [Tree a]
def nest(tree):
'''Accessor function for children of tree node.'''
return tree['nest'] if 'nest' in tree else None
# root :: Dict -> a
def root(dct):
'''Accessor function for data of tree node.'''
return dct['root'] if 'root' in dct else None
# MAIN ---
if __name__ == '__main__':
main()