Data update
This commit is contained in:
Ingy döt Net
parent
61b93a2cd1
commit
5af6d93694
858 changed files with 20572 additions and 2082 deletions
|
|
@ -0,0 +1,92 @@
|
|||
-- Return a deep copy of theList with items l thru r sorted ascending.
|
||||
on strandSort(theList, l, r)
|
||||
-- Resolve 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 src : missing value
|
||||
property dest : missing value
|
||||
property ranges : {}
|
||||
end script
|
||||
|
||||
-- Arrange a copy of the list into "strands" of exisiting ascending order
|
||||
-- and get the strands' ranges within this arrangement.
|
||||
copy theList to o's src
|
||||
set i to l
|
||||
repeat until (i > r)
|
||||
set j to i
|
||||
set jVal to o's src's item j
|
||||
repeat with k from (j + 1) to r
|
||||
set kVal to o's src's item k
|
||||
if (kVal < jVal) then
|
||||
else
|
||||
set j to j + 1
|
||||
set o's src's item k to o's src's item j
|
||||
set o's src's item j to kVal
|
||||
set jVal to kVal
|
||||
end if
|
||||
end repeat
|
||||
set o's ranges's end to {i, j}
|
||||
set i to j + 1
|
||||
end repeat
|
||||
set rangeCount to (count o's ranges)
|
||||
if (rangeCount = 1) then return o's src -- Already in order.
|
||||
|
||||
-- Merge the strands back and forth between this list and another duplicate.
|
||||
set o's dest to o's src's items
|
||||
repeat until (rangeCount = 1)
|
||||
set {o's src, o's dest} to {o's dest, o's src}
|
||||
set k to l
|
||||
repeat with rr from 2 to rangeCount by 2
|
||||
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 iVal to o's src's item i
|
||||
set jVal to o's src's item j
|
||||
repeat until (k > jx)
|
||||
if (iVal > jVal) then
|
||||
set o's dest's item k to jVal
|
||||
set j to j + 1
|
||||
if (j > jx) then
|
||||
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
|
||||
else
|
||||
set jVal to o's src's item j
|
||||
end if
|
||||
else
|
||||
set o's dest's item k to iVal
|
||||
set i to i + 1
|
||||
if (i > ix) then
|
||||
repeat with k from j to jx
|
||||
set o's dest's item k to o's src's item k
|
||||
end repeat
|
||||
else
|
||||
set iVal to o's src's item i
|
||||
end if
|
||||
end if
|
||||
set k to k + 1
|
||||
end repeat
|
||||
end repeat
|
||||
if (rr < rangeCount) then
|
||||
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 rangeCount to (rangeCount + 1) div 2
|
||||
end repeat
|
||||
|
||||
return o's dest
|
||||
end strandSort
|
||||
|
||||
strandSort({5, 1, 4, 37, 2, 0, 9, 6, -44, 3, 8, 7}, 1, -1)
|
||||
|
|
@ -0,0 +1 @@
|
|||
{-44, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 37}
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
// 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])
|
||||
|
|
@ -1,31 +1,57 @@
|
|||
/*REXX program sorts a random list of words (or numbers) using the strand sort algorithm*/
|
||||
parse arg size minv maxv old /*obtain optional arguments from the CL*/
|
||||
if size=='' | size=="," then size=20 /*Not specified? Then use the default.*/
|
||||
if minv=='' | minv=="," then minv= 0 /*Not specified? Then use the default.*/
|
||||
if maxv=='' | maxv=="," then maxv=size /*Not specified? Then use the default.*/
|
||||
do i=1 for size /*generate a list of random numbers. */
|
||||
old=old random(0,maxv-minv)+minv /*append a random number to a list. */
|
||||
end /*i*/
|
||||
old=space(old) /*elide extraneous blanks from the list*/
|
||||
say center('unsorted list', length(old), "─"); say old
|
||||
new=strand_sort(old) /*sort the list of the random numbers. */
|
||||
say; say center('sorted list' , length(new), "─"); say new
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
strand_sort: procedure; parse arg x; y=
|
||||
do while words(x)\==0; w=words(x)
|
||||
do j=1 for w-1 /*anything out of order?*/
|
||||
if word(x,j)>word(x,j+1) then do; w=j; leave; end
|
||||
end /*j*/
|
||||
y=merge(y,subword(x,1,w)); x=subword(x,w+1)
|
||||
end /*while*/
|
||||
return y
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
merge: procedure; parse arg a.1,a.2; p=
|
||||
do forever; w1=words(a.1); w2=words(a.2) /*do while 2 lists exist*/
|
||||
if w1==0 | if w2==0 then leave /*Any list empty? Stop.*/
|
||||
if word(a.1,w1) <= word(a.2,1) then leave /*lists are now sorted? */
|
||||
if word(a.2,w2) <= word(a.1,1) then return space(p a.2 a.1)
|
||||
#=1+(word(a.1,1) >= word(a.2,1)); p=p word(a.#,1); a.#=subword(a.#,2)
|
||||
end /*forever*/
|
||||
return space(p a.1 a.2)
|
||||
/*REXX program sorts a random list of words (or numbers) */
|
||||
/* using the strand sort algorithm */
|
||||
Parse Arg size minv maxv old /* obtain optional arguments from CL*/
|
||||
if size=='' | size=="," then size=20 /*Not specified? use default.*/
|
||||
if minv=='' | minv=="," then minv= 0 /*Not specified? use default.*/
|
||||
if maxv=='' | maxv=="," then maxv=size /*Not specified? use default.*/
|
||||
Do i=1 To size
|
||||
old=old random(0,maxv-minv)+minv/* append random numbers to the list*/
|
||||
End
|
||||
old=space(old)
|
||||
Say 'Unsorted list:'
|
||||
Say old
|
||||
new=strand_sort(old) /* sort given list (extended by random numbers) */
|
||||
Say
|
||||
Say 'Sorted list:'
|
||||
Say new
|
||||
Exit /* stick a fork in it, we're all done */
|
||||
/*--------------------------------------------------------------------*/
|
||||
strand_sort: Procedure
|
||||
Parse Arg source
|
||||
sorted=''
|
||||
Do While words(source)\==0
|
||||
w=words(source)
|
||||
/* Find first word in source that is smaller Than its predecessor */
|
||||
Do j=1 To w-1
|
||||
If word(source,j)>word(source,j+1) Then
|
||||
Leave
|
||||
End
|
||||
/* Elements source.1 trough source.j are in ascending order */
|
||||
head=subword(source,1,j)
|
||||
source=subword(source,j+1) /* the rest starts with a smaller */
|
||||
/* value or is empty (j=w!) */
|
||||
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue