Data update
This commit is contained in:
Ingy döt Net
parent
35bcdeebf8
commit
74c69a0df6
2427 changed files with 31826 additions and 3468 deletions
|
|
@ -0,0 +1,66 @@
|
|||
MODULE RosettaMergeSort;
|
||||
|
||||
TYPE Template* = ABSTRACT RECORD END;
|
||||
|
||||
(* Abstract Procedures: *)
|
||||
|
||||
(* Return TRUE if `front` comes before `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) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
|
||||
|
||||
(* Return the next element in the list after `s` *)
|
||||
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` *)
|
||||
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; (* Initialize the count of elements to 0 *)
|
||||
WHILE s # NIL DO (* While not at the end of the list *)
|
||||
INC(n); (* Increment the count of elements *)
|
||||
s := t.Next(s) (* Move to the next element in the linked list *)
|
||||
END;
|
||||
RETURN n (* Return the total number of elements in the linked list *)
|
||||
END Length;
|
||||
|
||||
(* Merge sorted lists `front` and `rear` - Return the merged sorted list *)
|
||||
PROCEDURE (IN t: Template) Merge (front, rear: ANYPTR): ANYPTR, NEW;
|
||||
BEGIN
|
||||
IF front = NIL THEN RETURN rear END;
|
||||
IF rear = NIL THEN RETURN front END;
|
||||
IF t.Before(front, rear) THEN
|
||||
RETURN t.Set(front, t.Merge(t.Next(front), rear))
|
||||
ELSE
|
||||
RETURN t.Set(rear, t.Merge(front, t.Next(rear)))
|
||||
END
|
||||
END Merge;
|
||||
|
||||
(* Perform a merge sort on `s` - Return the sorted list *)
|
||||
PROCEDURE (IN t: Template) Sort* (s: ANYPTR): ANYPTR, NEW;
|
||||
|
||||
(* 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.Next(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 s END; (* If `s` in empty, return `s` *)
|
||||
(* Calculate the length of the list and call TakeSort *)
|
||||
RETURN TakeSort(t.Length(s), s) (* Return the sorted list *)
|
||||
END Sort;
|
||||
|
||||
END RosettaMergeSort.
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
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.
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
MODULE RosettaMergeSortUse;
|
||||
|
||||
(* Import Modules: *)
|
||||
IMPORT Sort := RosettaMergeSort, Log := StdLog;
|
||||
|
||||
(* Type Definitions: *)
|
||||
TYPE
|
||||
(* a linked list node containing an integer and a pointer to the next node *)
|
||||
List = POINTER TO RECORD
|
||||
value: INTEGER;
|
||||
next: List
|
||||
END;
|
||||
|
||||
(* Implement the abstract record type Sort.Template *)
|
||||
Template = RECORD (Sort.Template) 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: Template) Next (s: ANYPTR): ANYPTR;
|
||||
BEGIN RETURN s(List).next END Next;
|
||||
|
||||
(* Set the next pointer of a list node *)
|
||||
PROCEDURE (IN t: Template) Set (s, next: ANYPTR): ANYPTR;
|
||||
BEGIN
|
||||
IF next = NIL THEN
|
||||
s(List).next := NIL
|
||||
ELSE
|
||||
s(List).next := next(List)
|
||||
END;
|
||||
RETURN s
|
||||
END Set;
|
||||
|
||||
(* Helper Procedures: *)
|
||||
|
||||
(* Prefix a node to a list *)
|
||||
PROCEDURE Prefix (value: INTEGER; s: List): List;
|
||||
VAR new: List;
|
||||
BEGIN
|
||||
NEW(new); new.value := value; new.next := s; RETURN new
|
||||
END Prefix;
|
||||
|
||||
(* Write a list *)
|
||||
PROCEDURE Show (s: List);
|
||||
VAR count: INTEGER;
|
||||
BEGIN
|
||||
count := 0;
|
||||
WHILE s # NIL DO
|
||||
IF count = 10 THEN
|
||||
Log.Ln; (* Insert a newline after displaying 10 numbers *)
|
||||
count := 0
|
||||
END;
|
||||
Log.IntForm(s.value, Log.decimal, 4, ' ', Log.hideBase);
|
||||
s := s.next;
|
||||
INC(count)
|
||||
END
|
||||
END Show;
|
||||
|
||||
(* Main Procedure: *)
|
||||
PROCEDURE Use*;
|
||||
VAR t: Template; 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
|
||||
(* Use the `b` procedure to add the integers to the list `s` *)
|
||||
b(663); b(085); b(534); b(066); b(038); b(323); b(727); b(651);
|
||||
b(625); b(706); b(149); b(956); b(804); b(626); b(106); b(230);
|
||||
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);
|
||||
b(130); b(866); b(937); b(226); b(298); b(029); b(149); b(381);
|
||||
b(590); b(255); b(101); b(485); b(801); b(223); b(645); b(458);
|
||||
b(068); b(683);
|
||||
Log.String("Before:"); Log.Ln;
|
||||
Show(s); Log.Ln;
|
||||
s := t.Sort(s)(List);
|
||||
Log.String("After:"); Log.Ln;
|
||||
Show(s); Log.Ln
|
||||
END Use;
|
||||
|
||||
END RosettaMergeSortUse.
|
||||
|
|
@ -1,23 +1,23 @@
|
|||
#| Recursive, single-thread, mergesort implementation
|
||||
sub mergesort ( @a ) {
|
||||
return @a if @a <= 1;
|
||||
return @a if @a <= 1;
|
||||
|
||||
# recursion step
|
||||
my $m = @a.elems div 2;
|
||||
my @l = samewith @a[ 0 ..^ $m ];
|
||||
my @r = samewith @a[ $m ..^ @a ];
|
||||
# recursion step
|
||||
my $m = @a.elems div 2;
|
||||
my @l = samewith @a[ 0 ..^ $m ];
|
||||
my @r = samewith @a[ $m ..^ @a ];
|
||||
|
||||
# short cut - in case of no overlapping left and right parts
|
||||
# short cut - in case of no overlapping in left and right parts
|
||||
return flat @l, @r if @l[*-1] !after @r[0];
|
||||
return flat @r, @l if @r[*-1] !after @l[0];
|
||||
|
||||
# merge step
|
||||
return flat gather {
|
||||
take @l[0] before @r[0]
|
||||
?? @l.shift
|
||||
!! @r.shift
|
||||
while @l and @r;
|
||||
return flat gather {
|
||||
take @l[0] before @r[0]
|
||||
?? @l.shift
|
||||
!! @r.shift
|
||||
while @l and @r;
|
||||
|
||||
take @l, @r;
|
||||
}
|
||||
take @l, @r;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,26 +1,29 @@
|
|||
#| Recursive, naive parallel, mergesort implementation
|
||||
proto mergesort-parallel-naive(| --> Positional) {*}
|
||||
multi mergesort-parallel-naive(@unsorted where @unsorted.elems < 2) { @unsorted }
|
||||
multi mergesort-parallel-naive(@unsorted where @unsorted.elems == 2) {
|
||||
@unsorted[0] after @unsorted[1]
|
||||
?? (@unsorted[1], @unsorted[0])
|
||||
!! @unsorted
|
||||
}
|
||||
multi mergesort-parallel-naive(@unsorted) {
|
||||
my $mid = @unsorted.elems div 2;
|
||||
my Promise $left-sorted = start { flat samewith @unsorted[ 0 ..^ $mid ] };
|
||||
my @right-sorted = flat samewith @unsorted[ $mid ..^ @unsorted.elems ];
|
||||
#| Recursive, naive multi-thread, mergesort implementation
|
||||
sub mergesort-parallel-naive ( @a ) {
|
||||
return @a if @a <= 1;
|
||||
|
||||
await $left-sorted andthen my @left-sorted = $left-sorted.result;
|
||||
my $m = @a.elems div 2;
|
||||
|
||||
return flat @left-sorted, @right-sorted if @left-sorted[*-1] !after @right-sorted[0];
|
||||
return flat @right-sorted, @left-sorted if @right-sorted[*-1] !after @left-sorted[0];
|
||||
# recursion step launching new thread
|
||||
my @l = start { samewith @a[ 0 ..^ $m ] };
|
||||
|
||||
return flat gather {
|
||||
take @left-sorted[0] before @right-sorted[0]
|
||||
?? @left-sorted.shift
|
||||
!! @right-sorted.shift
|
||||
while @left-sorted.elems and @right-sorted.elems;
|
||||
take @left-sorted, @right-sorted;
|
||||
# meanwhile recursively sort right side
|
||||
my @r = samewith @a[ $m ..^ @a ] ;
|
||||
|
||||
# as we went parallel on left side, we need to await the result
|
||||
await @l[0] andthen @l = @l[0].result;
|
||||
|
||||
# short cut - in case of no overlapping left and right parts
|
||||
return flat @l, @r if @l[*-1] !after @r[0];
|
||||
return flat @r, @l if @r[*-1] !after @l[0];
|
||||
|
||||
# merge step
|
||||
return flat gather {
|
||||
take @l[0] before @r[0]
|
||||
?? @l.shift
|
||||
!! @r.shift
|
||||
while @l and @r;
|
||||
|
||||
take @l, @r;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,47 +1,31 @@
|
|||
constant $BATCH-SIZE = 2**10;
|
||||
my atomicint $worker = $*KERNEL.cpu-cores;
|
||||
#| Recursive, batch tuned multi-thread, mergesort implementation
|
||||
sub mergesort-parallel ( @a, $batch = 2**9 ) {
|
||||
return @a if @a <= 1;
|
||||
|
||||
#| Recursive, parallel, tuned, mergesort implementation
|
||||
proto mergesort-parallel(| --> Positional) {*}
|
||||
multi mergesort-parallel(@unsorted where @unsorted.elems < 2) { @unsorted }
|
||||
multi mergesort-parallel(@unsorted where @unsorted.elems == 2) {
|
||||
@unsorted[0] after @unsorted[1]
|
||||
?? (@unsorted[1], @unsorted[0])
|
||||
!! @unsorted
|
||||
}
|
||||
multi mergesort-parallel(@unsorted) {
|
||||
my $mid = @unsorted.elems div 2;
|
||||
my $m = @a.elems div 2;
|
||||
|
||||
# atomically decide if we run left side on a new thread
|
||||
my $left-sorted = ⚛$worker > 0 &&
|
||||
$mid > $BATCH-SIZE
|
||||
?? (
|
||||
$worker⚛--;
|
||||
start {
|
||||
LEAVE $worker⚛++;
|
||||
samewith @unsorted[ 0 ..^ $mid ]
|
||||
}
|
||||
)
|
||||
!! samewith @unsorted[ 0 ..^ $mid ];
|
||||
# recursion step
|
||||
my @l = $m >= $batch
|
||||
?? start { samewith @a[ 0 ..^ $m ], $batch }
|
||||
!! samewith @a[ 0 ..^ $m ], $batch ;
|
||||
|
||||
# recursion on the right side using current thread
|
||||
my @right-sorted = samewith @unsorted[ $mid ..^ @unsorted.elems ];
|
||||
# meanwhile recursively sort right side
|
||||
my @r = samewith @a[ $m ..^ @a ], $batch;
|
||||
|
||||
# await calculation of left side
|
||||
await $left-sorted andthen $left-sorted = flat $left-sorted.result
|
||||
if $left-sorted ~~ Promise;
|
||||
my @left-sorted = flat $left-sorted;
|
||||
# if we went parallel on left side, we need to await the result
|
||||
await @l[0] andthen @l = @l[0].result if @l[0] ~~ Promise;
|
||||
|
||||
# short cut - in case of no overlapping left and right parts
|
||||
return flat @left-sorted, @right-sorted if @left-sorted[*-1] !after @right-sorted[0];
|
||||
return flat @right-sorted, @left-sorted if @right-sorted[*-1] !after @left-sorted[0];
|
||||
return flat @l, @r if @l[*-1] !after @r[0];
|
||||
return flat @r, @l if @r[*-1] !after @l[0];
|
||||
|
||||
# merge step
|
||||
return flat gather {
|
||||
take @left-sorted[0] before @right-sorted[0]
|
||||
?? @left-sorted.shift
|
||||
!! @right-sorted.shift
|
||||
while @left-sorted.elems and @right-sorted.elems;
|
||||
take @left-sorted, @right-sorted;
|
||||
take @l[0] before @r[0]
|
||||
?? @l.shift
|
||||
!! @r.shift
|
||||
while @l and @r;
|
||||
|
||||
take @l, @r;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,31 +1,18 @@
|
|||
say "x" x 10 ~ " Testing " ~ "x" x 10;
|
||||
use Test;
|
||||
my @functions-under-test = &mergesort, &mergesort-parallel-naive, &mergesort-parallel;
|
||||
my @testcases =
|
||||
() => (),
|
||||
<a>.List => <a>.List,
|
||||
<a a> => <a a>,
|
||||
<a b> => <a b>,
|
||||
<b a> => <a b>,
|
||||
("b", "a", 3) => (3, "a", "b"),
|
||||
<h b a c d f e g> => <a b c d e f g h>,
|
||||
(2, 3, 1, 4, 5) => (1, 2, 3, 4, 5),
|
||||
<a 🎮 3 z 4 🐧> => <a 🎮 3 z 4 🐧>.sort
|
||||
;
|
||||
my @implementations = &mergesort, &mergesort-parallel, &mergesort-parallel-naive;
|
||||
plan @testcases.elems * @implementations.elems;
|
||||
for @implementations -> &fun {
|
||||
|
||||
plan @testcases.elems * @functions-under-test.elems;
|
||||
for @functions-under-test -> &fun {
|
||||
say &fun.name;
|
||||
is-deeply &fun(.key), .value, .key ~ " => " ~ .value for @testcases;
|
||||
}
|
||||
done-testing;
|
||||
|
||||
use Benchmark;
|
||||
my $elem-length = 8;
|
||||
my @unsorted of Str = ('a'..'z').roll($elem-length).join xx 10 * $worker * $BATCH-SIZE;
|
||||
my $runs = 10;
|
||||
|
||||
say "Benchmarking by $runs times sorting {@unsorted.elems} strings of size $elem-length - using batches of $BATCH-SIZE strings and $worker workers for mergesort-parallel().";
|
||||
say "Hint: watch the number of Raku threads in Activity Monitor on Mac, Ressource Monitor on Windows or htop on Linux.";
|
||||
for @implementations -> &fun {
|
||||
print &fun.name, " => avg: ";
|
||||
my ($start, $end, $diff, $avg) = timethis $runs, sub { &fun(@unsorted) }
|
||||
say "$avg secs, total $diff secs";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,27 @@
|
|||
use Benchmark;
|
||||
my $runs = 5;
|
||||
my $elems = 10 * Kernel.cpu-cores * 2**10;
|
||||
my @unsorted of Str = ('a'..'z').roll(8).join xx $elems;
|
||||
my UInt $l-batch = 2**13;
|
||||
my UInt $m-batch = 2**11;
|
||||
my UInt $s-batch = 2**9;
|
||||
my UInt $t-batch = 2**7;
|
||||
|
||||
say "elements: $elems, runs: $runs, cpu-cores: {Kernel.cpu-cores}, large/medium/small/tiny-batch: $l-batch/$m-batch/$s-batch/$t-batch";
|
||||
|
||||
my %results = timethese $runs, {
|
||||
single-thread => { mergesort(@unsorted) },
|
||||
parallel-naive => { mergesort-parallel-naive(@unsorted) },
|
||||
parallel-tiny-batch => { mergesort-parallel(@unsorted, $t-batch) },
|
||||
parallel-small-batch => { mergesort-parallel(@unsorted, $s-batch) },
|
||||
parallel-medium-batch => { mergesort-parallel(@unsorted, $m-batch) },
|
||||
parallel-large-batch => { mergesort-parallel(@unsorted, $l-batch) },
|
||||
}, :statistics;
|
||||
|
||||
my @metrics = <mean median sd>;
|
||||
my $msg-row = "%.4f\t" x @metrics.elems ~ '%s';
|
||||
|
||||
say @metrics.join("\t");
|
||||
for %results.kv -> $name, %m {
|
||||
say sprintf($msg-row, %m{@metrics}, $name);
|
||||
}
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
program merge_sort;
|
||||
test := [-8, 241, 9, 316, -6, 3, 413, 9, 10];
|
||||
print(test, '=>', mergesort(test));
|
||||
|
||||
proc mergesort(m);
|
||||
if #m <= 1 then
|
||||
return m;
|
||||
end if;
|
||||
|
||||
middle := #m div 2;
|
||||
left := mergesort(m(..middle));
|
||||
right := mergesort(m(middle+1..));
|
||||
if left(#left) <= right(1) then
|
||||
return left + right;
|
||||
end if;
|
||||
return merge(left, right);
|
||||
end proc;
|
||||
|
||||
proc merge(left, right);
|
||||
result := [];
|
||||
loop while left /= [] and right /= [] do
|
||||
if left(1) <= right(1) then
|
||||
item fromb left;
|
||||
else
|
||||
item fromb right;
|
||||
end if;
|
||||
result with:= item;
|
||||
end loop;
|
||||
return result + left + right;
|
||||
end proc;
|
||||
end program;
|
||||
Loading…
Add table
Add a link
Reference in a new issue