Rosetta Code

Sorting algorithms/Strand sort: Difference between revisions

Page Discussion

Sorting algorithms/Strand sort (view source)

Revision as of 12:31, 8 February 2024

21,990 bytes added ,  3 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
m (Added the Sidef language)
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(29 intermediate revisions by 15 users not shown)
Line 1:
{{task|Sorting Algorithms}}
{{Sorting Algorithm}}
[[Category:Sorting]]
{{Wikipedia|Strand sort}}
 
Implement the [[wp:Strand sort|Strand sort]]. This is a way of sorting numbers by extracting shorter sequences of already sorted numbers from an unsorted list.
<br>
;Task:
Implement the [[wp:Strand sort|Strand sort]].
 
This is a way of sorting numbers by extracting shorter sequences of already sorted numbers from an unsorted list.
<br><br>
 
=={{header|11l}}==
{{trans|Python}}
 
<syntaxhighlight lang="11l">F merge_list(&a, &b)
[Int] out
L !a.empty & !b.empty
I a[0] < b[0]
out.append(a.pop(0))
E
out.append(b.pop(0))
out [+]= a
out [+]= b
R out
 
F strand(&a)
V i = 0
V s = [a.pop(0)]
L i < a.len
I a[i] > s.last
s.append(a.pop(i))
E
i++
R s
 
F strand_sort(&a)
V out = strand(&a)
L !a.empty
out = merge_list(&out, &strand(&a))
R out
 
print(strand_sort(&[1, 6, 3, 2, 1, 7, 5, 3]))</syntaxhighlight>
 
{{out}}
<pre>
[1, 1, 2, 3, 3, 5, 6, 7]
</pre>
 
=={{header|AppleScript}}==
Strand sort seems to be essentially a merge sort with a particular way of setting up the initial blocks.
<syntaxhighlight lang="applescript">-- Sort items l thru r of theList in place, ascending.
on strandSort(theList, l, r)
-- Deal with negative and/or transposed range index parameters.
set listLength to (count theList)
if (l < 0) then set l to listLength + l + 1
if (r < 0) then set r to listLength + r + 1
if (l > r) then set {l, r} to {r, l}
if ((l < 1) or (r > listLength)) then error "strandSort(): range index parameter(s) outside list range."
script o
property dest : theList -- Original list.
property src : my dest's items l thru r -- The items in the sort range.
property ranges : {}
end script
-- Individually list-wrap the items in o's src to avoid having to
-- hard-code their actual class in the line marked ** below.
repeat with i from 1 to (r - l + 1)
set o's src's item i to {o's src's item i}
end repeat
-- Extract "strands" of existing order from the sort range items
-- and write the resulting runs over the range in the original list.
set i to l
repeat until (i > r)
set j to i
set jv to o's src's beginning's beginning -- The value in src's first sublist.
set o's dest's item j to jv -- Store it in the next original-list slot
set o's src's item 1 to missing value -- Replace the sublist with a placeholder.
-- Do the same with any later values that are sequentially greater or equal.
repeat with k from 2 to (count o's src)
set kv to o's src's item k's beginning
if (kv < jv) then
else
set j to j + 1
set o's dest's item j to kv
set jv to kv
set o's src's item k to missing value
end if
end repeat
set o's ranges's end to {i, j} -- Note this strand's range in the list.
set o's src to o's src's lists -- Lose src's zapped sublists. **
set i to j + 1
end repeat
set strandCount to (count o's ranges)
if (strandCount = 1) then return -- The input list was already in order.
-- Work out how many passes the iterative merge will take and from this whether
-- the auxiliary list has to be the source or the destination during the first pass.
-- The destination in the final pass has to be the original list.
set passCount to 0
repeat while (2 ^ passCount < strandCount)
set passCount to passCount + 1
end repeat
if (passCount mod 2 = 0) then
set o's src to o's dest
set o's dest to o's dest's items
else
set o's src to o's dest's items
end if
-- Merge the strands.
repeat passCount times
set k to l -- Destination index.
repeat with rr from 2 to strandCount by 2 -- Per pair of ranges.
set {{i, ix}, {j, jx}} to o's ranges's items (rr - 1) thru rr
set o's ranges's item (rr - 1) to {i, jx}
set o's ranges's item rr to missing value
set iv to o's src's item i
set jv to o's src's item j
repeat until (k > jx)
if (iv > jv) then
set o's dest's item k to jv
if (j < jx) then
set j to j + 1
set jv to o's src's item j
else
repeat with i from i to ix
set k to k + 1
set o's dest's item k to o's src's item i
end repeat
end if
else
set o's dest's item k to iv
if (i < ix) then
set i to i + 1
set iv to o's src's item i
else
repeat with k from j to jx
set o's dest's item k to o's src's item k
end repeat
end if
end if
set k to k + 1
end repeat
end repeat
if (rr < strandCount) then -- Odd range at the end of this pass?
set {i, ix} to o's ranges's end
repeat with k from i to ix
set o's dest's item k to o's src's item k
end repeat
end if
set o's ranges to o's ranges's lists
set strandCount to (strandCount + 1) div 2
set {o's src, o's dest} to {o's dest, o's src}
end repeat
return -- nothing.
end strandSort
 
local lst
set lst to {5, 1, 4, 37, 2, 0, 9, 6, -44, 3, 8, 7}
strandSort(lst, 1, -1)
return lst</syntaxhighlight>
 
{{output}}
<syntaxhighlight lang="applescript">{-44, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 37}</syntaxhighlight>
 
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
<langsyntaxhighlight AutoHotkeylang="autohotkey">string =
(
-2 0 -2 5 5 3 -1 -3 5 5 0 2 -4 4 2
Line 32 ⟶ 197:
string := list, list = "", index := 0
}
esc::ExitApp</langsyntaxhighlight>outout<syntaxhighlight lang="text">
unsorted:-2 0 -2 5 5 3 -1 -3 5 5 0 2 -4 4 2
Sorted:-4 -3 -2 -2 -1 0 0 2 2 3 4 5 5 5 5</langsyntaxhighlight>
 
=={{header|C}}==
Strand sort using singly linked list. C99, compiled with <code>gcc -std=c99</code>
<langsyntaxhighlight Clang="c">#include <stdio.h>
 
typedef struct node_t *node, node_t;
Line 115 ⟶ 280:
 
return 0;
}</langsyntaxhighlight>outout<syntaxhighlight lang="text">before sort: -2 0 -2 5 5 3 -1 -3 5 5 0 2 -4 4 2
after sort: -4 -3 -2 -2 -1 0 0 2 2 3 4 5 5 5 5</langsyntaxhighlight>
 
=={{header|C++}}==
<langsyntaxhighlight lang="cpp">#include <list>
 
template <typename T>
Line 140 ⟶ 305:
}
return result;
}</langsyntaxhighlight>
 
=={{header|Clojure}}==
<langsyntaxhighlight Clojurelang="clojure">(ns rosettacode.strand-sort)
 
(defn merge-join
Line 178 ⟶ 343:
(strand-sort [1, 6, 3, 2, 1, 7, 5, 3])
;;=> (1 1 2 3 3 5 6 7)
</syntaxhighlight>
</lang>
 
=={{header|CMake}}==
Only for lists of integers.
<langsyntaxhighlight lang="cmake"># strand_sort(<output variable> [<value>...]) sorts a list of integers.
function(strand_sort var)
# Strand sort moves elements from _ARGN_ to _answer_.
Line 243 ⟶ 408:
 
set("${var}" ${answer} PARENT_SCOPE)
endfunction(strand_sort)</langsyntaxhighlight>
 
<langsyntaxhighlight lang="cmake">strand_sort(result 11 55 55 44 11 33 33 44 22 22)
message(STATUS "${result}") # -- 11;11;22;22;33;33;44;44;55;55</langsyntaxhighlight>
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">(defun strand-sort (l cmp)
(if l
(let* ((l (reverse l))
Line 259 ⟶ 424:
(let ((r (loop repeat 15 collect (random 10))))
(print r)
(print (strand-sort r #'<)))</langsyntaxhighlight>output<syntaxhighlight lang="text">(5 8 6 0 6 8 4 7 0 7 1 5 3 3 6)
(0 0 1 3 3 4 5 5 6 6 6 7 7 8 8)</langsyntaxhighlight>
 
=={{header|D}}==
 
=== Using doubly linked lists ===
<langsyntaxhighlight lang="d">import std.stdio, std.container;
 
DList!T strandSort(T)(DList!T list) {
Line 308 ⟶ 473:
foreach (e; strandSort(lst))
write(e, " ");
}</langsyntaxhighlight>
{{out}}
<pre>-4 -3 -2 -2 -1 0 0 2 2 3 4 5 5 5 5 </pre>
 
=== Faster version using slices ===
<langsyntaxhighlight lang="d">import std.stdio, std.array;
 
T[] strandSort(T)(const(T)[] list) pure nothrow {
Line 347 ⟶ 512:
const arr = [-2, 0, -2, 5, 5, 3, -1, -3, 5, 5, 0, 2, -4, 4, 2];
arr.strandSort.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[-4, -3, -2, -2, -1, 0, 0, 2, 2, 3, 4, 5, 5, 5, 5]</pre>
 
=={{header|Elixir}}==
{{trans|Ruby}}
<syntaxhighlight lang="elixir">defmodule Sort do
def strand_sort(args), do: strand_sort(args, [])
defp strand_sort([], result), do: result
defp strand_sort(a, result) do
{_, sublist, b} = Enum.reduce(a, {hd(a),[],[]}, fn val,{v,l1,l2} ->
if v <= val, do: {val, [val | l1], l2},
else: {v, l1, [val | l2]}
end)
strand_sort(b, :lists.merge(Enum.reverse(sublist), result))
end
end
 
IO.inspect Sort.strand_sort [7, 17, 6, 20, 20, 12, 1, 1, 9]</syntaxhighlight>
 
{{out}}
<pre>
[1, 1, 6, 7, 9, 12, 17, 20, 20]
</pre>
 
=={{header|Euphoria}}==
<langsyntaxhighlight lang="euphoria">function merge(sequence left, sequence right)
sequence result
result = {}
Line 394 ⟶ 581:
? s
puts(1,"After: ")
? strand_sort(s)</langsyntaxhighlight>
 
Output:
Line 400 ⟶ 587:
After: {18,51,340,346,417,502,551,746,903,940}</pre>
 
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
// Strand sort. Nigel Galloway: August 18th., 2023
let fN g=let mutable n=g in fun g->if n>g then false else n<-g; true
let fI n=let fN=fN(List.head n) in List.partition fN n
let rec fG n g=[match n,g with [],g|g,[]->yield! g
|n::gn,i::ng when n<i->yield n; yield! fG gn g
|n,g::ng->yield g; yield! fG n ng]
let rec fL n g=match n with []->g |_->let n,i=fI n in fL i (n::g)
let sort n=fL n []|>List.fold(fun n g->fG n g)[]
printfn "%A" (sort ["one";"two";"three";"four"]);;
printfn "%A" (sort [2;3;1;5;11;7;5])
</syntaxhighlight>
{{out}}
<pre>
["four"; "one"; "three"; "two"]
[1; 2; 3; 5; 5; 7; 11]
</pre>
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 493 ⟶ 698:
}
return
}</langsyntaxhighlight>
Output:
<pre>
Line 502 ⟶ 707:
=={{header|Haskell}}==
 
<langsyntaxhighlight lang="haskell">-- Same merge as in Merge Sort
merge :: (Ord a) => [a] -> [a] -> [a]
merge [] ys = ys
Line 517 ⟶ 722:
extractStrand x (x1 : xs)
| x <= x1 = let (strand, rest) = extractStrand x1 xs in (x : strand, rest)
| otherwise = let (strand, rest) = extractStrand x xs in (strand, x1 : rest)</langsyntaxhighlight>
 
=={{header|J}}==
Line 523 ⟶ 728:
Using <code>merge</code> defined at [[Sorting algorithms/Merge sort#J]]:
 
<langsyntaxhighlight lang="j">strandSort=: (#~ merge $:^:(0<#)@(#~ -.)) (= >./\)</langsyntaxhighlight>
 
Example use:
 
<langsyntaxhighlight lang="j"> strandSort 3 1 5 4 2
1 2 3 4 5</langsyntaxhighlight>
 
Note: the order in which this J implementation processes the strands differs from the pseudocode currently at the wikipedia page on strand sort and matches the haskell implementation currently at the wikipedia page.
Line 534 ⟶ 739:
Also note that the individual strands can be seen by using <code>;</code> instead of <code>merge</code>.
 
<langsyntaxhighlight lang="j"> ((#~ ; $:^:(0<#)@(#~ -.)) (= >./\)) 3 1 5 4 2
┌───┬───┬─┬┐
│3 5│1 4│2││
Line 541 ⟶ 746:
┌─────────┬─────┬┐
│3 3 4 5 6│1 2 3││
└─────────┴─────┴┘</langsyntaxhighlight>
 
=={{header|Java}}==
{{works with|Java|1.6+}}
<langsyntaxhighlight lang="java5">import java.util.Arrays;
import java.util.LinkedList;
 
Line 590 ⟶ 795:
System.out.println(strandSort(new LinkedList<Integer>(Arrays.asList(3,3,1,2,4,3,5,6))));
}
}</langsyntaxhighlight>
Output:
<pre>[1, 2, 3, 4, 5]
Line 597 ⟶ 802:
 
=={{header|jq}}==
Most of the implementation is the "merge" function for merging two arrays. Notice that the helper function, strand, is defined here as an inner function.<langsyntaxhighlight lang="jq"># merge input array with array x by comparing the heads of the arrays
# in turn; # if both arrays are sorted, the result will be sorted:
def merge(x):
Line 635 ⟶ 840:
| ($s[0] | merge( $s[1] | strand_sort))
end ;
</syntaxhighlight>
</lang>
Example:
[1,3,5,2,4,6] | strand_sort
 
=={{header|Julia}}==
{{trans|Python}}
<syntaxhighlight lang="julia">function mergelist(a, b)
out = Vector{Int}()
while !isempty(a) && !isempty(b)
if a[1] < b[1]
push!(out, popfirst!(a))
else
push!(out, popfirst!(b))
end
end
append!(out, a)
append!(out, b)
out
end
function strand(a)
i, s = 1, [popfirst!(a)]
while i < length(a) + 1
if a[i] > s[end]
append!(s, splice!(a, i))
else
i += 1
end
end
s
end
 
strandsort(a) = (out = strand(a); while !isempty(a) out = mergelist(out, strand(a)) end; out)
=={{header|Mathematica}}==
<lang Mathematica>StrandSort[ input_ ] := Module[ {results = {}, A = input},
println(strandsort([1, 6, 3, 2, 1, 7, 5, 3]))
</syntaxhighlight>{{output}}<pre>
[1, 1, 2, 3, 3, 5, 6, 7]
</pre>
 
=={{header|Kotlin}}==
{{trans|D}}
<syntaxhighlight lang="scala">// version 1.1.2
 
fun <T : Comparable<T>> strandSort(l: List<T>): List<T> {
fun merge(left: MutableList<T>, right: MutableList<T>): MutableList<T> {
val res = mutableListOf<T>()
while (!left.isEmpty() && !right.isEmpty()) {
if (left[0] <= right[0]) {
res.add(left[0])
left.removeAt(0)
}
else {
res.add(right[0])
right.removeAt(0)
}
}
res.addAll(left)
res.addAll(right)
return res
}
var list = l.toMutableList()
var result = mutableListOf<T>()
while (!list.isEmpty()) {
val sorted = mutableListOf(list[0])
list.removeAt(0)
val leftover = mutableListOf<T>()
for (item in list) {
if (sorted.last() <= item)
sorted.add(item)
else
leftover.add(item)
}
result = merge(sorted, result)
list = leftover
}
return result
}
 
fun main(args: Array<String>) {
val l = listOf(-2, 0, -2, 5, 5, 3, -1, -3, 5, 5, 0, 2, -4, 4, 2)
println(strandSort(l))
}</syntaxhighlight>
 
{{out}}
<pre>
[-4, -3, -2, -2, -1, 0, 0, 2, 2, 3, 4, 5, 5, 5, 5]
</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">StrandSort[ input_ ] := Module[ {results = {}, A = input},
While[Length@A > 0,
sublist = {A[[1]]}; A = A[[2;;All]];
Line 648 ⟶ 937:
];
results = #[[Ordering@#]]&@Join[sublist, results];];
results ]</lang>
StrandSort[{2, 3, 7, 5, 1, 4, 7}]</syntaxhighlight>
Example usage :
{{out}}
<pre>StrandSort[{2, 3, 7, 5, 1, 4, 7}]
<pre>{1, 2, 3, 4, 5, 7, 7}</pre>
 
=={{header|MAXScript}}==
<langsyntaxhighlight MAXScriptlang="maxscript">fn strandSort arr =
(
arr = deepcopy arr
Line 677 ⟶ 967:
return results
 
)</langsyntaxhighlight>
Output:
<syntaxhighlight lang="maxscript">
<lang MAXScript>
a = for i in 1 to 20 collect random 1 40
#(19, 26, 14, 31, 11, 33, 2, 14, 32, 28, 12, 38, 2, 37, 27, 18, 31, 24, 39, 28)
strandSort a
#(2, 2, 11, 12, 14, 14, 18, 19, 24, 26, 27, 28, 28, 31, 31, 32, 33, 37, 38, 39)
</syntaxhighlight>
</lang>
 
=={{header|NetRexx}}==
<langsyntaxhighlight NetRexxlang="netrexx">/* NetRexx */
options replace format comments java crossref savelog symbols binary
 
Line 760 ⟶ 1,050:
 
return result
</syntaxhighlight>
</lang>
;Output
<pre>
Line 783 ⟶ 1,073:
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim">proc mergeList[T](a, b: var seq[T]): seq[T] =
result = @[]
while a.len > 0 and b.len > 0:
Line 814 ⟶ 1,104:
 
var a = @[1, 6, 3, 2, 1, 7, 5, 3]
echo a.strandSort</langsyntaxhighlight>
Output:
<pre>@[1, 1, 2, 3, 3, 5, 6, 7]</pre>
Line 820 ⟶ 1,110:
=={{header|OCaml}}==
{{trans|Haskell}}
<langsyntaxhighlight lang="ocaml">let rec strand_sort (cmp : 'a -> 'a -> int) : 'a list -> 'a list = function
[] -> []
| x::xs ->
Line 831 ⟶ 1,121:
in
let strand, rest = extract_strand x xs in
List.merge cmp strand (strand_sort cmp rest)</langsyntaxhighlight>
usage
<pre>
Line 839 ⟶ 1,129:
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">strandSort(v)={
my(sorted=[],unsorted=v,remaining,working);
while(#unsorted,
Line 868 ⟶ 1,158:
);
ret
};</langsyntaxhighlight>
 
=={{header|Pascal}}==
<langsyntaxhighlight Pascallang="pascal">program StrandSortDemo;
type
Line 949 ⟶ 1,239:
end;
writeln;
end.</langsyntaxhighlight>
 
=={{header|Perl}}==
<syntaxhighlight lang="perl">use strict;
<lang Perl>use 5.10.0; # for given/when
use warnings;
use feature 'say';
 
sub merge {
my ($x, $y) = @_;
my @out;
while (@$x and @$y) {
my $t = given ($x->[-1] <=> $y->[-1]) {;
if ($t when(== 1) { unshift @out, pop @$x }
elsif ($t == when(-1) { unshift @out, pop @$y }
else default { splice @out, 0, 0, pop(@$x), pop(@$y) }
}
@$x, @$y, }@out
return @$x, @$y, @out
}
 
sub strand {
my $x = shift;
my @out = shift @$x // return;
iffor (-@$x .. -1) {
push @out, splice @$x, $_, 1 if for (-@$x->[$_] ..>= $out[-1) {];
}
if ($x->[$_] >= $out[-1]) {
@out
push @out, splice @$x, $_, 1
}
}
}
return @out
}
 
sub strand_sort {
my @x = @_;
my(@out, @outstrand);
@out = merge \@out, \@strand while (my @strand = strand(\@x)) {;
@out
@out = merge(\@out, \@strand)
}
@out
}
 
Line 991 ⟶ 1,277:
say "Before @a";
@a = strand_sort(@a);
say "After @a";</langsyntaxhighlight>
=={{header|Perl 6}}==
<lang perl6>sub infix:<M> (@x, @y) {
gather {
while @x and @y {
take do given @x[0] cmp @y[0] {
when Increase { @x.shift }
when Decrease { @y.shift }
when Same { @x.shift, @y.shift }
}
}
take @x, @y;
}
}
 
=={{header|Phix}}==
sub strand (@x is rw) {
<!--<syntaxhighlight lang="phix">(phixonline)-->
my $prev = -Inf;
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
my $i = 0;
gather while $i < @x {
<span style="color: #008080;">function</span> <span style="color: #000000;">merge</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">)</span>
if @x[$i] before $prev {
<span style="color: #004080;">sequence</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
$i++;
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">)></span><span style="color: #000000;">0</span>
}
<span style="color: #008080;">and</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)></span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
else {
<span style="color: #008080;">if</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;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
take $prev = splice(@x, $i, 1)[0];
<span style="color: #008080;">exit</span>
}
<span style="color: #008080;">elsif</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">[$]<=</span><span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
}
<span style="color: #008080;">return</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">right</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">left</span>
}
<span style="color: #008080;">elsif</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]<</span><span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
 
<span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">result</span><span style="color: #0000FF;">,</span><span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
sub strand_sort (@x is copy) {
<span style="color: #000000;">left</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
my @out;
<span style="color: #008080;">else</span>
@out M= strand(@x) while @x;
<span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">result</span><span style="color: #0000FF;">,</span><span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
@out;
<span style="color: #000000;">right</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</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;">while</span>
my @a = (^100).roll(10);
<span style="color: #008080;">return</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">left</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">right</span>
say "Before @a[]";
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
@a = strand_sort(@a);
say "After @a[]";
<span style="color: #008080;">function</span> <span style="color: #000000;">strand_sort</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;">sequence</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
@a = <The quick brown fox jumps over the lazy dog>;
<span style="color: #008080;">while</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: #000000;">0</span> <span style="color: #008080;">do</span>
say "Before @a[]";
<span style="color: #004080;">integer</span> <span style="color: #000000;">j</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
@a = strand_sort(@a);
<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: #000000;">1</span> <span style="color: #008080;">do</span>
say "After @a[]";</lang>
<span style="color: #008080;">if</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: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">j</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">merge</span><span style="color: #0000FF;">(</span><span style="color: #000000;">result</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</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;">result</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">strand_sort</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)))</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
<pre>Before 1 20 64 72 48 75 96 55 42 74
{1,2,3,4,5,6,7,8,9,10}
After 1 20 42 48 55 64 72 74 75 96
</pre>
Before The quick brown fox jumps over the lazy dog
After The brown dog fox jumps lazy over quick the</pre>
 
=={{header|PHP}}==
{{trans|D}}
{{works with|PHP 5.3.0+}}
<langsyntaxhighlight lang="php">$lst = new SplDoublyLinkedList();
foreach (array(1,20,64,72,48,75,96,55,42,74) as $v)
$lst->push($v);
Line 1,080 ⟶ 1,365:
foreach ($right as $v) $res->push($v);
return $res;
}</langsyntaxhighlight>
<pre>1 20 42 48 55 64 72 74 75 96</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de strandSort (Lst)
(let Res NIL # Result list
(while Lst
Line 1,104 ⟶ 1,389:
(pop 'Res)
(fifo 'Sub) ) ) ) ) ) ) )
Res ) )</langsyntaxhighlight>
Test:
<pre>: (strandSort (3 1 5 4 2))
Line 1,113 ⟶ 1,398:
 
=={{header|PL/I}}==
<langsyntaxhighlight PLlang="pl/Ii">strand: procedure options (main); /* 27 Oct. 2012 */
declare A(100) fixed, used(100) bit (1), sorted fixed controlled;
declare (temp, work) fixed controlled;
Line 1,203 ⟶ 1,488:
end move;
 
end strand;</langsyntaxhighlight>
Generated data:
<pre>
Line 1,219 ⟶ 1,504:
 
=={{header|PureBasic}}==
<langsyntaxhighlight PureBasiclang="purebasic">Procedure strandSort(List a())
Protected NewList subList()
Protected NewList results()
Line 1,300 ⟶ 1,585:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
Sample output:
<pre>List 1:
Line 1,315 ⟶ 1,600:
 
=={{header|Python}}==
<langsyntaxhighlight Pythonlang="python">def merge_list(a, b):
out = []
while len(a) and len(b):
Line 1,341 ⟶ 1,626:
return out
 
print strand_sort([1, 6, 3, 2, 1, 7, 5, 3])</langsyntaxhighlight>
Output:<syntaxhighlight lang="text">[1, 1, 2, 3, 3, 5, 6, 7]</langsyntaxhighlight>
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="Quackery"> [ [] swap
1 split witheach
[ over -1 peek
over > iff
[ swap dip join ]
else join ] ] is sift ( [ --> [ [ )
 
[ [] temp put
[ dup [] != while
over [] != while
over 0 peek
over 0 peek
> not if dip
[ behead
temp take
swap join
temp put ]
again ]
join
temp take swap join ] is merge ( [ [ --> [ )
 
[ [] swap
[ sift
rot merge swap
dup [] = until ]
drop ] is strandsort ( [ --> [ )
 
[] 25 times
[ 89 random 10 + join ]
say "Before: " dup echo cr
strandsort
say "After: " echo cr</syntaxhighlight>
 
{{out}}
 
<pre>Before: [ 46 66 79 51 21 79 65 46 95 17 92 13 32 11 72 44 83 64 50 88 46 38 57 37 27 ]
After: [ 11 13 17 21 27 32 37 38 44 46 46 46 50 51 57 64 65 66 72 79 79 83 88 92 95 ]</pre>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
(require mzlib/list)
Line 1,363 ⟶ 1,688:
 
(strand-sort (build-list 10 (λ(_) (random 15))))
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
{{Works with|Rakudo|2018.04.01}}
<syntaxhighlight lang="raku" line>sub infix:<M> (@x-in, @y-in) {
my @x = | @x-in;
my @y = | @y-in;
flat @x, @y,
reverse gather while @x and @y {
take do given @x[*-1] cmp @y[*-1] {
when More { pop @x }
when Less { pop @y }
when Same { pop(@x), pop(@y) }
}
}
}
 
sub strand (@x) {
my $i = 0;
my $prev = -Inf;
gather while $i < @x {
@x[$i] before $prev ?? $i++ !! take $prev = splice(@x, $i, 1)[0];
}
}
 
sub strand_sort (@x is copy) {
my @out;
@out M= strand(@x) while @x;
@out;
}
 
my @a = (^100).roll(10);
say "Before {@a}";
@a = strand_sort(@a);
say "After {@a}";
 
@a = <The quick brown fox jumps over the lazy dog>;
say "Before {@a}";
@a = strand_sort(@a);
say "After {@a}";</syntaxhighlight>
{{out}}
<pre>Before 1 20 64 72 48 75 96 55 42 74
After 1 20 42 48 55 64 72 74 75 96
Before The quick brown fox jumps over the lazy dog
After The brown dog fox jumps lazy over quick the</pre>
 
=={{header|REXX}}==
This REXX program was written to generate a specified amount of random numbers as
well as allowing a pre-pended list of numbersitems).
 
<br>It can handle integers, floating point numbers, exponentated numbers, and character strings.
It can handle integers, floating point numbers, exponentiated numbers, and/or character strings.
<lang rexx>/*REXX pgm sorts a random list of words using the strand sort algorithm.*/
<syntaxhighlight lang="rexx">/*REXX program sorts a random list of words (or numbers) */
parse arg size minv maxv,old /*get options from command line. */
if/* using the strand sort algorithm size=='' then size=20 /*no size? Then use the default.*/
ifParse minv==''Arg thensize minv=0 maxv old /*no minV? " " " "obtain optional arguments from CL*/
if maxvsize=='' | then maxvsize==size "," then size=20 /*noNot maxVspecified? use " " " " default.*/
if minv=='' | minv=="," then minv= 0 /*Not specified? use default.*/
do i=1 for size /*generate random # list*/
if maxv=='' | maxv=="," then maxv=size /*Not specified? use default.*/
old=old random(0,maxv-minv)+minv
Do i=1 To size
end /*i*/
old=old random(0,maxv-minv)+minv/* append random numbers to the list*/
old=space(old) /*remove any extraneous blanks. */
End
say center('unsorted list',length(old),"─"); say old; say
old=space(old)
new=strand_sort(old) /*sort the list of random numbers*/
Say 'Unsorted list:'
say center('sorted list' ,length(new),"─"); say new
Say old
exit /*stick a fork in it, we're done.*/
new=strand_sort(old) /* sort given list (extended by random numbers) */
/*──────────────────────────────────STRAND_SORT subroutine──────────────*/
Say
strand_sort: procedure; parse arg x; y=
Say 'Sorted list:'
do while words(x)\==0; w=words(x)
Say new
do j=1 for w-1 /*any number | word out of order?*/
Exit if word(x,j)>word(x,j+1) then do; w=j;/* stick a fork in it, we're leave;all done end*/
/*--------------------------------------------------------------------*/
end /*j*/
strand_sort: Procedure
y=merge(y,subword(x,1,w)); x=subword(x,w+1)
Parse Arg source
end /*while*/
sorted=''
return y
Do While words(source)\==0
/*──────────────────────────────────MERGE subroutine────────────────────*/
w=words(source)
merge: procedure; parse arg a.1,a.2; p=
/* Find first word in source that is smaller Than its predecessor */
do forever /*keep at it while 2 lists exist.*/
Do j=1 To w-1
do i=1 for 2; w.i=words(a.i); end /*find number of entries in lists*/
If word(source,j)>word(source,j+1) Then
if w.1*w.2==0 then leave /*if any list is empty, then stop*/
Leave
if word(a.1,w.1) <= word(a.2,1) then leave /*lists are now sorted?*/
End
if word(a.2,w.2) <= word(a.1,1) then return space(p a.2 a.1)
/* Elements source.1 trough source.j are in ascending order */
#=1+(word(a.1,1) >= word(a.2,1)); p=p word(a.#,1); a.#=subword(a.#,2)
head=subword(source,1,j)
end /*forever*/
source=subword(source,j+1) /* the rest starts with a smaller */
return space(p a.1 a.2)</lang>
/* value or is empty (j=w!) */
'''output''' when using the input of: &nbsp; <tt> 25 -9 30 1000 2000 3000 </tt>
sorted=merge(sorted,head)
End
Return sorted
/*--------------------------------------------------------------------*/
merge: Procedure
Parse Arg a.1,a.2
p=''
Do Forever
w1=words(a.1)
w2=words(a.2)
Select
When w1==0 | w2==0 Then
Return space(p a.1 a.2)
When word(a.1,w1)<=word(a.2,1) Then
Return space(p a.1 a.2)
When word(a.2,w2)<=word(a.1,1) Then
Return space(p a.2 a.1)
Otherwise Do
nn=1+(word(a.1,1)>=word(a.2,1))
/* move the smaller first word of a.1 or a.2 to p */
p=p word(a.nn,1)
a.nn=subword(a.nn,2)
End
End
End</syntaxhighlight>
'''output''' &nbsp; when using the input of: &nbsp; <tt> 25 -9 30 1000 2000 3000 </tt>
<pre>
────────────────────────────────unsorted list────────────────────────────────
Line 1,410 ⟶ 1,806:
</pre>
The REXX program can also sort words as well as numbers. <br>
<br>'''output''' &nbsp; when using the input of: &nbsp; <tt> 24 -9 100 66 66 8.8 carp Carp </tt>
<pre>
──────────────────────────────────────unsorted list───────────────────────────────────────
Line 1,422 ⟶ 1,818:
<br>The order of sorting on an EBCDIC machine is: &nbsp; <tt> lowerCase, upperCase, numbers </tt>
<br><br>
 
=={{header|Ring}}==
<syntaxhighlight lang="ring">
# Project : Sorting algorithms/Strand sort
 
test = [-2,0,-2,5,5,3,-1,-3,5,5,0,2,-4,4,2]
results = []
resultsend = []
see "before sort:" + nl
showarray(test)
test = strandsort(test)
see "after sort:" + nl
showarray(test)
 
func strandsort(a)
while len(a) > 0
sublist = []
add(sublist,a[1])
del(a,1)
for i = 1 to len(a)
if a[i] > sublist[len(sublist)]
add(sublist,a[i])
del(a,i)
ok
next
for n = 1 to len(sublist)
add(results,sublist[n])
next
for n = 1 to len(results)
for m = n + 1 to len(results)
if results[m] < results[n]
temp = results[m]
results[m] = results[n]
results[n] = temp
ok
next
next
end
return results
 
func showarray(vect)
svect = ""
for n = 1 to len(vect)
svect = svect + vect[n] + " "
next
svect = left(svect, len(svect) - 1)
see svect + nl
</syntaxhighlight>
Output:
<pre>
before sort:
-2 0 -2 5 5 3 -1 -3 5 5 0 2 -4 4 2
after sort:
-4 -3 -2 -2 -1 0 0 2 2 3 4 5 5 5 5
</pre>
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">class Array
def strandsort
a = dup
Line 1,446 ⟶ 1,897:
end
 
p [1, 6, 3, 2, 1, 7, 5, 3].strandsort</langsyntaxhighlight>
 
{{out}}
Line 1,453 ⟶ 1,904:
=={{header|Sidef}}==
{{trans|Perl}}
<langsyntaxhighlight lang="ruby">func merge(x, y) {
var out = [];
while (x && y) {
given (x[-1] <=> y[-1]) {
>when ( 1) { out.prepend(x.pop) }
>when (-1) { out.prepend(y.pop) }
: default { out.prepend(x.pop, y.pop) }
};
}
x + y + out;
}
Line 1,468 ⟶ 1,920:
var out = [x.shift];
if (x.len) {
rangefor i in (-x.len, .. -1).each { |i|
if (x[i] >= out[-1]) {
out.append(x.pop_at(i));
}
}
};
return out;
}
 
Line 1,481 ⟶ 1,933:
while (var strd = strand(x)) {
out = merge(out, strd);
};
return out;
}
 
var a = 10.of { 100.rand.intirand };
say "Before: #{a}";
say "After: #{strand_sort(a.copy)}";</langsyntaxhighlight>
 
{{out}}
Line 1,496 ⟶ 1,948:
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl">proc merge {listVar toMerge} {
upvar 1 $listVar v
set i [set j 0]
Line 1,536 ⟶ 1,988:
}
 
puts [strandSort {3 1 5 4 2}]</langsyntaxhighlight>
 
=={{header|Ursala}}==
 
<langsyntaxhighlight Ursalalang="ursala">strand_sort "r" = # parameterized by a relational predicate "r"
 
@NiX -+
:-0 ~&B^?a\~&Y@a "r"?abh/~&alh2faltPrXPRC ~&arh2falrtPXPRC,
~&r->l ^|rlPlCrrPX/~& @hNCNXtX ~&r->lbx "r"?rllPXh/~&llPrhPlrPCXrtPX ~&rhPllPClrPXrtPX+-</langsyntaxhighlight>
demonstration code:<langsyntaxhighlight Ursalalang="ursala">#cast %nL
 
x = (strand_sort nat-nleq) <3,1,5,4,2></langsyntaxhighlight>output:<pre><1,2,3,4,5></pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="wren">var merge = Fn.new { |left, right|
var res = []
while (!left.isEmpty && !right.isEmpty) {
if (left[0] <= right[0]) {
res.add(left[0])
left.removeAt(0)
} else {
res.add(right[0])
right.removeAt(0)
}
}
res.addAll(left)
res.addAll(right)
return res
}
 
var strandSort = Fn.new { |a|
var list = a.toList
var res = []
while (!list.isEmpty) {
var sorted = [list[0]]
list.removeAt(0)
var leftover = []
for (item in list) {
if (sorted[-1] <= item) {
sorted.add(item)
} else {
leftover.add(item)
}
}
res = merge.call(sorted, res)
list = leftover
}
return res
}
 
var a = [-2, 0, -2, 5, 5, 3, -1, -3, 5, 5, 0, 2, -4, 4, 2]
System.print("Unsorted: %(a)")
a = strandSort.call(a)
System.print("Sorted : %(a)")</syntaxhighlight>
 
{{out}}
<pre>
Unsorted: [-2, 0, -2, 5, 5, 3, -1, -3, 5, 5, 0, 2, -4, 4, 2]
Sorted : [-4, -3, -2, -2, -1, 0, 0, 2, 2, 3, 4, 5, 5, 5, 5]
</pre>
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">fcn strandSort(A){ //--> new list, A is cleared, should add A=A.copy()
sublist:=List.createLong(A.len()); results:=List.createLong(A.len());
while(A){
Line 1,560 ⟶ 2,061:
}
results
}</langsyntaxhighlight>
The createLong list method creates a new list with pre-allocated space
<langsyntaxhighlight lang="zkl">strandSort(L(3,1,5,4,2)).println();
strandSort("azbfe".split("")).println();</langsyntaxhighlight>
{{out}}
<pre>
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/179396...350692"