Sorting algorithms/Merge sort: Difference between revisions

Content added Content deleted
(Add Refal)
(→‎{{header|Component Pascal}}: Modified to show that the sort is stable)
Line 2,877: Line 2,877:
The merge sort algorithm is often the best choice for sorting a linked list.
The merge sort algorithm is often the best choice for sorting a linked list.


The `Sort` procedure reduces the number of traversals and memory allocations by:
The `Sort` procedure reduces the number of traversals by calculating the length only once at the beginning of the sorting process.
This optimization leads to a more efficient sorting process, making it faster, especially for large input lists.
calling `Length` only once at the beginning of the sorting process and
avoiding the creation of new list segments.
These optimizations lead to a more efficient sorting process, making it faster, especially for large input lists.

It uses a helper `TakeSort` procedure, which takes the length of the list as a parameter and sorts the list in a bottom-up manner
without explicitly splitting the list into smaller parts.
Within the recursive calls to the helper `TakeSort` procedure, the value of n is manipulated to calculate the lengths of sublists.
The lengths of these sublists are used for further recursive calls but are not recalculated using `Length`.


Two modules are provided - for implementing and for using the merge sort .
Two modules are provided - for implementing and for using the merge sort .
<syntaxhighlight lang="oberon2">
<syntaxhighlight lang="oberon2">
MODULE RosettaMergeSort;
MODULE RosettaMergeSort;



TYPE Template* = ABSTRACT RECORD END;
TYPE Template* = ABSTRACT RECORD END;
Line 2,895: Line 2,890:
(* Abstract Procedures: *)
(* Abstract Procedures: *)


(* Return TRUE if `front` comes before `rear` in the sorted order, FALSE otherwise *)
(* Return TRUE if list item`front` comes before list item `rear` in the sorted order, FALSE otherwise *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Template) Pre- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
PROCEDURE (IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;


(* Return the next element in the list after `s` *)
(* Return the next item in the list after `s` *)
PROCEDURE (IN t: Template) Suc- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
PROCEDURE (IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;


(* Update the next pointer of `s` to the value of `next` - Return the modified `s` *)
(* Update the next pointer of list item `s` to the value of list `next` - Return the modified `s` *)
PROCEDURE (IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;
PROCEDURE (IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;

(* Return the total number of elements in the list starting from `s` *)
PROCEDURE (IN t: Template) Length* (s: ANYPTR): INTEGER, NEW;
VAR n: INTEGER;
BEGIN
n := 0;
WHILE s # NIL DO
INC(n);
s := t.Suc(s)
END;
RETURN n
END Length;


(* Merge sorted lists `front` and `rear` - Return the merged sorted list *)
(* Merge sorted lists `front` and `rear` - Return the merged sorted list *)
Line 2,922: Line 2,905:
IF front = NIL THEN RETURN rear END;
IF front = NIL THEN RETURN rear END;
IF rear = NIL THEN RETURN front END;
IF rear = NIL THEN RETURN front END;
IF t.Pre(front, rear) THEN
IF t.Before(front, rear) THEN
RETURN t.Set(front, t.Merge(t.Suc(front), rear))
RETURN t.Set(front, t.Merge(t.Next(front), rear))
ELSE
ELSE
RETURN t.Set(rear, t.Merge(front, t.Suc(rear)))
RETURN t.Set(rear, t.Merge(front, t.Next(rear)))
END
END
END Merge;
END Merge;

(* Sort the first `n` items in the list `s` and drop them from `s` *)
(* Return the sorted `n` items *)
PROCEDURE (IN t: Template) TakeSort (n: INTEGER; VAR s: ANYPTR): ANYPTR, NEW;
VAR k: INTEGER; front, rear: ANYPTR;
BEGIN
IF n = 1 THEN (* base case: if `n` is 1, return the head of `s` *)
front := s; s := t.Next(s); RETURN t.Set(front, NIL)
END;
(* Divide the first `n` items of `s` into two sorted parts *)
k := n DIV 2;
front := t.TakeSort(k, s);
rear := t.TakeSort(n - k, s);
RETURN t.Merge(front, rear) (* Return the merged parts *)
END TakeSort;


(* Perform a merge sort on `s` - Return the sorted list *)
(* Perform a merge sort on `s` - Return the sorted list *)
PROCEDURE (IN t: Template) Sort* (s: ANYPTR): ANYPTR, NEW;
PROCEDURE (IN t: Template) Sort* (s: ANYPTR): ANYPTR, NEW;
VAR n: INTEGER; r: ANYPTR;

(* Take a positive integer `n` and an occupied list `s` *)
(* Sort the initial segment of `s` of length `n` and return the result *)
(* Update `s` to the list which remain when the first `n` elements are removed *)
PROCEDURE TakeSort (n: INTEGER; VAR s: ANYPTR): ANYPTR;
VAR k: INTEGER; h, front, rear: ANYPTR;
BEGIN
IF n = 1 THEN (* base case: if n = 1, return the head of `s` *)
h := s; s := t.Suc(s); RETURN t.Set(h, NIL)
END;
(* Divide the first n elements of the list into two sorted halves *)
k := n DIV 2;
front := TakeSort(k, s);
rear := TakeSort(n - k, s);
RETURN t.Merge(front, rear) (* Merge and return the halves *)
END TakeSort;

BEGIN
BEGIN
IF s = NIL THEN RETURN NIL END; (* If `s` in empty, return `s` *)
IF s = NIL THEN RETURN s END; (* If `s` is empty, return `s` *)
(* Calculate the length of the list and call TakeSort *)
(* Count of items in `s` *)
RETURN TakeSort(t.Length(s), s) (* Return the sorted list *)
n := 0; r := s; (* Initialize the item to be counted to `s` *)
WHILE r # NIL DO INC(n); r := t.Next(r) END;
RETURN t.TakeSort(n, s) (* Return the sorted list *)
END Sort;
END Sort;


END RosettaMergeSort.
END RosettaMergeSort.
</syntaxhighlight>
</syntaxhighlight>
Use the merge sort implementation from `RosettaMergeSort` to sort a linked list of characters:
Interface extracted from implementation:
<syntaxhighlight lang="oberon2">
DEFINITION RosettaMergeSort;

TYPE
Template = ABSTRACT RECORD
(IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
(IN t: Template) Length (s: ANYPTR): INTEGER, NEW;
(IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
(IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;
(IN t: Template) Sort (s: ANYPTR): ANYPTR, NEW
END;

END RosettaMergeSort.
</syntaxhighlight>
Use the merge sort implementation from `RosettaMergeSort` to sort a linked list of integers:
<syntaxhighlight lang="oberon2">
<syntaxhighlight lang="oberon2">
MODULE RosettaMergeSortUse;
MODULE RosettaMergeSortUse;


(* Import Modules: *)
(* Import Modules: *)

IMPORT Sort := RosettaMergeSort, Out;
IMPORT Sort := RosettaMergeSort, Out;


(* Type Definitions: *)
(* Type Definitions: *)
TYPE
TYPE
(* a character list *)
(* a linked list node containing an integer and a pointer to the next node *)
List = POINTER TO RECORD
List = POINTER TO RECORD
value: INTEGER;
value: CHAR;
next: List
next: List
END;
END;


(* Implement the abstract record type Sort.Template *)
(* Implement the abstract record type Sort.Template *)
Template = RECORD (Sort.Template) END;
Order = ABSTRACT RECORD (Sort.Template) END;
Asc = RECORD (Order) END;
Bad = RECORD (Order) END;
Desc = RECORD (Order) END;


(* Abstract Procedure Implementations: *)
(* Abstract Procedure Implementations: *)

(* Compare integers in the list nodes to determine their order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Template) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN RETURN front(List).value <= rear(List).value END Before;


(* Return the next node in the linked list *)
(* Return the next node in the linked list *)
PROCEDURE (IN t: Template) Next (s: ANYPTR): ANYPTR;
PROCEDURE (IN t: Order) Next (s: ANYPTR): ANYPTR;
BEGIN RETURN s(List).next END Next;
BEGIN RETURN s(List).next END Next;


(* Set the next pointer of a list node *)
(* Set the next pointer of list item `s` to `next` - Return the updated `s` *)
PROCEDURE (IN t: Template) Set (s, next: ANYPTR): ANYPTR;
PROCEDURE (IN t: Order) Set (s, next: ANYPTR): ANYPTR;
BEGIN
BEGIN
IF next = NIL THEN
IF next = NIL THEN s(List).next := NIL
s(List).next := NIL
ELSE s(List).next := next(List) END;
ELSE
s(List).next := next(List)
END;
RETURN s
RETURN s
END Set;
END Set;

(* Ignoring case, compare characters to determine ascending order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Asc) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) <= CAP(rear(List).value)
END Before;

(* Unstable sort!!! *)
PROCEDURE (IN t: Bad) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) < CAP(rear(List).value)
END Before;

(* Ignoring case, compare characters to determine descending order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Desc) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) >= CAP(rear(List).value)
END Before;


(* Helper Procedures: *)
(* Helper Procedures: *)


(* Prefix a node to a list *)
(* Takes a string and converts it into a linked list of characters *)
PROCEDURE Prefix (value: INTEGER; s: List): List;
PROCEDURE Explode (str: ARRAY OF CHAR): List;
VAR new: List;
VAR i: INTEGER; h, t: List;
BEGIN
BEGIN
i := LEN(str$);
NEW(new); new.value := value; new.next := s; RETURN new
WHILE i # 0 DO
END Prefix;
t := h; NEW(h);
DEC(i); h.value := str[i];
h.next := t
END;
RETURN h
END Explode;


(* Write a list *)
(* Outputs the characters in a linked list as a string in quotes *)
PROCEDURE Show (s: List);
PROCEDURE Show (s: List);
VAR count: INTEGER;
VAR i: INTEGER;
BEGIN
BEGIN
Out.Char('"');
count := 0;
WHILE s # NIL DO
WHILE s # NIL DO Out.Char(s.value); s := s.next END;
Out.Char('"')
IF count = 10 THEN
Out.Ln; (* Insert a newline after displaying 10 numbers *)
count := 0
END;
Out.Int(s.value, 4);
s := s.next;
INC(count)
END
END Show;
END Show;


(* Main Procedure: *)
(* Main Procedure: *)
PROCEDURE Use*;
PROCEDURE Use*;
VAR t: Template; s: List;
VAR a: Asc; b: Bad; d: Desc; s: List;
(* Calls Prefix to add integers to the beginning of the list `s` *)
PROCEDURE b (value: INTEGER); BEGIN s := Prefix(value, s) END b;
BEGIN
BEGIN
s := Explode("A quick brown fox jumps over the lazy dog");
(* Use the `b` procedure to add the integers to the list `s` *)
Out.String("Before:"); Out.Ln; Show(s); Out.Ln;
b(663); b(085); b(534); b(066); b(038); b(323); b(727); b(651);
s := a.Sort(s)(List); (* Ascending stable sort *)
b(625); b(706); b(149); b(956); b(804); b(626); b(106); b(230);
Out.String("After Asc:"); Out.Ln; Show(s); Out.Ln;
b(314); b(249); b(758); b(236); b(775); b(399); b(701); b(296);
b(770); b(380); b(403); b(760); b(159); b(551); b(153); b(297);
s := b.Sort(s)(List); (* Ascending unstable sort *)
Out.String("After Bad:"); Out.Ln; Show(s); Out.Ln;
b(130); b(866); b(937); b(226); b(298); b(029); b(149); b(381);
s := d.Sort(s)(List); (* Descending stable sort *)
b(590); b(255); b(101); b(485); b(801); b(223); b(645); b(458);
Out.String("After Desc:"); Out.Ln; Show(s); Out.Ln
b(068); b(683);
Out.String("Before:"); Out.Ln;
Show(s); Out.Ln;
s := t.Sort(s)(List);
Out.String("After:"); Out.Ln;
Show(s); Out.Ln
END Use;
END Use;



END RosettaMergeSortUse.Use
END RosettaMergeSortUse.
</syntaxhighlight>
</syntaxhighlight>
Execute: ^Q RosettaMergeSortUse.Use
Execute: ^Q RosettaMergeSortUse.Use
{{out}}
{{out}}
<pre>
<pre>
Before:
Before:
"A quick brown fox jumps over the lazy dog"
683 68 458 645 223 801 485 101 255 590
After Asc:
381 149 29 298 226 937 866 130 297 153
" Aabcdeefghijklmnoooopqrrstuuvwxyz"
551 159 760 403 380 770 296 701 399 775
After Bad:
236 758 249 314 230 106 626 804 956 149
" aAbcdeefghijklmnoooopqrrstuuvwxyz"
706 625 651 727 323 38 66 534 85 663
After:
After Desc:
"zyxwvuutsrrqpoooonmlkjihgfeedcbaA "
29 38 66 68 85 101 106 130 149 149
153 159 223 226 230 236 249 255 296 297
298 314 323 380 381 399 403 458 485 534
551 590 625 626 645 651 663 683 701 706
727 758 760 770 775 801 804 866 937 956
</pre>
</pre>


Retrieved from "https://rosettacode.org/wiki/Sorting_algorithms/Merge_sort"