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

Content added Content deleted

Inline

Revision as of 17:52, 6 July 2022

This page uses content from Wikipedia. The current wikipedia article is at Tree_sort. The original RosettaCode article was extracted from the wikipedia article № 295989333 of 15:13, 12 June 2009 . The list of authors can be seen in the page history. As with Rosetta Code, the pre 5 June 2009 text of Wikipedia is available under the GNU FDL. (See links for details on variance)

A tree sort is a sort algorithm that builds a binary search tree from the keys to be sorted, and then traverses the tree (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.

The tree sort is considered by some to be the faster method to sort a linked list, followed by Quicksort and Mergesort:

A Comparative Study of Linked List Sorting Algorithms by Ching-Kuang Shene

Sediment sort, bubble sort, selection sort perform very badly.

http://www.martinbroadhurst.com/sorting-a-linked-list-by-turning-it-into-a-binary-tree.html

Task:
First, construct a doubly linked list (unsorted).
Then construct a tree in situ: use the prev and next of that list as left and right tree pointers.
Then traverse the tree, in order, and recreate a doubly linked list, again in situ, but of course now in sorted order.

ATS

<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</lang>

Output:

$ 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

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. Therefore 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.

C

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

}</lang>

Output:

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]

FreeBASIC

Translation of: Yabasic

<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</lang>

Output:

eight five four nine one seven six ten three two

Go

This is based on the Kotlin entry but has been adjusted to satisfy the revised task description. <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)

}</lang>

Output:

5 3 7 9 1 -> 1 3 5 7 9 
d c e b a -> a b c d e

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

<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</lang>

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

J

What *is* a sentence in Finnegan's Wake? 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).

Let's also say that we have prepared a file which contains some sort of ascii rendition of the text. Note that the final result we get here will depend on exactly how that ascii rendition was prepared. But let's just ignore that issue so we can get something working.

Next, we need to think of what kind of tree, there are a great number of kinds of trees, and they can be categorized in many different ways. For example, a directory tree is almost never a balanced binary tree. (Note that a linked list is a kind of a tree - an extremely tall and skinny unbalanced tree, but a tree nonetheless - and a binary tree at that. Then again, note that efficiency claims in general are specious, because efficient for one purpose tends to be inefficient for many other purposes.) Since we are going for efficiency here, we will implement a short, fat tree (let's call that "efficient use of the programmer's time" or something like that...). Specifically, we'll be implementing a one level deep tree which happens to have 14961 leaves connected directly to the root node. (Edit: task description has been changed to mandate a specific binary tree. But we are going to ignore that here, since the consequence would be several orders of magnitude slowdown, and a lot of extra code to write. That kind of detail can be useful in an educational setting, and in some technology settings, but it would cause real problems here.)

Simplicity is a virtue, right?

Finally, there's the matter of counting swaps. Let's define our swap count as the minimal number of swaps which would be needed to produce our sorted result.

With these choices, the task becomes:

<lang J> finn=: fread '~user/temp/wake/finneganswake.txt'

  sentences=: (<;.2~ '. '&E.@rplc&(LF,' !.?.')) finn
  #sentences

14961

     +/<:#@>C./:sentences

14945</lang>

We have to swap almost every sentence, but 16 of them can be sorted "for free" with the swaps of the other sentences.

For that matter, inspecting the lengths of the cycles formed by the minimal arrangements of swaps...

<lang J> /:~ #@>C./:sentences 1 1 2 2 4 9 12 25 32 154 177 570 846 935 1314 10877</lang>

... we can see that two of the sentences were fine right where they start out. Let's see what they are:

<lang J> ;:inv (#~(= /:~))sentences

Very, all
  fourlike tellt.  What tyronte power!</lang>

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:

<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

)</lang>

This could be wrapped differently, but it's adequate for this task.

Example use would be something like: <lang j> insert sentences

  extract</lang>

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

Java

<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);
   }

}</lang>

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

}</lang>

Output:

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]

Julia

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

</lang>

Output:

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]

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: <lang scala>// version 1.1.51

import java.util.LinkedList

class BinaryTree<T : Comparable<T>> {

   var node: T? = null
   lateinit var leftSubTree: BinaryTree<T>
   lateinit var rightSubTree: BinaryTree<T>

   fun insert(item: T) {
       if (node == null) {
           node = item
           leftSubTree = BinaryTree<T>()
           rightSubTree = BinaryTree<T>()
       }
       else if (item < node as T) { 
           leftSubTree.insert(item)
       }
       else {
           rightSubTree.insert(item)
       }
   }

   fun inOrder() {
       if (node == null) return
       leftSubTree.inOrder()
       print("$node ")
       rightSubTree.inOrder()
   }

}

fun <T : Comparable<T>> LinkedList<T>.treeSort() {

   val searchTree = BinaryTree<T>()
   for (item in this) searchTree.insert(item)
   print("${this.joinToString(" ")} -> ")
   searchTree.inOrder()
   println()

}

fun main(args: Array<String>) {

   val ll = LinkedList(listOf(5, 3, 7, 9, 1))
   ll.treeSort()
   val ll2 = LinkedList(listOf('d', 'c', 'e', 'b' , 'a'))
   ll2.treeSort()

}</lang>

Output:

5 3 7 9 1 -> 1 3 5 7 9 
d c e b a -> a b c d e

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.

<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()</lang>

Output:

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

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.

<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))) </lang>

Output:

(1 3 5 7 9)

Phix

version 1

Translation of: Kotlin

with javascript_semantics

enum KEY,LEFT,RIGHT
function tree_insert(object node, item)
    if node=NULL then
        node = {item,NULL,NULL}
    else
        node = deep_copy(node,1) -- (one level only needed)
        if item<node[KEY] then
            node[LEFT] = tree_insert(node[LEFT],item)
        else
            node[RIGHT] = tree_insert(node[RIGHT],item)
        end if
    end if
    return node
end function
 
function inOrder(object node)
    sequence res = ""
    if node!=NULL then
        res = inOrder(node[LEFT])
        res &= node[KEY]
        res &= inOrder(node[RIGHT])
    end if
    return res
end function
 
procedure treeSort(sequence s)
    object tree = NULL
    for i=1 to length(s) do tree = tree_insert(tree,s[i]) end for
    pp({s," => ",inOrder(tree)})
end procedure
 
treeSort({5, 3, 7, 9, 1})
treeSort("dceba")

Output:

{{5,3,7,9,1}, " => ", {1,3,5,7,9}}
{"dceba", " => ", "abcde"}

version 2

Following my idea of a revised task description, see talk page.

with javascript_semantics

-- doubly linked list:
enum NEXT,PREV,DATA
constant empty_dll = {{1,1}}
sequence dll

procedure insert_after(object data, integer pos=1)
    integer prv = dll[pos][PREV]
    dll = append(dll,{pos,prv,data})
    if prv!=0 then
        dll[prv][NEXT] = length(dll)
    end if
    dll[pos][PREV] = length(dll)
end procedure
 
procedure append_node(integer node)
-- (like insert_after, but in situ rebuild)
    integer prev = dll[1][PREV]
    dll[node][NEXT] = 1
    dll[node][PREV] = prev
    dll[prev][NEXT] = node
    dll[1][PREV] = node
end procedure
 
function dll_collect()
    sequence res = ""
    integer idx = dll[1][NEXT]
    while idx!=1 do
        res = append(res,dll[idx][DATA])
        idx = dll[idx][NEXT]
    end while
    return res
end function
 
-- tree:
enum LEFT,RIGHT,KEY
 
function tree_insert(integer root, object item, integer idx)
    if root=NULL then
        return idx
    else
        integer branch = iff(item<dll[root][KEY]?LEFT:RIGHT)
        dll[root][branch] = tree_insert(dll[root][branch],item,idx)
        return root
    end if
end function
 
procedure traverse(integer node)
    if node!=NULL then
        traverse(dll[node][LEFT])
        integer right = dll[node][RIGHT]
        append_node(node)
        traverse(right)
    end if
end procedure
 
bool detailed = true
procedure treeSort()
    if detailed then
        ?{"initial dll",dll}
    end if
    integer tree = NULL,
            idx = dll[1][NEXT]
    while idx!=1 do
        integer next = dll[idx][NEXT]
        dll[idx][NEXT] = NULL
        dll[idx][PREV] = NULL
        tree = tree_insert(tree,dll[idx][DATA],idx)
        idx = next
    end while
    dll[1] = {tree,0} -- (0 is meaningless, but aligns output)
    if detailed then
        ?{"tree insitu",dll}
    end if
    dll[1] = deep_copy(empty_dll[1])
    traverse(tree)
    if detailed then
        ?{"rebuilt dll",dll}
    end if
end procedure
 
procedure test(sequence s)
    dll = deep_copy(empty_dll)
    for i=1 to length(s) do insert_after(s[i]) end for
    ?{"unsorted",dll_collect()}
    treeSort()
    ?{"sorted",dll_collect()}
end procedure
 
test({5, 3, 7, 9, 1})
detailed = false
test("dceba")
test({"d","c","e","b","a"})

Output:

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

Racket

Translation of: Scheme

-- this implementation illustrates differences in identifiers and syntaxes of Scheme and Racket's match-lambda family. racket/match documented here.

<lang racket>#lang racket/base (require racket/match)

(define insert

 ;; (insert key tree)
 (match-lambda**
  [(x '())         `(() ,x ())]
  [(x '(() () ())) `(() ,x ())]
  [(x `(,l ,k ,r)) #:when (<= x k) `(,(insert x l) ,k ,r)]
  [(x `(,l ,k ,r)) `(,l ,k ,(insert x r))]
  [(_ _) "incorrect arguments or broken tree"]))

(define in-order

 ;; (in-order tree)
 (match-lambda
   [`(() ,x ()) `(,x)]
   [`(,l ,x ())  (append (in-order l) `(,x))]
   [`(() ,x ,r)  (append `(,x) (in-order r))]
   [`(,l ,x ,r)  (append (in-order l) `(,x) (in-order r))]
   [_ "incorrect arguments or broken tree"]))

(define (tree-sort lst)

 (define tree-sort-itr
   (match-lambda**
     [(x `())        (in-order x)]
     [(x `(,a . ,b)) (tree-sort-itr (insert a x) b)] 
     [(_ _) "incorrect arguments or broken tree"]))
 (tree-sort-itr '(() () ()) lst))

(tree-sort '(5 3 7 9 1))</lang>

Output:

'(1 3 5 7 9)

Scheme

The following implements a sorting algorithm that takes a linked list, puts each key into an unbalanced binary tree and returns an in-order traversal of the tree.

Library: Matchable

Works with: Chicken Scheme

<lang Scheme>(use matchable)

(define insert

 ;; (insert key tree)
 (match-lambda*
  [(x ())         `(() ,x ()) ]
  [(x (() () ())) `(() ,x ()) ]
  [(x (l k r))
   (=> continue)
   (if (<= x k)

`(,(insert x l) ,k ,r) (continue)) ]

  [(x (l k r)) `(,l ,k ,(insert x r)) ]
  [_ "incorrect arguments or broken tree" ]))

(define in-order

 ;; (in-order tree)
 (match-lambda
  [(() x ()) `(,x)]
  [(l x ())  (append (in-order l) `(,x))]
  [(() x r)  (append `(,x) (in-order r))]
  [(l x r)   (append (in-order l) `(,x) (in-order r))]
  [_ "incorrect arguments or broken tree" ]))

(define (tree-sort lst)

 (define tree-sort-itr
   (match-lambda*
    [(x ())      (in-order x)]
    [(x (a . b)) (tree-sort-itr (insert a x) b)] 
    [_ "incorrect arguments or broken tree" ]))
 (tree-sort-itr '(() () ()) lst))</lang>

Usage: <lang Scheme> #;2> (tree-sort '(5 3 7 9 1)) (1 3 5 7 9)</lang>

Wren

Translation of: Kotlin

Library: Wren-llist

Library: wren-sort

<lang ecmascript>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)</lang>

Output:

5 3 7 9 1 -> 1 3 5 7 9 
d c e b a -> a b c d e

Yabasic

<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</lang>

Output:

eight five four nine one seven six ten three two
---Program done, press RETURN---

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. <lang zkl>class Node{

  var left,right,value;
  fcn init(value){ self.value=value; }

} class Tree{

  var root;
  fcn add(value){
     if(not root){ root=Node(value); return(self); }
     fcn(node,value){

if(not node) return(Node(value)); if(value!=node.value){ // don't add duplicate values if(value<node.value) node.left =self.fcn(node.left, value); else node.right=self.fcn(node.right,value); } node

     }(root,value);
     return(self);
  }
  fcn walker{ Utils.Generator(walk,root); }
  fcn walk(node){	// in order traversal
     if(node){
        self.fcn(node.left);
        vm.yield(node.value);
        self.fcn(node.right);
     }
  }

}</lang> <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) }</lang>

Output:

...
Atomic.sleep(0.5);
Atomic.sleep(100000);
Atomic.sleep(2);
Atomic.waitFor(fcn{
Boyz:=Boys.pump(D(),fcn([(b,gs)]){
Compiler.Compiler.compileText(code)();
...