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

m
m (J: might be worth doing this one right? the binary tree pointers are the temporary data structure being sorted here, cost is higher sorting all at once because many need multiple updates, but this is a way to cut down accumulated costs of successive sorts)
m (→‎{{header|Wren}}: Minor tidy)
 
(36 intermediate revisions by 17 users not shown)
Line 1:
{{draft task|Sorting Algorithms}}
[[Category:Sorting]]
{{Sorting Algorithm}}
 
{{Wikipedia pre 15 June 2009|pagename=article|lang=en|oldid=295989333|timedate=15:13, 12 June 2009}}
{{Wikipedia pre 15 June 2009|pagename=Tree_sort|lang=en|oldid=295989333|timedate=15:13, 12 June 2009}}
A '''tree sort''' is a [[wp:sort algorithm|sort algorithm]] that builds a [[wp:binary search tree|binary search tree]] from the keys to be sorted, and then traverses the tree ([[wp:Tree traversal|in-order]]) so that the keys come out in sorted order. Its typical use is when sorting the elements of a stream from a file. Several other sorts would have to load the elements to a temporary data structure, whereas in a tree sort the act of loading the input into a data structure is sorting it.
 
Line 7 ⟶ 9:
* [http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.31.9981 A Comparative Study of Linked List Sorting Algorithms by Ching-Kuang Shene]
[[Sorting_algorithms#Sediment sort|Sediment sort]], [[Sorting_algorithms#bubble sort|bubble sort]], [[Sorting_algorithms#selection sort|selection sort]] perform very badly.
* http://www.martinbroadhurst.com/sorting-a-linked-list-by-turning-it-into-a-binary-tree.html
 
 
'''Task:'''<br>
First, construct a doubly linked list (unsorted).<br>
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}}==
<syntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <time.h>
 
void fatal(const char* message) {
fprintf(stderr, "%s\n", message);
exit(1);
}
 
void* xmalloc(size_t n) {
void* ptr = malloc(n);
if (ptr == NULL)
fatal("Out of memory");
return ptr;
}
 
typedef struct node_tag {
int item;
struct node_tag* prev;
struct node_tag* next;
} node_t;
 
void list_initialize(node_t* list) {
list->prev = list;
list->next = list;
}
 
void list_destroy(node_t* list) {
node_t* n = list->next;
while (n != list) {
node_t* tmp = n->next;
free(n);
n = tmp;
}
}
 
void list_append_node(node_t* list, node_t* node) {
node_t* prev = list->prev;
prev->next = node;
list->prev = node;
node->prev = prev;
node->next = list;
}
 
void list_append_item(node_t* list, int item) {
node_t* node = xmalloc(sizeof(node_t));
node->item = item;
list_append_node(list, node);
}
 
void list_print(node_t* list) {
printf("[");
node_t* n = list->next;
if (n != list) {
printf("%d", n->item);
n = n->next;
}
for (; n != list; n = n->next)
printf(", %d", n->item);
printf("]\n");
}
 
void tree_insert(node_t** p, node_t* n) {
while (*p != NULL) {
if (n->item < (*p)->item)
p = &(*p)->prev;
else
p = &(*p)->next;
}
*p = n;
}
 
void tree_to_list(node_t* list, node_t* node) {
if (node == NULL)
return;
node_t* prev = node->prev;
node_t* next = node->next;
tree_to_list(list, prev);
list_append_node(list, node);
tree_to_list(list, next);
}
 
void tree_sort(node_t* list) {
node_t* n = list->next;
if (n == list)
return;
node_t* root = NULL;
while (n != list) {
node_t* next = n->next;
n->next = n->prev = NULL;
tree_insert(&root, n);
n = next;
}
list_initialize(list);
tree_to_list(list, root);
}
 
int main() {
srand(time(0));
node_t list;
list_initialize(&list);
for (int i = 0; i < 16; ++i)
list_append_item(&list, rand() % 100);
printf("before sort: ");
list_print(&list);
tree_sort(&list);
printf(" after sort: ");
list_print(&list);
list_destroy(&list);
return 0;
}</syntaxhighlight>
 
{{out}}
<pre>
before sort: [33, 57, 20, 49, 32, 48, 13, 81, 18, 76, 98, 47, 11, 4, 21, 5]
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.
<syntaxhighlight lang="go">package main
 
import (
"container/list"
"fmt"
)
 
type BinaryTree struct {
node int
leftSubTree *BinaryTree
rightSubTree *BinaryTree
}
 
func (bt *BinaryTree) insert(item int) {
if bt.node == 0 {
bt.node = item
bt.leftSubTree = &BinaryTree{}
bt.rightSubTree = &BinaryTree{}
} else if item < bt.node {
bt.leftSubTree.insert(item)
} else {
bt.rightSubTree.insert(item)
}
}
 
func (bt *BinaryTree) inOrder(ll *list.List) {
if bt.node == 0 {
return
}
bt.leftSubTree.inOrder(ll)
ll.PushBack(bt.node)
bt.rightSubTree.inOrder(ll)
}
func treeSort(ll *list.List) *list.List {
searchTree := &BinaryTree{}
for e := ll.Front(); e != nil; e = e.Next() {
i := e.Value.(int)
searchTree.insert(i)
}
ll2 := list.New()
searchTree.inOrder(ll2)
return ll2
}
 
func printLinkedList(ll *list.List, f string, sorted bool) {
for e := ll.Front(); e != nil; e = e.Next() {
i := e.Value.(int)
fmt.Printf(f+" ", i)
}
if !sorted {
fmt.Print("-> ")
} else {
fmt.Println()
}
}
 
func main() {
sl := []int{5, 3, 7, 9, 1}
ll := list.New()
for _, i := range sl {
ll.PushBack(i)
}
printLinkedList(ll, "%d", false)
lls := treeSort(ll)
printLinkedList(lls, "%d", true)
 
sl2 := []int{'d', 'c', 'e', 'b', 'a'}
ll2 := list.New()
for _, c := range sl2 {
ll2.PushBack(c)
}
printLinkedList(ll2, "%c", false)
lls2 := treeSort(ll2)
printLinkedList(lls2, "%c", true)
}</syntaxhighlight>
 
{{out}}
<pre>
5 3 7 9 1 -> 1 3 5 7 9
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]
'''Test case:''' Create a linked list of all the sentences of all the episodes of [http://www.telelib.com/authors/J/JoyceJames/prose/finneganswake Finnegans Wake by James Joyce]. Load them into a local memory based linked list, then tree sort them inplace and print the number of node swaps and seconds of [[wp:BogoMips|BogoMips]] are necessary to perform the sort. (The book is to be stored locally (whole ''or'' in individual episodes) in a test text file on disk before loading by the specimin code into a linked list for sorting.)
[2,2,3,4,5,6,7,9]</pre>
 
=={{header|J}}==
 
What *is* a sentence in Finnegan's wakeWake? Let's say that it's all the text leading up to a period, question mark or exclamation point if (and only if) the character is followed by a space or newline. (There are some practical difficulties here - this means, for example, that the first sentence of a chapter includes the chapter heading - but it's good enough for now.)
 
There's also the issue of how do we want to sort the sentences? Let's say we'll sort them in ascii order without normalization of the text (since that is simplest).
Line 26 ⟶ 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 37 ⟶ 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.
 
(Processing time here is negligible - other than the time needed to fetch a copy of the book and render it as plain text ascii - but if we were careful to implement the efficiency recommendations of this task more in the spirit of whatever the task is presumably implying, we could probably increase the processing time by several orders of magnitude.)
 
So... ok... let's do this "right" (which is to say according to the current task specification, as opposed to the task specification that was present for the early drafts - though, perhaps, using Finnegan's Wake as a data set encourages a certain degree of ... informality?).
 
Anyways, here we go:
 
<syntaxhighlight lang="j">left=: i.0
right=: i.0
data=: i.0
 
insert=:3 :0"0
k=. 0
assert. (left =&# right) * (left =&# data)
if. 0<#data do.
while. k<#data do.
if. y=k{data do.return.end.
n=. k
if. y<k{data do.
k=. k{".p=.'left'
else.
k=. k{".p=.'right'
end.
end.
(p)=:(#data) n} ".p
end.
left=:left, _
right=:right, _
data=:data,y
i.0 0
)
 
flatten=:3 :0
extract 0
)
 
extract=:3 :0
if. y>:#data do.'' return. end.
(extract y{left),(y{data),extract y{right
)</syntaxhighlight>
 
This could be wrapped differently, but it's adequate for this task.
 
Example use would be something like:
<syntaxhighlight lang="j"> insert sentences
extract''</syntaxhighlight>
 
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}}==
<syntaxhighlight lang="java">// TreeSortTest.java
import java.util.*;
 
public class TreeSortTest {
public static void main(String[] args) {
test1();
System.out.println();
test2();
}
 
// Sort a random list of integers
private static void test1() {
LinkedList<Integer> list = new LinkedList<>();
Random r = new Random();
for (int i = 0; i < 16; ++i)
list.add(Integer.valueOf(r.nextInt(100)));
System.out.println("before sort: " + list);
list.treeSort();
System.out.println(" after sort: " + list);
}
 
// Sort a list of strings
private static void test2() {
LinkedList<String> list = new LinkedList<>();
String[] strings = { "one", "two", "three", "four", "five",
"six", "seven", "eight", "nine", "ten"};
for (String str : strings)
list.add(str);
System.out.println("before sort: " + list);
list.treeSort();
System.out.println(" after sort: " + list);
}
}</syntaxhighlight>
 
<syntaxhighlight lang="java">// LinkedList.java
 
// Java provides a doubly-linked list implementation but it doesn't permit
// public access to its internal structure for obvious reasons, so to
// fulfil the task requirements we must implement one ourselves.
 
import java.util.*;
 
public class LinkedList<T extends Comparable<? super T>> {
private final Node<T> sentinel = new Node<T>(null);
 
public LinkedList() {
clear();
}
 
public void clear() {
sentinel.next = sentinel;
sentinel.prev = sentinel;
}
 
public boolean isEmpty() {
return sentinel.next == sentinel;
}
 
public void add(T item) {
addNode(new Node<T>(item));
}
 
private void addNode(Node<T> n) {
n.prev = sentinel.prev;
n.next = sentinel;
sentinel.prev.next = n;
sentinel.prev = n;
}
 
public String toString() {
StringBuilder str = new StringBuilder("[");
Node<T> n = sentinel.next;
if (n != sentinel) {
str.append(n.item);
n = n.next;
while (n != sentinel) {
str.append(", ");
str.append(n.item);
n = n.next;
}
}
str.append("]");
return str.toString();
}
 
public void treeSort() {
if (isEmpty())
return;
Node<T> n = sentinel.next;
Node<T> root = null;
while (n != sentinel) {
Node<T> next = n.next;
n.next = null;
n.prev = null;
root = treeInsert(root, n);
n = next;
}
clear();
treeToList(root);
}
 
private Node<T> treeInsert(Node<T> tree, Node<T> n) {
if (tree == null)
tree = n;
else if (n.item.compareTo(tree.item) < 0)
tree.prev = treeInsert(tree.prev, n);
else
tree.next = treeInsert(tree.next, n);
return tree;
}
 
private void treeToList(Node<T> node) {
if (node == null)
return;
Node<T> prev = node.prev;
Node<T> next = node.next;
treeToList(prev);
addNode(node);
treeToList(next);
}
 
private static class Node<T> {
private T item;
private Node<T> prev = null;
private Node<T> next = null;
 
private Node(T item) {
this.item = item;
}
}
}</syntaxhighlight>
 
{{out}}
<pre>
before sort: [37, 88, 13, 18, 72, 77, 29, 93, 21, 97, 37, 42, 67, 22, 29, 2]
after sort: [2, 13, 18, 21, 22, 29, 29, 37, 37, 42, 67, 72, 77, 88, 93, 97]
 
before sort: [one, two, three, four, five, six, seven, eight, nine, ten]
after sort: [eight, five, four, nine, one, seven, six, ten, three, two]
</pre>
 
=={{header|Julia}}==
<syntaxhighlight lang="julia">mutable struct BTree{T}
data::T
left::Union{BTree, Nothing}
right::Union{BTree, Nothing}
BTree(val::T) where T = new{T}(val, nothing, nothing)
end
 
function insert(tree, data)
if data < tree.data
if tree.left == nothing
tree.left = BTree(data)
else
insert(tree.left, data)
end
else
if tree.right == nothing
tree.right = BTree(data)
else
insert(tree.right, data)
end
end
end
 
function sorted(tree)
return tree == nothing ? [] :
typeof(tree.data)[sorted(tree.left); tree.data; sorted(tree.right)]
end
 
function arraytotree(arr)
tree = BTree(arr[1])
for data in arr[2:end]
insert(tree, data)
end
return tree
end
 
function testtreesort(arr)
println("Unsorted: ", arr)
tree = arraytotree(arr)
println("Sorted: ", sorted(tree))
end
 
testtreesort(rand(1:99, 12))
</syntaxhighlight>{{out}}
<pre>
Unsorted: [1, 12, 15, 22, 28, 26, 69, 22, 1, 62, 73, 95]
Sorted: [1, 1, 12, 15, 22, 22, 26, 28, 62, 69, 73, 95]
</pre>
 
=={{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 96 ⟶ 1,240:
val ll2 = LinkedList(listOf('d', 'c', 'e', 'b' , 'a'))
ll2.treeSort()
}</langsyntaxhighlight>
 
{{out}}
Line 102 ⟶ 1,246:
5 3 7 9 1 -> 1 3 5 7 9
d c e b a -> a b c d e
</pre>
 
=={{header|Nim}}==
Inspired by C and Java solutions.
 
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.
 
<syntaxhighlight lang="nim">import lists, random
 
 
func treeInsert[T](tree: var DoublyLinkedNode[T]; node: DoublyLinkedNode[T]) =
if tree.isNil: tree = node
elif node.value < tree.value: tree.prev.treeInsert(node)
else: tree.next.treeInsert(node)
 
 
func listFromTree[T](list: var DoublyLinkedList[T]; node: DoublyLinkedNode[T]) =
if node.isNil: return
let prev = node.prev
let next = node.next
list.listFromTree(prev)
list.append(node)
list.listFromTree(next)
 
 
func treeSort[T](list: DoublyLinkedList[T]): DoublyLinkedList[T] =
var list = list
if list.head == list.tail: return list
var n = list.head
var root: DoublyLinkedNode[T] = nil
while not n.isNil:
var next = n.next
n.next = nil
n.prev = nil
root.treeInsert(n)
n = next
result = initDoublyLinkedList[T]()
result.listFromTree(root)
 
 
randomize()
var list1 = initDoublyLinkedList[int]()
for i in 0..15: list1.append(rand(10..99))
echo "Before sort: ", list1
echo "After sort: ", list1.treeSort()
echo()
 
var list2 = initDoublyLinkedList[string]()
for s in ["one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten"]:
list2.append(s)
echo "Before sort: ", list2
echo "After sort: ", list2.treeSort()</syntaxhighlight>
 
{{out}}
<pre>Before sort: [27, 33, 51, 66, 34, 56, 81, 78, 32, 63, 78, 48, 71, 66, 30, 49]
After sort: [27, 30, 32, 33, 34, 48, 49, 51, 56, 63, 66, 66, 71, 78, 78, 81]
 
Before sort: ["one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten"]
After sort: ["eight", "five", "four", "nine", "one", "seven", "six", "ten", "three", "two"]</pre>
 
=={{header|Ol}}==
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.
 
<syntaxhighlight lang="scheme">
(define (tree-sort l)
(map car (ff->list
(fold (lambda (ff p)
(put ff p #t))
#empty l))))
 
(print (tree-sort '(5 3 7 9 1)))
</syntaxhighlight>
{{out}}
<pre>
(1 3 5 7 9)
</pre>
 
=={{header|Phix}}==
=== version 1 ===
{{trans|Kotlin}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">KEY</span><span style="color: #0000FF;">,</span><span style="color: #000000;">LEFT</span><span style="color: #0000FF;">,</span><span style="color: #000000;">RIGHT</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">item</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">node</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">item</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">node</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (one level only needed)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">item</span><span style="color: #0000FF;"><</span><span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">KEY</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">LEFT</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">LEFT</span><span style="color: #0000FF;">],</span><span style="color: #000000;">item</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">RIGHT</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">RIGHT</span><span style="color: #0000FF;">],</span><span style="color: #000000;">item</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">node</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">inOrder</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">!=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inOrder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">LEFT</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">KEY</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">inOrder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">[</span><span style="color: #000000;">RIGHT</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">treeSort</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span> <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">({</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" =&gt; "</span><span style="color: #0000FF;">,</span><span style="color: #000000;">inOrder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<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>
<!--</syntaxhighlight>-->
{{out}}
<pre>
{{5,3,7,9,1}, " => ", {1,3,5,7,9}}
{"dceba", " => ", "abcde"}
</pre>
 
=== version 2 ===
Following my idea of a revised task description, see talk page.
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #000080;font-style:italic;">-- doubly linked list:</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">NEXT</span><span style="color: #0000FF;">,</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">,</span><span style="color: #000000;">DATA</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">empty_dll</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}}</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">dll</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">insert_after</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">data</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">pos</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">prv</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">pos</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">dll</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">pos</span><span style="color: #0000FF;">,</span><span style="color: #000000;">prv</span><span style="color: #0000FF;">,</span><span style="color: #000000;">data</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">prv</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">prv</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">pos</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">append_node</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- (like insert_after, but in situ rebuild)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">prev</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">node</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">node</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">prev</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">prev</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">node</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">node</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">dll_collect</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">DATA</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #000080;font-style:italic;">-- tree:</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">LEFT</span><span style="color: #0000FF;">,</span><span style="color: #000000;">RIGHT</span><span style="color: #0000FF;">,</span><span style="color: #000000;">KEY</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">item</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">idx</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">branch</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">item</span><span style="color: #0000FF;"><</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">root</span><span style="color: #0000FF;">][</span><span style="color: #000000;">KEY</span><span style="color: #0000FF;">]?</span><span style="color: #000000;">LEFT</span><span style="color: #0000FF;">:</span><span style="color: #000000;">RIGHT</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">root</span><span style="color: #0000FF;">][</span><span style="color: #000000;">branch</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">root</span><span style="color: #0000FF;">][</span><span style="color: #000000;">branch</span><span style="color: #0000FF;">],</span><span style="color: #000000;">item</span><span style="color: #0000FF;">,</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">root</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">traverse</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">node</span><span style="color: #0000FF;">!=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">traverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">node</span><span style="color: #0000FF;">][</span><span style="color: #000000;">LEFT</span><span style="color: #0000FF;">])</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">right</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">node</span><span style="color: #0000FF;">][</span><span style="color: #000000;">RIGHT</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">append_node</span><span style="color: #0000FF;">(</span><span style="color: #000000;">node</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">traverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #004080;">bool</span> <span style="color: #000000;">detailed</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">treeSort</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">detailed</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?{</span><span style="color: #008000;">"initial dll"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">next</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">NEXT</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">PREV</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">DATA</span><span style="color: #0000FF;">],</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">next</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- (0 is meaningless, but aligns output)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">detailed</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?{</span><span style="color: #008000;">"tree insitu"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">empty_dll</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">traverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">detailed</span> <span style="color: #008080;">then</span>
<span style="color: #0000FF;">?{</span><span style="color: #008000;">"rebuilt dll"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">dll</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">empty_dll</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #000000;">insert_after</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span> <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #0000FF;">?{</span><span style="color: #008000;">"unsorted"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll_collect</span><span style="color: #0000FF;">()}</span>
<span style="color: #000000;">treeSort</span><span style="color: #0000FF;">()</span>
<span style="color: #0000FF;">?{</span><span style="color: #008000;">"sorted"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dll_collect</span><span style="color: #0000FF;">()}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">test</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;">detailed</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">false</span>
<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>
<!--</syntaxhighlight>-->
{{out}}
<pre>
{"unsorted",{5,3,7,9,1}}
{"initial dll",{{2,6},{3,1,5},{4,2,3},{5,3,7},{6,4,9},{1,5,1}}}
{"tree insitu",{{2,0},{3,4,5},{6,0,3},{0,5,7},{0,0,9},{0,0,1}}}
{"rebuilt dll",{{6,5},{4,3,5},{2,6,3},{5,2,7},{1,4,9},{3,1,1}}}
{"sorted",{1,3,5,7,9}}
{"unsorted","dceba"}
{"sorted","abcde"}
{"unsorted",{"d","c","e","b","a"}}
{"sorted",{"a","b","c","d","e"}}
</pre>
 
Line 107 ⟶ 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 136 ⟶ 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 145 ⟶ 1,572:
{{libheader|Matchable}}
{{works with|Chicken Scheme}}
<langsyntaxhighlight Schemelang="scheme">(use matchable)
 
(define insert
Line 175 ⟶ 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}}==
{{trans|Kotlin}}
{{libheader|Wren-llist}}
{{libheader|wren-sort}}
<syntaxhighlight lang="wren">import "./llist" for DLinkedList
import "./sort" for Cmp
 
class BinaryTree {
construct new() {
_node = null
_leftSubTree = null
_rightSubTree = null
}
 
insert(item) {
if (!_node) {
_node = item
_leftSubTree = BinaryTree.new()
_rightSubTree = BinaryTree.new()
} else {
var cmp = Cmp.default(item)
if (cmp.call(item, _node) < 0) {
_leftSubTree.insert(item)
} else {
_rightSubTree.insert(item)
}
}
}
 
inOrder() {
if (!_node) return
_leftSubTree.inOrder()
System.write("%(_node) ")
_rightSubTree.inOrder()
}
}
 
var treeSort = Fn.new { |ll|
var searchTree = BinaryTree.new()
for (item in ll) searchTree.insert(item)
System.write("%(ll.join(" ")) -> ")
searchTree.inOrder()
System.print()
}
 
var ll = DLinkedList.new([5, 3, 7, 9, 1])
treeSort.call(ll)
var ll2 = DLinkedList.new(["d", "c", "e", "b", "a"])
treeSort.call(ll2)</syntaxhighlight>
 
{{out}}
<pre>
5 3 7 9 1 -> 1 3 5 7 9
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 207 ⟶ 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>
9,476

edits