2016 Update
This commit is contained in:
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -2,4 +2,4 @@ Use the [[wp:Quickselect|quickselect algorithm]] on the vector
|
|||
: [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
|
||||
To show the first, second, third, ... up to the tenth largest member of the vector, in order, here on this page.
|
||||
|
||||
* Note: Quick''sort'' has a separate [[Sorting algorithms/Quicksort|task]].
|
||||
* Note: Quick''sort'' has a separate [[Sorting algorithms/Quicksort|task]]. <br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
defmodule Quick do
|
||||
def select(k, [x|xs]) do
|
||||
{ys, zs} = Enum.partition(xs, fn e -> e < x end)
|
||||
l = length(ys)
|
||||
cond do
|
||||
k < l -> select(k, ys)
|
||||
k > l -> select(k - l - 1, zs)
|
||||
true -> x
|
||||
end
|
||||
end
|
||||
|
||||
def test do
|
||||
v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
|
||||
Enum.map(0..length(v)-1, fn i -> select(i,v) end)
|
||||
|> IO.inspect
|
||||
end
|
||||
end
|
||||
|
||||
Quick.test
|
||||
51
Task/Quickselect-algorithm/Fortran/quickselect-algorithm.f
Normal file
51
Task/Quickselect-algorithm/Fortran/quickselect-algorithm.f
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
INTEGER FUNCTION FINDELEMENT(K,A,N) !I know I can.
|
||||
Chase an order statistic: FindElement(N/2,A,N) leads to the median, with some odd/even caution.
|
||||
Careful! The array is shuffled: for i < K, A(i) <= A(K); for i > K, A(i) >= A(K).
|
||||
Charles Anthony Richard Hoare devised this method, as related to his famous QuickSort.
|
||||
INTEGER K,N !Find the K'th element in order of an array of N elements, not necessarily in order.
|
||||
INTEGER A(N),HOPE,PESTY !The array, and like associates.
|
||||
INTEGER L,R,L2,R2 !Fingers.
|
||||
L = 1 !Here we go.
|
||||
R = N !The bounds of the work area within which the K'th element lurks.
|
||||
DO WHILE (L .LT. R) !So, keep going until it is clamped.
|
||||
HOPE = A(K) !If array A is sorted, this will be rewarded.
|
||||
L2 = L !But it probably isn't sorted.
|
||||
R2 = R !So prepare a scan.
|
||||
DO WHILE (L2 .LE. R2) !Keep squeezing until the inner teeth meet.
|
||||
DO WHILE (A(L2) .LT. HOPE) !Pass elements less than HOPE.
|
||||
L2 = L2 + 1 !Note that at least element A(K) equals HOPE.
|
||||
END DO !Raising the lower jaw.
|
||||
DO WHILE (HOPE .LT. A(R2)) !Elements higher than HOPE
|
||||
R2 = R2 - 1 !Are in the desired place.
|
||||
END DO !And so we speed past them.
|
||||
IF (L2 - R2) 1,2,3 !How have the teeth paused?
|
||||
1 PESTY = A(L2) !On grit. A(L2) > HOPE and A(R2) < HOPE.
|
||||
A(L2) = A(R2) !So swap the two troublemakers.
|
||||
A(R2) = PESTY !To be as if they had been in the desired order all along.
|
||||
2 L2 = L2 + 1 !Advance my teeth.
|
||||
R2 = R2 - 1 !As if they hadn't paused on this pest.
|
||||
3 END DO !And resume the squeeze, hopefully closing in K.
|
||||
IF (R2 .LT. K) L = L2 !The end point gives the order position of value HOPE.
|
||||
IF (K .LT. L2) R = R2 !But we want the value of order position K.
|
||||
END DO !Have my teeth met yet?
|
||||
FINDELEMENT = A(K) !Yes. A(K) now has the K'th element in order.
|
||||
END FUNCTION FINDELEMENT !Remember! Array A has likely had some elements moved!
|
||||
|
||||
PROGRAM POKE
|
||||
INTEGER FINDELEMENT !Not the default type for F.
|
||||
INTEGER N !The number of elements.
|
||||
PARAMETER (N = 10) !Fixed for the test problem.
|
||||
INTEGER A(66) !An array of integers.
|
||||
DATA A(1:N)/9, 8, 7, 6, 5, 0, 1, 2, 3, 4/ !The specified values.
|
||||
|
||||
WRITE (6,1) A(1:N) !Announce, and add a heading.
|
||||
1 FORMAT ("Selection of the i'th element in order from an array.",/
|
||||
1 "The array need not be in order, and may be reordered.",/
|
||||
2 " i Val:Array elements...",/,8X,666I2)
|
||||
|
||||
DO I = 1,N !One by one,
|
||||
WRITE (6,2) I,FINDELEMENT(I,A,N),A(1:N) !Request the i'th element.
|
||||
2 FORMAT (I3,I4,":",666I2) !Match FORMAT 1.
|
||||
END DO !On to the next trial.
|
||||
|
||||
END !That was easy.
|
||||
33
Task/Quickselect-algorithm/Lua/quickselect-algorithm.lua
Normal file
33
Task/Quickselect-algorithm/Lua/quickselect-algorithm.lua
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
function partition (list, left, right, pivotIndex)
|
||||
local pivotValue = list[pivotIndex]
|
||||
list[pivotIndex], list[right] = list[right], list[pivotIndex]
|
||||
local storeIndex = left
|
||||
for i = left, right do
|
||||
if list[i] < pivotValue then
|
||||
list[storeIndex], list[i] = list[i], list[storeIndex]
|
||||
storeIndex = storeIndex + 1
|
||||
end
|
||||
end
|
||||
list[right], list[storeIndex] = list[storeIndex], list[right]
|
||||
return storeIndex
|
||||
end
|
||||
|
||||
function quickSelect (list, left, right, n)
|
||||
local pivotIndex
|
||||
while 1 do
|
||||
if left == right then return list[left] end
|
||||
pivotIndex = math.random(left, right)
|
||||
pivotIndex = partition(list, left, right, pivotIndex)
|
||||
if n == pivotIndex then
|
||||
return list[n]
|
||||
elseif n < pivotIndex then
|
||||
right = pivotIndex - 1
|
||||
else
|
||||
left = pivotIndex + 1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
math.randomseed(os.time())
|
||||
local vec = {9, 8, 7, 6, 5, 0, 1, 2, 3, 4}
|
||||
for i = 1, 10 do print(i, quickSelect(vec, 1, #vec, i) .. " ") end
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
function partition($list, $left, $right, $pivotIndex) {
|
||||
$pivotValue = $list[$pivotIndex]
|
||||
$list[$pivotIndex], $list[$right] = $list[$right], $list[$pivotIndex]
|
||||
$storeIndex = $left
|
||||
foreach ($i in $left..($right-1)) {
|
||||
if ($list[$i] -lt $pivotValue) {
|
||||
$list[$storeIndex],$list[$i] = $list[$i], $list[$storeIndex]
|
||||
$storeIndex += 1
|
||||
}
|
||||
}
|
||||
$list[$right],$list[$storeIndex] = $list[$storeIndex], $list[$right]
|
||||
$storeIndex
|
||||
}
|
||||
|
||||
function rank($list, $left, $right, $n) {
|
||||
if ($left -eq $right) {$list[$left]}
|
||||
else {
|
||||
$pivotIndex = Get-Random -Minimum $left -Maximum $right
|
||||
$pivotIndex = partition $list $left $right $pivotIndex
|
||||
if ($n -eq $pivotIndex) {$list[$n]}
|
||||
elseif ($n -lt $pivotIndex) {(rank $list $left ($pivotIndex - 1) $n)}
|
||||
else {(rank $list ($pivotIndex+1) $right $n)}
|
||||
}
|
||||
}
|
||||
|
||||
function quickselect($list) {
|
||||
$right = $list.count-1
|
||||
foreach($left in 0..$right) {rank $list $left $right $left}
|
||||
}
|
||||
$arr = @(9, 8, 7, 6, 5, 0, 1, 2, 3, 4)
|
||||
"$(quickselect $arr)"
|
||||
|
|
@ -1,30 +1,32 @@
|
|||
/*REXX pgm sorts a list (which may be numbers) using quick select algorithm.*/
|
||||
parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*use the default?*/
|
||||
do #=1 for words(list); @.#=word(list,#) /*assign item──►@.*/
|
||||
end /*#*/ /* [↑] #: number of items in the list*/
|
||||
#=#-1 /*adjust number of items in the list. */
|
||||
do j=1 for # /*show 1 ──► # of items place and value*/
|
||||
say right('item',20) right(j,length(#))", value: " qSel(1,#,j)
|
||||
/*REXX program sorts a list (which may be numbers) by using the quick select algorithm. */
|
||||
parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*Not given? Use default.*/
|
||||
say right('list: ', 22) list
|
||||
say
|
||||
do #=1 for words(list); @.#=word(list,#) /*assign all the items ──► @. (array). */
|
||||
end /*#*/ /* [↑] #: number of items in the list.*/
|
||||
#=#-1 /*adjust number of items in the list. */
|
||||
do j=1 for # /*show 1 ──► # items place and value.*/
|
||||
say right('item', 20) right(j, length(#))", value: " qSel(1, #, j)
|
||||
end /*j*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────QPART subroutine──────────────────────────*/
|
||||
qPart: procedure expose @.; parse arg L 1 ?,R,X; xVal = @.X
|
||||
parse value @.X @.R with @.R @.X /*swap the two names items (X and R). */
|
||||
do k=L to R-1 /*process the left side of the list. */
|
||||
if @.k>xVal then iterate /*when an item > item #X, then skip it.*/
|
||||
parse value @.? @.k with @.k @.? /*swap the two named items (? and K). */
|
||||
?=?+1 /*bump the item number (point to next)*/
|
||||
end /*k*/
|
||||
parse value @.R @.? with @.? @.R /*swap the two named items (R and ?). */
|
||||
return ? /*return item num.*/
|
||||
/*──────────────────────────────────QSEL subroutine───────────────────────────*/
|
||||
qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*one?*/
|
||||
do forever /*keep searching until we're all done. */
|
||||
new=qPart(L, R, (L+R)%2) /*partition the list into roughly ½. */
|
||||
dist=new-L+1 /*calculate the pivot distance less L+1*/
|
||||
if dist==z then return @.new /*we're all done with this pivot part. */
|
||||
else if z<dist then R=new-1 /*decrease right half. */
|
||||
else do; z=z-dist /*decrease the distance.*/
|
||||
L=new+1 /*increase the left half*/
|
||||
end
|
||||
end /*forever*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qPart: procedure expose @.; parse arg L 1 ?,R,X; xVal=@.X
|
||||
parse value @.X @.R with @.R @.X /*swap the two names items (X and R). */
|
||||
do k=L to R-1 /*process the left side of the list. */
|
||||
if @.k>xVal then iterate /*when an item > item #X, then skip it.*/
|
||||
parse value @.? @.k with @.k @.? /*swap the two named items (? and K). */
|
||||
?=?+1 /*bump the item number (point to next).*/
|
||||
end /*k*/
|
||||
parse value @.R @.? with @.? @.R /*swap the two named items (R and ?). */
|
||||
return ? /*return the item number to invoker. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*only one item?*/
|
||||
do forever /*keep searching until we're all done. */
|
||||
new=qPart(L, R, (L+R) % 2) /*partition the list into roughly ½. */
|
||||
$=new-L+1 /*calculate pivot distance less L+1. */
|
||||
if $==z then return @.new /*we're all done with this pivot part. */
|
||||
else if z<$ then R=new-1 /*decrease the right half of the array.*/
|
||||
else do; z=z-$ /*decrease the distance. */
|
||||
L=new+1 /*increase the left half *f the array.*/
|
||||
end
|
||||
end /*forever*/
|
||||
|
|
|
|||
|
|
@ -1,32 +1,34 @@
|
|||
/*REXX pgm sorts a list (which may be numbers) using quick select algorithm.*/
|
||||
parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*use the default?*/
|
||||
do #=1 for words(list); @.#=word(list,#) /*assign item──►@.*/
|
||||
end /*#*/ /* [↑] #: number of items in the list*/
|
||||
#=#-1 /*adjust number of items in the list. */
|
||||
do j=1 for # /*show 1 ──► # of items place and value*/
|
||||
say right('item',20) right(j,length(#))", value: " qSel(1,#,j)
|
||||
/*REXX program sorts a list (which may be numbers) by using the quick select algorithm. */
|
||||
parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*Not given? Use default.*/
|
||||
say right('list: ', 22) list
|
||||
say
|
||||
do #=1 for words(list); @.#=word(list,#) /*assign all the items ──► @. (array). */
|
||||
end /*#*/ /* [↑] #: number of items in the list.*/
|
||||
#=#-1 /*adjust number of items in the list. */
|
||||
do j=1 for # /*show 1 ──► # items place and value.*/
|
||||
say right('item', 20) right(j, length(#))", value: " qSel(1, #, j)
|
||||
end /*j*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────QPART subroutine──────────────────────────*/
|
||||
qPart: procedure expose @.; parse arg L 1 ?,R,X; xVal = @.X
|
||||
call swap X,R /*swap the two named items (X and R). */
|
||||
do k=L to R-1 /*process the left side of the list. */
|
||||
if @.k>xVal then iterate /*when an item > item #X, then skip it.*/
|
||||
call swap ?,k /*swap the two named items (? and K). */
|
||||
?=?+1 /*bump item number we're working with. */
|
||||
end /*k*/
|
||||
call swap R,? /*swap the two named items (R and ?). */
|
||||
return ? /*return item num.*/
|
||||
/*──────────────────────────────────QSEL subroutine───────────────────────────*/
|
||||
qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*one?*/
|
||||
do forever /*keep searching until we're all done. */
|
||||
new=qPart(L, R, (L+R)%2) /*partition the list into roughly ½. */
|
||||
dist=new-L+1 /*calculate the pivot distance less L+1*/
|
||||
if dist==z then return @.new /*we're all done with this pivot part. */
|
||||
else if z<dist then R=new-1 /*decrease right half. */
|
||||
else do; z=z-dist /*decrease the distance.*/
|
||||
L=new+1 /*increase the left half*/
|
||||
end
|
||||
end /*forever*/
|
||||
/*──────────────────────────────────SWAP subroutine───────────────────────────*/
|
||||
swap: parse arg _1,_2; parse value @._1 @._2 with @._2 @._1; return /*swap 2.*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qPart: procedure expose @.; parse arg L 1 ?,R,X; xVal=@.X
|
||||
call swap X,R /*swap the two named items (X and R). */
|
||||
do k=L to R-1 /*process the left side of the list. */
|
||||
if @.k>xVal then iterate /*when an item > item #X, then skip it.*/
|
||||
call swap ?,k /*swap the two named items (? and K). */
|
||||
?=?+1 /*bump the item number (point to next).*/
|
||||
end /*k*/
|
||||
call swap R,? /*swap the two named items (R and ?). */
|
||||
return ? /*return the item number to invoker. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*only one item?*/
|
||||
do forever /*keep searching until we're all done. */
|
||||
new=qPart(L, R, (L+R)%2) /*partition the list into roughly ½. */
|
||||
$=new-L+1 /*calculate the pivot distance less L+1*/
|
||||
if $==z then return @.new /*we're all done with this pivot part. */
|
||||
else if z<$ then R=new-1 /*decrease the right half of the array.*/
|
||||
else do; z=z-$ /*decrease the distance. */
|
||||
L=new+1 /*increase the left half of the array.*/
|
||||
end
|
||||
end /*forever*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
swap: parse arg _1,_2; parse value @._1 @._2 with @._2 @._1; return /*swap 2 items.*/
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue