Sorting algorithms/Merge sort: Difference between revisions

→‎{{header|Component Pascal}}: Modified to show that the sort is stable
(Add Refal)
(→‎{{header|Component Pascal}}: Modified to show that the sort is stable)
Line 2,877:
The merge sort algorithm is often the best choice for sorting a linked list.
 
The `Sort` procedure reduces the number of traversals andby memorycalculating allocationsthe by: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 .
<syntaxhighlight lang="oberon2">
MODULE RosettaMergeSort;
 
 
TYPE Template* = ABSTRACT RECORD END;
Line 2,895 ⟶ 2,890:
(* Abstract Procedures: *)
 
(* 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 *)
PROCEDURE (IN t: Template) PreBefore- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
 
(* Return the next elementitem in the list after `s` *)
PROCEDURE (IN t: Template) SucNext- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
 
(* 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;
 
(* 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 *)
Line 2,922 ⟶ 2,905:
IF front = NIL THEN RETURN rear END;
IF rear = NIL THEN RETURN front END;
IF t.PreBefore(front, rear) THEN
RETURN t.Set(front, t.Merge(t.SucNext(front), rear))
ELSE
RETURN t.Set(rear, t.Merge(front, t.SucNext(rear)))
END
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 *)
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
IF s = NIL THEN RETURN NILs END; (* If `s` inis empty, return `s` *)
(* Calculate the lengthCount of the list anditems callin TakeSort`s` *)
RETURNn TakeSort(t.Length(s),:= 0; r := s); (* ReturnInitialize the sorteditem listto 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 RosettaMergeSort.
</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">
MODULE RosettaMergeSortUse;
 
(* Import Modules: *)
 
IMPORT Sort := RosettaMergeSort, Out;
 
(* Type Definitions: *)
TYPE
(* a character list *)
(* a linked list node containing an integer and a pointer to the next node *)
List = POINTER TO RECORD
value: INTEGERCHAR;
next: List
END;
 
(* Implement the abstract record type Sort.Template *)
TemplateOrder = ABSTRACT RECORD (Sort.Template) END;
Asc = RECORD (Order) END;
Bad = RECORD (Order) END;
Desc = RECORD (Order) END;
 
(* 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 *)
PROCEDURE (IN t: TemplateOrder) Next (s: ANYPTR): ANYPTR;
BEGIN RETURN s(List).next END Next;
 
(* Set the next pointer of a list nodeitem `s` to `next` - Return the updated `s` *)
PROCEDURE (IN t: TemplateOrder) Set (s, next: ANYPTR): ANYPTR;
BEGIN
IF next = NIL THEN s(List).next := NIL
ELSE s(List).next := NILnext(List) END;
ELSE
s(List).next := next(List)
END;
RETURN s
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: *)
 
(* PrefixTakes a nodestring toand converts it into a linked list of characters *)
PROCEDURE PrefixExplode (valuestr: INTEGER;ARRAY s:OF ListCHAR): List;
VAR newi: INTEGER; h, t: List;
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;
 
(* WriteOutputs the characters in a linked list as a string in quotes *)
PROCEDURE Show (s: List);
VAR counti: INTEGER;
BEGIN
Out.Char('"');
count := 0;
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;
 
(* Main Procedure: *)
PROCEDURE Use*;
VAR ta: TemplateAsc; 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
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);s b(380);:= b.Sort(403s); b(760List); b(159);* b(551);Ascending b(153);unstable sort b(297*);
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 RosettaMergeSortUse.Use
END RosettaMergeSortUse.
</syntaxhighlight>
Execute: ^Q RosettaMergeSortUse.Use
{{out}}
<pre>
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 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>
 
9

edits