Rosetta Code

Sorting algorithms/Tree sort on a linked list: Difference between revisions

Page Discussion

Sorting algorithms/Tree sort on a linked list (view source)

Revision as of 12:33, 8 February 2024

22,801 bytes added ,  3 months ago
m
→‎{{header|Wren}}: Minor tidy
m (→‎{{header|Phix}}: added a version title.)
m (→‎{{header|Wren}}: Minor tidy)
 
(13 intermediate revisions by 7 users not shown)
Line 16:
Then construct a tree in situ: use the prev and next of that list as left and right tree pointers.<br>
Then traverse the tree, in order, and recreate a doubly linked list, again in situ, but of course now in sorted order.
 
=={{header|ATS}}==
 
<syntaxhighlight lang="ats">(*
 
Tree sort based on the algorithm at http://archive.today/WM83M
 
One change is that, instead of a comparison function returning an
integer, we have a template function that serves as order
predicate. In other words, it is a "less than" function.
 
The mutable structures are implemented in C. The doubly-linked list
implementation is "unsafe". (A "safe" implementation of
doubly-linked lists would be nontrivial.) The ATS code is in an
"imperative" style.
 
*)
 
#define ATS_EXTERN_PREFIX "tree_sort_task_"
 
#include "share/atspre_staload.hats"
staload UN = "prelude/SATS/unsafe.sats"
 
%{^
 
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
 
struct tree_sort_task_dlnode {
atstype_ptr data;
struct tree_sort_task_dlnode *prev;
struct tree_sort_task_dlnode *next;
};
 
typedef struct tree_sort_task_dlnode *tree_sort_task_dlnode_t;
 
struct tree_sort_task_dllist {
tree_sort_task_dlnode_t head;
tree_sort_task_dlnode_t tail;
atstype_int count;
};
 
typedef struct tree_sort_task_dllist *tree_sort_task_dllist_t;
 
static tree_sort_task_dlnode_t
tree_sort_task_dlnode_make__ (atstype_ptr data)
{
tree_sort_task_dlnode_t node =
ATS_MALLOC (sizeof (struct tree_sort_task_dlnode));
node->data = data;
node->prev = NULL;
node->next = NULL;
return node;
}
 
static inline atstype_ptr
tree_sort_task_dlnode_get_data__ (tree_sort_task_dlnode_t node)
{
return node->data;
}
 
static inline tree_sort_task_dlnode_t
tree_sort_task_dlnode_get_prev__ (tree_sort_task_dlnode_t node)
{
return node->prev;
}
 
static inline tree_sort_task_dlnode_t
tree_sort_task_dlnode_get_next__ (tree_sort_task_dlnode_t node)
{
return node->next;
}
 
static inline void
tree_sort_task_dlnode_set_prev__ (tree_sort_task_dlnode_t node,
tree_sort_task_dlnode_t new_prev)
{
node->prev = new_prev;
}
 
static inline void
tree_sort_task_dlnode_set_next__ (tree_sort_task_dlnode_t node,
tree_sort_task_dlnode_t new_next)
{
node->next = new_next;
}
 
static tree_sort_task_dllist_t
tree_sort_task_dllist_make__ (void)
{
tree_sort_task_dllist_t list =
ATS_MALLOC (sizeof (struct tree_sort_task_dllist));
list->head = NULL;
list->tail = NULL;
list->count = 0;
return list;
}
 
static inline tree_sort_task_dlnode_t
tree_sort_task_dllist_get_head__ (tree_sort_task_dllist_t list)
{
return list->head;
}
 
static inline tree_sort_task_dlnode_t
tree_sort_task_dllist_get_tail__ (tree_sort_task_dllist_t list)
{
return list->tail;
}
 
static inline int
tree_sort_task_dllist_get_count__ (tree_sort_task_dllist_t list)
{
return list->count;
}
 
static inline void
tree_sort_task_dllist_set_head__ (tree_sort_task_dllist_t list,
tree_sort_task_dlnode_t new_head)
{
list->head = new_head;
}
 
static inline void
tree_sort_task_dllist_set_tail__ (tree_sort_task_dllist_t list,
tree_sort_task_dlnode_t new_tail)
{
list->tail = new_tail;
}
 
static inline void
tree_sort_task_dllist_set_count__ (tree_sort_task_dllist_t list,
int new_count)
{
list->count = new_count;
}
 
%}
 
abstype dlnode (a : t@ype+, is_nil : bool) = ptr
typedef dlnode (a : t@ype+) = [is_nil : bool] dlnode (a, is_nil)
 
abstype dllist (a : t@ype+, n : int) = ptr
typedef dllist (a : t@ype+) = [n : int] dllist (a, n)
 
fn {a : t@ype}
dlnode_make (elem : a) : dlnode (a, false) =
let
extern fn dlnode_make__ : ptr -> ptr = "mac#%"
val data = $extfcall (ptr, "ATS_MALLOC", sizeof<a>)
val () = $UN.ptr0_set<a> (data, elem)
in
$UN.cast (dlnode_make__ data)
end
 
fn {a : t@ype}
dlnode_nil () : dlnode (a, true) =
$UN.cast the_null_ptr
 
fn {}
dlnode_is_nil
{is_nil : bool}
{a : t@ype}
(node : dlnode (a, is_nil))
: [b : bool | b == is_nil] bool b =
$UN.cast (iseqz ($UN.cast{ptr} node))
 
fn {}
dlnode_isnot_nil
{is_nil : bool}
{a : t@ype}
(node : dlnode (a, is_nil))
: [b : bool | b == ~is_nil] bool b =
$UN.cast (isneqz ($UN.cast{ptr} node))
 
fn {a : t@ype}
dlnode_get_elem (node : dlnode (a, false)) : a =
let
extern fn dlnode_get_data__ : ptr -> ptr = "mac#%"
val data = dlnode_get_data__ ($UN.cast node)
in
$UN.ptr0_get<a> data
end
 
fn {a : t@ype}
dlnode_get_prev (node : dlnode (a, false)) : dlnode a =
let
extern fn dlnode_get_prev__ : ptr -> ptr = "mac#%"
in
$UN.cast (dlnode_get_prev__ ($UN.cast node))
end
 
fn {a : t@ype}
dlnode_get_next (node : dlnode (a, false)) : dlnode a =
let
extern fn dlnode_get_next__ : ptr -> ptr = "mac#%"
in
$UN.cast (dlnode_get_next__ ($UN.cast node))
end
 
fn {a : t@ype}
dlnode_set_prev
(node : dlnode (a, false),
new_prev : dlnode a)
: void =
let
extern fn dlnode_set_prev__ : (ptr, ptr) -> void = "mac#%"
in
dlnode_set_prev__ ($UN.cast node, $UN.cast new_prev)
end
 
fn {a : t@ype}
dlnode_set_next
(node : dlnode (a, false),
new_next : dlnode a)
: void =
let
extern fn dlnode_set_next__ : (ptr, ptr) -> void = "mac#%"
in
dlnode_set_next__ ($UN.cast node, $UN.cast new_next)
end
 
overload iseqz with dlnode_is_nil
overload isneqz with dlnode_isnot_nil
overload get_elem with dlnode_get_elem
overload get_prev with dlnode_get_prev
overload get_next with dlnode_get_next
overload set_prev with dlnode_set_prev
overload set_next with dlnode_set_next
 
fn {a : t@ype}
dllist_make () : dllist (a, 0) =
let
extern fn dllist_make__ : () -> ptr = "mac#%"
in
$UN.cast (dllist_make__ ())
end
 
fn {a : t@ype}
dllist_get_head (lst : dllist a) : dlnode a =
let
extern fn dllist_get_head__ : ptr -> ptr = "mac#%"
in
$UN.cast (dllist_get_head__ ($UN.cast lst))
end
 
fn {a : t@ype}
dllist_get_tail (lst : dllist a) : dlnode a =
let
extern fn dllist_get_tail__ : ptr -> ptr = "mac#%"
in
$UN.cast (dllist_get_tail__ ($UN.cast lst))
end
 
fn {}
dllist_get_count
{n : int}
{a : t@ype}
(lst : dllist (a, n))
: int n =
let
extern fn dllist_get_count__ : ptr -> int = "mac#%"
in
$UN.cast (dllist_get_count__ ($UN.cast lst))
end
 
fn {a : t@ype}
dllist_set_head
(lst : dllist a,
new_head : dlnode a)
: void =
let
extern fn dllist_set_head__ : (ptr, ptr) -> void = "mac#%"
in
dllist_set_head__ ($UN.cast lst, $UN.cast new_head)
end
 
fn {a : t@ype}
dllist_set_tail
(lst : dllist a,
new_tail : dlnode a)
: void =
let
extern fn dllist_set_tail__ : (ptr, ptr) -> void = "mac#%"
in
dllist_set_tail__ ($UN.cast lst, $UN.cast new_tail)
end
 
fn {a : t@ype}
dllist_set_count {n : int}
(lst : &dllist a >> dllist (a, n),
new_count : int n)
: void =
let
extern fn dllist_set_count__ : (ptr, int) -> void = "mac#%"
val () = dllist_set_count__ ($UN.cast lst, $UN.cast new_count)
prval () = $UN.castvwtp2void{dllist (a, n)} lst
in
end
 
fn {}
dllist_is_empty
{n : int}
{a : t@ype}
(lst : dllist (a, n))
: [b : bool | b == (n == 0)] bool b =
dllist_get_count lst = 0
 
fn {}
dllist_isnot_empty
{n : int}
{a : t@ype}
(lst : dllist (a, n))
: [b : bool | b == (n != 0)] bool b =
dllist_get_count lst <> 0
 
overload length with dllist_get_count
overload iseqz with dllist_is_empty
overload isneqz with dllist_isnot_empty
overload get_head with dllist_get_head
overload get_tail with dllist_get_tail
overload get_count with dllist_get_count
overload set_head with dllist_set_head
overload set_tail with dllist_set_tail
overload set_count with dllist_set_count
 
fn {a : t@ype}
dllist_insert_at_end
{n : int}
(lst : &dllist (a, n) >> dllist (a, n + 1),
new_elem : a)
: void =
let
val node = dlnode_make<a> new_elem
val n = length lst
in
set_count<a> (lst, succ n);
if n = 0 then
begin
set_head<a> (lst, node);
set_tail<a> (lst, node)
end
else
let
val last_node = get_tail<a> lst
val () = assertloc (isneqz last_node)
in
set_next<a> (last_node, node);
set_prev<a> (node, last_node);
set_tail<a> (lst, node)
end
end
 
infix +=
overload += with dllist_insert_at_end
 
fn {a : t@ype}
dllist2list {n : nat}
(lst : dllist (a, n))
: list (a, n) =
let
val n = length lst
fun
loop {i : nat | i <= n}
.<n - i>.
(last_node : dlnode a,
accum : list (a, i),
i : int i)
: list (a, n) =
if i = n then
let
val () = assertloc (iseqz last_node)
in
accum
end
else
let
val () = assertloc (isneqz last_node)
val elem = get_elem<a> last_node
in
loop (get_prev<a> last_node,
list_cons (elem, accum),
succ i)
end
in
loop (get_tail<a> lst, list_nil (), 0)
end
 
fn {a : t@ype}
list2dllist {n : nat}
(lst : list (a, n))
: dllist (a, n) =
let
fun
loop {i : nat | i <= n}
.<n - i>.
(lst : list (a, n - i),
accum : &dllist (a, i) >> dllist (a, n))
: void =
case+ lst of
| list_nil () => ()
| list_cons (elem, rest) =>
begin
accum += elem;
loop (rest, accum)
end
 
var retval = dllist_make<a> ()
in
loop {0} (lst, retval);
retval
end
 
extern fn {a : t@ype} (* The "less than" template. *)
dllist_tree_sort$lt : (a, a) -> bool
 
fn {a : t@ype}
dllist2tree {n : nat}
(lst : &dllist (a, n) >> _,
root : &dlnode a? >> dlnode a)
: void =
begin
root := get_head lst;
if isneqz root then
let
var node : dlnode a = get_next<a> root
in
set_prev<a> (root, dlnode_nil ());
set_next<a> (root, dlnode_nil ());
while (isneqz node)
let
val next = get_next<a> node
var current : dlnode a = root
var previous : dlnode a = dlnode_nil ()
var node_lt_curr : bool = false
in
while (isneqz current)
begin
previous := current;
node_lt_curr :=
dllist_tree_sort$lt<a> (get_elem<a> node,
get_elem<a> current);
if node_lt_curr then
current := get_prev<a> current
else
current := get_next<a> current
end;
let
prval () =
$UN.castvwtp2void{[b : bool] dlnode (a, b)} previous
val () = assertloc (isneqz previous)
in
if node_lt_curr then
set_prev<a> (previous, node)
else
set_next<a> (previous, node)
end;
set_prev<a> (node, dlnode_nil ());
set_next<a> (node, dlnode_nil ());
node := next
end
end
end
 
fn {a : t@ype}
tree2dllist {n : nat}
(lst : &dllist (a, n) >> _,
root : dlnode a)
: void =
let
fun
recurs (lst : &dllist (a, n) >> _,
root : dlnode a,
previous : &dlnode a >> _,
count : &int >> _)
: void =
if isneqz root then
let
val left = get_prev<a> root
and right = get_next<a> root
in
recurs (lst, left, previous, count);
if iseqz (get_prev<a> root) * iseqz (get_head<a> lst) then
begin (* We are at the first element. *)
set_head<a> (lst, root);
set_prev<a> (root, dlnode_nil ())
end
else
let
val () = assertloc (isneqz previous)
in
set_next<a> (previous, root);
set_prev<a> (root, previous)
end;
if succ count = length lst then
begin (* We are at the last element. *)
set_tail<a> (lst, root);
set_next<a> (root, dlnode_nil ())
end;
previous := root;
count := succ count;
recurs (lst, right, previous, count)
end
 
var previous : dlnode a = dlnode_nil ()
var count : int = 0
in
set_head<a> (lst, dlnode_nil ());
set_tail<a> (lst, dlnode_nil ());
recurs (lst, root, previous, count)
end
 
fn {a : t@ype}
dllist_tree_sort
{n : nat}
(lst : &dllist (a, n) >> _)
: void =
let
var root : dlnode a
in
dllist2tree (lst, root);
tree2dllist (lst, root)
end
 
implement
dllist_tree_sort$lt<int> (x, y) =
x < y
 
implement
main0 () =
let
var i : int
var data : List0 int = list_nil ()
in
for (i := 1; i <= 20; i := succ i)
data := list_cons ($extfcall (int, "rand") % 20, data);
let
var lst = list2dllist<int> data
in
println! (dllist2list<int> lst);
dllist_tree_sort<int> lst;
println! (dllist2list<int> lst)
end
end</syntaxhighlight>
 
{{out}}
<pre>$ patscc -DATS_MEMALLOC_GCBDW -O3 tree_sort_task.dats -lgc && ./a.out
16, 12, 6, 0, 6, 3, 19, 10, 7, 2, 1, 9, 12, 6, 15, 13, 15, 17, 6, 3
0, 1, 2, 3, 3, 6, 6, 6, 6, 7, 9, 10, 12, 12, 13, 15, 15, 16, 17, 19</pre>
 
Some comments:
 
I see the task used to have something to do with Finnegan's Wake, and with counting cycles, etc. Here I simply sort a list of integers.
 
It is unlikely, in ATS, that someone would use doubly-linked lists as their canonical linked list implementation. Sorting a singly-linked list this way would be interesting, but I cannot think of a way to do it without allocating new nodes. Of course, a quicksort or mergesort can be done on a singly-linked list without allocating new nodes.
 
(Obviously, if one is sorting a ''non-linear'' linked list, it is in general necessary to allocate new nodes. However, it is not necessary to allocate any ''temporary'' nodes.)
 
=={{header|C}}==
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <time.h>
Line 128 ⟶ 686:
list_destroy(&list);
return 0;
}</langsyntaxhighlight>
 
{{out}}
Line 135 ⟶ 693:
after sort: [4, 5, 11, 13, 18, 20, 21, 32, 33, 47, 48, 49, 57, 76, 81, 98]
</pre>
 
=={{header|FreeBASIC}}==
{{trans|Yabasic}}
<syntaxhighlight lang="freebasic">#define key 0
#define izda 1
#define dcha 2
 
Dim Shared As Integer index, size
index = 0 : size = 10
 
Dim Shared As String tree(size)
Dim Shared As Integer indTree(size, 3)
 
Declare Sub insertNode(word As String, prev As Integer)
Declare Sub makeNode(prev As Integer, branch As Integer, word As String)
 
Function Token(Texto As String, Delim As String, Direcc As Byte = 0) As String
Dim As Integer LocA = Instr(Texto, Delim)
Return Iif(Direcc <= 0, Left(Texto, LocA), Right(Texto, Len(Texto) - LocA))
End Function
 
Sub makeNode(prev As Integer, branch As Integer, word As String)
If indTree(prev, branch) = 0 Then
index += 1
If index > size Then size += 10 : Redim tree(size) : Redim indTree(size, 3)
indTree(prev, branch) = index
tree(index) = word
indTree(index, key) = 1
Else
insertNode(word, indTree(prev, branch))
End If
End Sub
 
Sub insertNode(word As String, prev As Integer)
Dim As String pal, ant
pal = Lcase(word)
ant = Lcase(tree(prev))
If ant <> "" Then
If pal < ant Then
makeNode(prev, izda, word)
Elseif pal > ant Then
makeNode(prev, dcha, word)
Elseif pal = ant Then
indTree(prev, key) += 1
End If
Else
index += 1
tree(index) = word
indTree(index, key) = 1
End If
End Sub
 
Sub showTree(numreg As Integer)
If indTree(numreg, izda) Then showTree(indTree(numreg, izda))
Print tree(numreg); " ";
If indTree(numreg, dcha) Then showTree(indTree(numreg, dcha))
End Sub
 
Sub makeTree(texto() As String)
For n As Integer = 1 To Ubound(texto)
insertNode(texto(n), 1)
Next n
End Sub
 
Dim As String g(1 To 10) = {"one","two","three","four","five","six","seven","eight","nine","ten"}
makeTree(g())
showTree(1)
Print
Sleep</syntaxhighlight>
{{out}}
<pre>eight five four nine one seven six ten three two</pre>
 
=={{header|Go}}==
This is based on the Kotlin entry but has been adjusted to satisfy the revised task description.
<langsyntaxhighlight lang="go">package main
 
import (
Line 212 ⟶ 842:
lls2 := treeSort(ll2)
printLinkedList(lls2, "%c", true)
}</langsyntaxhighlight>
 
{{out}}
Line 219 ⟶ 849:
d c e b a -> a b c d e
</pre>
 
=={{header|Haskell}}==
 
Due to pure functional nature of Haskell sorting in situ is impossible.
 
Here we use abstractions of ``Foldable`` type class in order to traverse both the doubly-linked list and the binary tree.
Implementation of doubly-linked list is given here [[Doubly-linked_list/Traversal#Haskell]]
 
<syntaxhighlight lang="haskell">{-# language DeriveFoldable #-}
import Data.Foldable
 
-- double-linked list
data DList a = End | Elem { prev :: DList a
, elt :: a
, next :: DList a }
 
mkDList :: Foldable t => t a -> DList a
mkDList = go End . toList
where go _ [] = End
go prev (x:xs) = current
where current = Elem prev x next
next = go current xs
 
instance Foldable DList where
foldMap f End = mempty
foldMap f dl = f (elt dl) <> foldMap f (next dl)
 
sortDL :: Ord a => DList a -> DList a
sortDL = mkDList . mkTree
 
-- binary tree
data BTree a = Empty | Node { left :: BTree a
, node :: a
, right :: BTree a }
deriving (Show, Foldable)
 
addTree Empty x = Node Empty x Empty
addTree (Node l a g) x =
case compare x a of
LT -> Node (addTree l x) a g
_ -> Node l a (addTree g x)
 
mkTree :: (Foldable t, Ord a) => t a -> BTree a
mkTree = foldl addTree Empty
 
treeSort :: (Foldable t, Ord a) => t a -> [a]
treeSort = toList . mkTree</syntaxhighlight>
 
<pre>λ> let l = mkDList [2,4,3,5,7,6,2,9]
λ> l
mkDList [2,4,3,5,7,6,2,9] :: Num a => DList a
 
λ> toList l
[2,4,3,5,7,6,2,9]
 
λ> mkTree l
Node {left = Empty, node = 2, right = Node {left = Node {left = Node {left = Empty, node = 2, right = Empty}, node = 3, right = Empty}, node = 4, right = Node {left = Empty, node = 5, right = Node {left = Node {left = Empty, node = 6, right = Empty}, node = 7, right = Node {left = Empty, node = 9, right = Empty}}}}}
 
λ> toList $ mkTree l
[2,2,3,4,5,6,7,9]
 
λ> toList $ sortDL l
[2,2,3,4,5,6,7,9]
 
λ> treeSort [2,4,3,5,7,6,2,9]
[2,2,3,4,5,6,7,9]</pre>
 
=={{header|J}}==
Line 236 ⟶ 932:
With these choices, the task becomes:
 
<langsyntaxhighlight Jlang="j"> finn=: fread '~user/temp/wake/finneganswake.txt'
sentences=: (<;.2~ '. '&E.@rplc&(LF,' !.?.')) finn
#sentences
14961
+/<:#@>C./:sentences
14945</langsyntaxhighlight>
 
We have to swap almost every sentence, but 16 of them can be sorted "for free" with the swaps of the other sentences.
Line 247 ⟶ 943:
For that matter, inspecting the lengths of the cycles formed by the minimal arrangements of swaps...
 
<langsyntaxhighlight Jlang="j"> /:~ #@>C./:sentences
1 1 2 2 4 9 12 25 32 154 177 570 846 935 1314 10877</langsyntaxhighlight>
 
... we can see that two of the sentences were fine right where they start out. Let's see what they are:
 
<langsyntaxhighlight Jlang="j"> ;:inv (#~(= /:~))sentences
Very, all
fourlike tellt. What tyronte power!</langsyntaxhighlight>
 
So now you know.
Line 264 ⟶ 960:
Anyways, here we go:
 
<langsyntaxhighlight Jlang="j">left=: i.0
right=: i.0
data=: i.0
Line 296 ⟶ 992:
if. y>:#data do.'' return. end.
(extract y{left),(y{data),extract y{right
)</langsyntaxhighlight>
 
This could be wrapped differently, but it's adequate for this task.
 
Example use would be something like:
<langsyntaxhighlight lang="j"> insert sentences
extract''</langsyntaxhighlight>
 
But task's the current url for Finnegan's Wake does not point at flat text and constructing such a thing would be a different task...
 
=={{header|Java}}==
<langsyntaxhighlight lang="java">// TreeSortTest.java
import java.util.*;
 
Line 339 ⟶ 1,035:
System.out.println(" after sort: " + list);
}
}</langsyntaxhighlight>
 
<langsyntaxhighlight lang="java">// LinkedList.java
 
// Java provides a doubly-linked list implementation but it doesn't permit
Line 437 ⟶ 1,133:
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 449 ⟶ 1,145:
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">mutable struct BTree{T}
data::T
left::Union{BTree, Nothing}
Line 492 ⟶ 1,188:
 
testtreesort(rand(1:99, 12))
</langsyntaxhighlight>{{out}}
<pre>
Unsorted: [1, 12, 15, 22, 28, 26, 69, 22, 1, 62, 73, 95]
Line 500 ⟶ 1,196:
=={{header|Kotlin}}==
As I can't be bothered to download Finnegan's Wake and deal with the ensuing uncertainties, I've contented myself by following a similar approach to the Racket and Scheme entries:
<langsyntaxhighlight lang="scala">// version 1.1.51
 
import java.util.LinkedList
Line 544 ⟶ 1,240:
val ll2 = LinkedList(listOf('d', 'c', 'e', 'b' , 'a'))
ll2.treeSort()
}</langsyntaxhighlight>
 
{{out}}
Line 557 ⟶ 1,253:
As Nim standard library provides a doubly linked list implementation which allows to access to the "prev" and "next" fields, we used it. So, we had only to write the transformation from list to tree and conversely.
 
<langsyntaxhighlight Nimlang="nim">import lists, random
 
 
Line 601 ⟶ 1,297:
list2.append(s)
echo "Before sort: ", list2
echo "After sort: ", list2.treeSort()</langsyntaxhighlight>
 
{{out}}
Line 613 ⟶ 1,309:
Ol has builtin sorted key-value trees named "ff". We converting list into ff and back again as already sorted list. Only values (small integers, constants) and symbols are allowed.
 
<langsyntaxhighlight lang="scheme">
(define (tree-sort l)
(map car (ff->list
Line 621 ⟶ 1,317:
 
(print (tree-sort '(5 3 7 9 1)))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 628 ⟶ 1,324:
 
=={{header|Phix}}==
=== version one1 ===
{{trans|Kotlin}}
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 666 ⟶ 1,362:
<span style="color: #000000;">treeSort</span><span style="color: #0000FF;">({</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">treeSort</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"dceba"</span><span style="color: #0000FF;">)</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 675 ⟶ 1,371:
=== version 2 ===
Following my idea of a revised task description, see talk page.
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 770 ⟶ 1,466:
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"dceba"</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"d"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"c"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"e"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"b"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"a"</span><span style="color: #0000FF;">})</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 787 ⟶ 1,483:
{{trans|Scheme}} -- this implementation illustrates differences in identifiers and syntaxes of Scheme and Racket's <code>match-lambda</code> family. [http://docs.racket-lang.org/reference/match.html <code>racket/match</code> documented here].
 
<langsyntaxhighlight lang="racket">#lang racket/base
(require racket/match)
 
Line 816 ⟶ 1,512:
(tree-sort-itr '(() () ()) lst))
 
(tree-sort '(5 3 7 9 1))</langsyntaxhighlight>
 
{{out}}
<pre>'(1 3 5 7 9)</pre>
 
=={{header|Raku}}==
{{trans|Go}}
<syntaxhighlight lang="raku" line># 20231201 Raku programming solution
 
class BinaryTree { has ($.node, $.leftSubTree, $.rightSubTree) is rw;
 
method insert($item) {
if not $.node.defined {
$.node = $item;
($.leftSubTree, $.rightSubTree)>>.&{ $_ = BinaryTree.new }
} elsif $item cmp $.node < 0 {
$.leftSubTree.insert($item);
} else {
$.rightSubTree.insert($item);
}
}
 
method inOrder(@ll) {
return unless $.node.defined;
$.leftSubTree.inOrder(@ll);
@ll.push($.node);
$.rightSubTree.inOrder(@ll);
}
}
 
sub treeSort(@ll) {
my $searchTree = BinaryTree.new;
for @ll -> $i { $searchTree.insert($i) }
$searchTree.inOrder(my @ll2);
return @ll2
}
 
sub printLinkedList(@ll, Str $fmt, Bool $sorted) {
for @ll -> $i { printf "$fmt ", $i }
$sorted ?? say() !! print "-> "
}
 
my @ll = <5 3 7 9 1>;
#my @ll = [37, 88, 13, 18, 72, 77, 29, 93, 21, 97, 37, 42, 67, 22, 29, 2];
printLinkedList(@ll, "%d", False);
my @lls = treeSort(@ll);
printLinkedList(@lls, "%d", True);
 
my @ll2 = <d c e b a>;
#my @ll2 = <one two three four five six seven eight nine ten>;
printLinkedList(@ll2, "%s", False);
my @lls2 = treeSort(@ll2);
printLinkedList(@lls2, "%s", True);
</syntaxhighlight>
You may [https://ato.pxeger.com/run?1=fZTPbtNAEMYvnPwUX4NBieRaxAGSKG2KeuBUiUN6Qwg58Riv6qyj3XVDFOVJONADvFSfprP-U8cmxZK93pn9Zn4zu9pff1R4lz88_M1NfD55fPV7lYZa41rIUO1uFRH2SEKNvuvLLCIPrp9SbBb50jrtVIkfST0fQGio7cxxAKzJJFkEITUp03eFofUAe-vhR8SQmUEZ1Y8oFpKiZy8_pQeXKISzxtH_P8F87r_dw_3OyqYIX9IWhyrGAZRqzl8Exmq9qXNd4F2b4CiP3ypjdhyK2qJjmhdUTvFp9eiLikj1P6Vp0yJFJlcSuUyJd6TdqTpUl7EJU6_gf3-T66TawEGj7IB2pAeHCXW-hGH3IuMiGrj1Dq6mUK2S4oR0O13o40zZ3Difc6P5EB0Jmq4Myl60fSUI52B5UMJUrbCGGmujhDQ3Qt5RdCN0QedhYRTceG08XGdZynGZm6KKuktURIjRswL0PGusaAoVrq6gw11_gLOzci16LO1ZgBIOXPnFB4wwxhTD-cx5Xdkv8XU09jCZeBiO-OVxHPDLtmDqYcq2YMgjz-269-z7aH1B6Q--zZyT5fXeRMz5OeQzx30pk2nO1tqik1pdi29VbrWVOLAVRFiBsETYVFDYM0kw2wwmsZscZ7lCLO4JWvyEpnuSIHuCIIVdSHJ-MnNgM-t_sYMOd_AC-LO-JC_vqeq6qq-tJw Attempt This Online!]
 
=={{header|Scheme}}==
Line 825 ⟶ 1,572:
{{libheader|Matchable}}
{{works with|Chicken Scheme}}
<langsyntaxhighlight Schemelang="scheme">(use matchable)
 
(define insert
Line 855 ⟶ 1,602:
[(x (a . b)) (tree-sort-itr (insert a x) b)]
[_ "incorrect arguments or broken tree" ]))
(tree-sort-itr '(() () ()) lst))</langsyntaxhighlight>
Usage: <langsyntaxhighlight Schemelang="scheme"> #;2> (tree-sort '(5 3 7 9 1))
(1 3 5 7 9)</langsyntaxhighlight>
 
=={{header|Wren}}==
Line 863 ⟶ 1,610:
{{libheader|Wren-llist}}
{{libheader|wren-sort}}
<langsyntaxhighlight ecmascriptlang="wren">import "./llist" for DLinkedList
import "./sort" for Cmp
 
class BinaryTree {
Line 907 ⟶ 1,654:
treeSort.call(ll)
var ll2 = DLinkedList.new(["d", "c", "e", "b", "a"])
treeSort.call(ll2)</langsyntaxhighlight>
 
{{out}}
Line 914 ⟶ 1,661:
d c e b a -> a b c d e
</pre>
 
=={{header|Yabasic}}==
<syntaxhighlight lang="yabasic">// Rosetta Code problem: http://rosettacode.org/wiki/Tree_sort_on_a_linked_list
// by Galileo, 04/2022
 
clear screen
 
KEY = 0 : LEFT = 1 : RIGHT = 2
 
index = 0 : size = 10
 
dim tree$(size)
dim indTree(size, 3)
 
 
sub makeNode(prev, branch, word$)
if indTree(prev, branch) = 0 then
index = index + 1
if index > size then size = size + 10 : redim tree$(size) : redim indTree(size, 3) end if
indTree(prev, branch) = index
tree$(index) = word$
indTree(index, KEY) = 1
else
insertNode(word$, indTree(prev, branch))
end if
end sub
 
 
sub insertNode(word$, prev)
local pal$, ant$
pal$ = lower$(word$)
ant$ = lower$(tree$(prev))
if ant$ <> "" then
if pal$ < ant$ then
makeNode(prev, LEFT, word$)
elseif pal$ > ant$ then
makeNode(prev, RIGHT, word$)
elseif pal$ = ant$ then
indTree(prev, KEY) = indTree(prev, KEY) + 1
end if
else
index = index + 1
tree$(index) = word$
indTree(index,KEY) = 1
end if
end sub
 
 
sub showTree(numreg)
if indTree(numreg,LEFT) then
showTree(indTree(numreg, LEFT))
end if
print tree$(numreg), " ";
if indTree(numreg, RIGHT) then
showTree(indTree(numreg, RIGHT))
end if
end sub
 
 
sub makeTree(line$)
local n, numwords, words$(1)
numwords = token(line$, words$())
for n = 1 to numwords
insertNode(words$(n), 1)
next n
end sub
 
 
makeTree("one two three four five six seven eight nine ten")
showTree(1)
print</syntaxhighlight>
{{out}}
<pre>eight five four nine one seven six ten three two
---Program done, press RETURN---</pre>
 
=={{header|zkl}}==
This code reads a file [of source code] line by line, and builds a binary tree of the first word of each line. Then prints the sorted list.
<langsyntaxhighlight lang="zkl">class Node{
var left,right,value;
fcn init(value){ self.value=value; }
Line 943 ⟶ 1,769:
}
}
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">tree:=Tree();
File("bbb.zkl").pump(tree.add,fcn(line){ // 5,000 lines to 660 words
line.split(" ")[0].strip(); // take first word
});
 
foreach word in (tree){ println(word) }</langsyntaxhighlight>
{{out}}
<pre>
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/245176...352418"