Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
3
Task/Sorting-algorithms-Quicksort/00-META.yaml
Normal file
3
Task/Sorting-algorithms-Quicksort/00-META.yaml
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
---
|
||||
from: http://rosettacode.org/wiki/Sorting_algorithms/Quicksort
|
||||
note: Sorting Algorithms
|
||||
79
Task/Sorting-algorithms-Quicksort/00-TASK.txt
Normal file
79
Task/Sorting-algorithms-Quicksort/00-TASK.txt
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
{{Sorting Algorithm}}
|
||||
[[Category:Sorting]]
|
||||
[[Category:Recursion]]
|
||||
{{Wikipedia|Quicksort}}
|
||||
|
||||
|
||||
;Task:
|
||||
Sort an array (or list) elements using the [https://en.wikipedia.org/wiki/Quicksort ''quicksort''] algorithm.
|
||||
|
||||
The elements must have a [https://en.wikipedia.org/wiki/Weak_ordering strict weak order] and the index of the array can be of any discrete type.
|
||||
|
||||
For languages where this is not possible, sort an array of integers.
|
||||
|
||||
|
||||
Quicksort, also known as ''partition-exchange sort'', uses these steps.
|
||||
|
||||
::# Choose any element of the array to be the pivot.
|
||||
::# Divide all other elements (except the pivot) into two partitions.
|
||||
::#* All elements less than the pivot must be in the first partition.
|
||||
::#* All elements greater than the pivot must be in the second partition.
|
||||
::# Use recursion to sort both partitions.
|
||||
::# Join the first sorted partition, the pivot, and the second sorted partition.
|
||||
|
||||
<br>
|
||||
The best pivot creates partitions of equal length (or lengths differing by '''1''').
|
||||
|
||||
The worst pivot creates an empty partition (for example, if the pivot is the first or last element of a sorted array).
|
||||
|
||||
The run-time of Quicksort ranges from <big> ''[[O]](n ''log'' n)'' </big> with the best pivots, to <big> ''[[O]](n<sup>2</sup>)'' </big> with the worst pivots, where <big> ''n'' </big> is the number of elements in the array.
|
||||
|
||||
|
||||
This is a simple quicksort algorithm, adapted from Wikipedia.
|
||||
|
||||
'''function''' ''quicksort''(array)
|
||||
less, equal, greater ''':=''' three empty arrays
|
||||
'''if''' length(array) > 1
|
||||
pivot ''':=''' ''select any element of'' array
|
||||
'''for each''' x '''in''' array
|
||||
'''if''' x < pivot '''then add''' x '''to''' less
|
||||
'''if''' x = pivot '''then add''' x '''to''' equal
|
||||
'''if''' x > pivot '''then add''' x '''to''' greater
|
||||
quicksort(less)
|
||||
quicksort(greater)
|
||||
array ''':=''' concatenate(less, equal, greater)
|
||||
|
||||
A better quicksort algorithm works in place, by swapping elements within the array, to avoid the memory allocation of more arrays.
|
||||
|
||||
'''function''' ''quicksort''(array)
|
||||
'''if''' length(array) > 1
|
||||
pivot ''':=''' ''select any element of'' array
|
||||
left ''':= first index of''' array
|
||||
right ''':=''' '''last index of''' array
|
||||
'''while''' left ≤ right
|
||||
'''while''' array[left] < pivot
|
||||
left := left + 1
|
||||
'''while''' array[right] > pivot
|
||||
right := right - 1
|
||||
'''if''' left ≤ right
|
||||
'''swap''' array[left] '''with''' array[right]
|
||||
left := left + 1
|
||||
right := right - 1
|
||||
quicksort(array '''from first index to''' right)
|
||||
quicksort(array '''from''' left '''to last index''')
|
||||
|
||||
Quicksort has a reputation as the fastest sort. Optimized variants of quicksort are common features of many languages and libraries. One often contrasts quicksort with [[../Merge sort|merge sort]], because both sorts have an average time of <big> ''[[O]](n ''log'' n)''. </big>
|
||||
|
||||
: ''"On average, mergesort does fewer comparisons than quicksort, so it may be better when complicated comparison routines are used. Mergesort also takes advantage of pre-existing order, so it would be favored for using sort() to merge several sorted arrays. On the other hand, quicksort is often faster for small arrays, and on arrays of a few distinct values, repeated many times."'' — http://perldoc.perl.org/sort.html
|
||||
|
||||
Quicksort is at one end of the spectrum of divide-and-conquer algorithms, with merge sort at the opposite end.
|
||||
|
||||
* Quicksort is a conquer-then-divide algorithm, which does most of the work during the partitioning and the recursive calls. The subsequent reassembly of the sorted partitions involves trivial effort.
|
||||
* Merge sort is a divide-then-conquer algorithm. The partioning happens in a trivial way, by splitting the input array in half. Most of the work happens during the recursive calls and the merge phase.
|
||||
|
||||
<br>
|
||||
With quicksort, every element in the first partition is less than or equal to every element in the second partition. Therefore, the merge phase of quicksort is so trivial that it needs no mention!
|
||||
|
||||
This task has not specified whether to allocate new arrays, or sort in place. This task also has not specified how to choose the pivot element. (Common ways to are to choose the first element, the middle element, or the median of three elements.) Thus there is a variety among the following implementations.
|
||||
<br><br>
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
F _quicksort(&array, start, stop) -> N
|
||||
I stop - start > 0
|
||||
V pivot = array[start]
|
||||
V left = start
|
||||
V right = stop
|
||||
L left <= right
|
||||
L array[left] < pivot
|
||||
left++
|
||||
L array[right] > pivot
|
||||
right--
|
||||
I left <= right
|
||||
swap(&array[left], &array[right])
|
||||
left++
|
||||
right--
|
||||
_quicksort(&array, start, right)
|
||||
_quicksort(&array, left, stop)
|
||||
|
||||
F quicksort(&array)
|
||||
_quicksort(&array, 0, array.len - 1)
|
||||
|
||||
V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
|
||||
quicksort(&arr)
|
||||
print(arr)
|
||||
|
|
@ -0,0 +1,172 @@
|
|||
* Quicksort 14/09/2015 & 23/06/2016
|
||||
QUICKSOR CSECT
|
||||
USING QUICKSOR,R13 base register
|
||||
B 72(R15) skip savearea
|
||||
DC 17F'0' savearea
|
||||
STM R14,R12,12(R13) prolog
|
||||
ST R13,4(R15) "
|
||||
ST R15,8(R13) "
|
||||
LR R13,R15 "
|
||||
MVC A,=A(1) a(1)=1
|
||||
MVC B,=A(NN) b(1)=hbound(t)
|
||||
L R6,=F'1' k=1
|
||||
DO WHILE=(LTR,R6,NZ,R6) do while k<>0 ==================
|
||||
LR R1,R6 k
|
||||
SLA R1,2 ~
|
||||
L R10,A-4(R1) l=a(k)
|
||||
LR R1,R6 k
|
||||
SLA R1,2 ~
|
||||
L R11,B-4(R1) m=b(k)
|
||||
BCTR R6,0 k=k-1
|
||||
LR R4,R11 m
|
||||
C R4,=F'2' if m<2
|
||||
BL ITERATE then iterate
|
||||
LR R2,R10 l
|
||||
AR R2,R11 +m
|
||||
BCTR R2,0 -1
|
||||
ST R2,X x=l+m-1
|
||||
LR R2,R11 m
|
||||
SRA R2,1 m/2
|
||||
AR R2,R10 +l
|
||||
ST R2,Y y=l+m/2
|
||||
L R1,X x
|
||||
SLA R1,2 ~
|
||||
L R4,T-4(R1) r4=t(x)
|
||||
L R1,Y y
|
||||
SLA R1,2 ~
|
||||
L R5,T-4(R1) r5=t(y)
|
||||
LR R1,R10 l
|
||||
SLA R1,2 ~
|
||||
L R3,T-4(R1) r3=t(l)
|
||||
IF CR,R4,LT,R3 if t(x)<t(l) ---+
|
||||
IF CR,R5,LT,R4 if t(y)<t(x) |
|
||||
LR R7,R4 p=t(x) |
|
||||
L R1,X x |
|
||||
SLA R1,2 ~ |
|
||||
ST R3,T-4(R1) t(x)=t(l) |
|
||||
ELSEIF CR,R5,GT,R3 elseif t(y)>t(l) |
|
||||
LR R7,R3 p=t(l) |
|
||||
ELSE , else |
|
||||
LR R7,R5 p=t(y) |
|
||||
L R1,Y y |
|
||||
SLA R1,2 ~ |
|
||||
ST R3,T-4(R1) t(y)=t(l) |
|
||||
ENDIF , end if |
|
||||
ELSE , else |
|
||||
IF CR,R5,LT,R3 if t(y)<t(l) |
|
||||
LR R7,R3 p=t(l) |
|
||||
ELSEIF CR,R5,GT,R4 elseif t(y)>t(x) |
|
||||
LR R7,R4 p=t(x) |
|
||||
L R1,X x |
|
||||
SLA R1,2 ~ |
|
||||
ST R3,T-4(R1) t(x)=t(l) |
|
||||
ELSE , else |
|
||||
LR R7,R5 p=t(y) |
|
||||
L R1,Y y |
|
||||
SLA R1,2 ~ |
|
||||
ST R3,T-4(R1) t(y)=t(l) |
|
||||
ENDIF , end if |
|
||||
ENDIF , end if ---+
|
||||
LA R8,1(R10) i=l+1
|
||||
L R9,X j=x
|
||||
FOREVER EQU * do forever --------------------+
|
||||
LR R1,R8 i |
|
||||
SLA R1,2 ~ |
|
||||
LA R2,T-4(R1) @t(i) |
|
||||
L R0,0(R2) t(i) |
|
||||
DO WHILE=(CR,R8,LE,R9,AND, while i<=j and ---+ | X
|
||||
CR,R0,LE,R7) t(i)<=p | |
|
||||
AH R8,=H'1' i=i+1 | |
|
||||
AH R2,=H'4' @t(i) | |
|
||||
L R0,0(R2) t(i) | |
|
||||
ENDDO , end while ---+ |
|
||||
LR R1,R9 j |
|
||||
SLA R1,2 ~ |
|
||||
LA R2,T-4(R1) @t(j) |
|
||||
L R0,0(R2) t(j) |
|
||||
DO WHILE=(CR,R8,LT,R9,AND, while i<j and ---+ | X
|
||||
CR,R0,GE,R7) t(j)>=p | |
|
||||
SH R9,=H'1' j=j-1 | |
|
||||
SH R2,=H'4' @t(j) | |
|
||||
L R0,0(R2) t(j) | |
|
||||
ENDDO , end while ---+ |
|
||||
CR R8,R9 if i>=j |
|
||||
BNL LEAVE then leave (segment finished) |
|
||||
LR R1,R8 i |
|
||||
SLA R1,2 ~ |
|
||||
LA R2,T-4(R1) @t(i) |
|
||||
LR R1,R9 j |
|
||||
SLA R1,2 ~ |
|
||||
LA R3,T-4(R1) @t(j) |
|
||||
L R0,0(R2) w=t(i) + |
|
||||
MVC 0(4,R2),0(R3) t(i)=t(j) |swap t(i),t(j) |
|
||||
ST R0,0(R3) t(j)=w + |
|
||||
B FOREVER end do forever ----------------+
|
||||
LEAVE EQU *
|
||||
LR R9,R8 j=i
|
||||
BCTR R9,0 j=i-1
|
||||
LR R1,R9 j
|
||||
SLA R1,2 ~
|
||||
LA R3,T-4(R1) @t(j)
|
||||
L R2,0(R3) t(j)
|
||||
LR R1,R10 l
|
||||
SLA R1,2 ~
|
||||
ST R2,T-4(R1) t(l)=t(j)
|
||||
ST R7,0(R3) t(j)=p
|
||||
LA R6,1(R6) k=k+1
|
||||
LR R1,R6 k
|
||||
SLA R1,2 ~
|
||||
LA R4,A-4(R1) r4=@a(k)
|
||||
LA R5,B-4(R1) r5=@b(k)
|
||||
IF C,R8,LE,Y if i<=y ----+
|
||||
ST R8,0(R4) a(k)=i |
|
||||
L R2,X x |
|
||||
SR R2,R8 -i |
|
||||
LA R2,1(R2) +1 |
|
||||
ST R2,0(R5) b(k)=x-i+1 |
|
||||
LA R6,1(R6) k=k+1 |
|
||||
ST R10,4(R4) a(k)=l |
|
||||
LR R2,R9 j |
|
||||
SR R2,R10 -l |
|
||||
ST R2,4(R5) b(k)=j-l |
|
||||
ELSE , else |
|
||||
ST R10,4(R4) a(k)=l |
|
||||
LR R2,R9 j |
|
||||
SR R2,R10 -l |
|
||||
ST R2,0(R5) b(k)=j-l |
|
||||
LA R6,1(R6) k=k+1 |
|
||||
ST R8,4(R4) a(k)=i |
|
||||
L R2,X x |
|
||||
SR R2,R8 -i |
|
||||
LA R2,1(R2) +1 |
|
||||
ST R2,4(R5) b(k)=x-i+1 |
|
||||
ENDIF , end if ----+
|
||||
ITERATE EQU *
|
||||
ENDDO , end while =====================
|
||||
* *** ********* print sorted table
|
||||
LA R3,PG ibuffer
|
||||
LA R4,T @t(i)
|
||||
DO WHILE=(C,R4,LE,=A(TEND)) do i=1 to hbound(t)
|
||||
L R2,0(R4) t(i)
|
||||
XDECO R2,XD edit t(i)
|
||||
MVC 0(4,R3),XD+8 put in buffer
|
||||
LA R3,4(R3) ibuffer=ibuffer+1
|
||||
LA R4,4(R4) i=i+1
|
||||
ENDDO , end do
|
||||
XPRNT PG,80 print buffer
|
||||
L R13,4(0,R13) epilog
|
||||
LM R14,R12,12(R13) "
|
||||
XR R15,R15 "
|
||||
BR R14 exit
|
||||
T DC F'10',F'9',F'9',F'6',F'7',F'16',F'1',F'16',F'17',F'15'
|
||||
DC F'1',F'9',F'18',F'16',F'8',F'20',F'18',F'2',F'19',F'8'
|
||||
TEND DS 0F
|
||||
NN EQU (TEND-T)/4)
|
||||
A DS (NN)F same size as T
|
||||
B DS (NN)F same size as T
|
||||
X DS F
|
||||
Y DS F
|
||||
PG DS CL80
|
||||
XD DS CL12
|
||||
YREGS
|
||||
END QUICKSOR
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
/* ARM assembly AARCH64 Raspberry PI 3B */
|
||||
/* program quickSort64.s */
|
||||
|
||||
/*******************************************/
|
||||
/* Constantes file */
|
||||
/*******************************************/
|
||||
/* for this file see task include a file in language AArch64 assembly */
|
||||
.include "../includeConstantesARM64.inc"
|
||||
|
||||
/*********************************/
|
||||
/* Initialized data */
|
||||
/*********************************/
|
||||
.data
|
||||
szMessSortOk: .asciz "Table sorted.\n"
|
||||
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
|
||||
sMessResult: .asciz "Value : @ \n"
|
||||
szCarriageReturn: .asciz "\n"
|
||||
|
||||
.align 4
|
||||
TableNumber: .quad 1,3,6,2,5,9,10,8,4,7,11
|
||||
#TableNumber: .quad 10,9,8,7,6,-5,4,3,2,1
|
||||
.equ NBELEMENTS, (. - TableNumber) / 8
|
||||
/*********************************/
|
||||
/* UnInitialized data */
|
||||
/*********************************/
|
||||
.bss
|
||||
sZoneConv: .skip 24
|
||||
/*********************************/
|
||||
/* code section */
|
||||
/*********************************/
|
||||
.text
|
||||
.global main
|
||||
main: // entry of program
|
||||
ldr x0,qAdrTableNumber // address number table
|
||||
mov x1,0 // first element
|
||||
mov x2,NBELEMENTS // number of élements
|
||||
bl quickSort
|
||||
ldr x0,qAdrTableNumber // address number table
|
||||
bl displayTable
|
||||
|
||||
ldr x0,qAdrTableNumber // address number table
|
||||
mov x1,NBELEMENTS // number of élements
|
||||
bl isSorted // control sort
|
||||
cmp x0,1 // sorted ?
|
||||
beq 1f
|
||||
ldr x0,qAdrszMessSortNok // no !! error sort
|
||||
bl affichageMess
|
||||
b 100f
|
||||
1: // yes
|
||||
ldr x0,qAdrszMessSortOk
|
||||
bl affichageMess
|
||||
100: // standard end of the program
|
||||
mov x0,0 // return code
|
||||
mov x8,EXIT // request to exit program
|
||||
svc 0 // perform the system call
|
||||
|
||||
qAdrsZoneConv: .quad sZoneConv
|
||||
qAdrszCarriageReturn: .quad szCarriageReturn
|
||||
qAdrsMessResult: .quad sMessResult
|
||||
qAdrTableNumber: .quad TableNumber
|
||||
qAdrszMessSortOk: .quad szMessSortOk
|
||||
qAdrszMessSortNok: .quad szMessSortNok
|
||||
/******************************************************************/
|
||||
/* control sorted table */
|
||||
/******************************************************************/
|
||||
/* x0 contains the address of table */
|
||||
/* x1 contains the number of elements > 0 */
|
||||
/* x0 return 0 if not sorted 1 if sorted */
|
||||
isSorted:
|
||||
stp x2,lr,[sp,-16]! // save registers
|
||||
stp x3,x4,[sp,-16]! // save registers
|
||||
mov x2,0
|
||||
ldr x4,[x0,x2,lsl 3]
|
||||
1:
|
||||
add x2,x2,1
|
||||
cmp x2,x1
|
||||
bge 99f
|
||||
ldr x3,[x0,x2, lsl 3]
|
||||
cmp x3,x4
|
||||
blt 98f
|
||||
mov x4,x3
|
||||
b 1b
|
||||
98:
|
||||
mov x0,0 // not sorted
|
||||
b 100f
|
||||
99:
|
||||
mov x0,1 // sorted
|
||||
100:
|
||||
ldp x3,x4,[sp],16 // restaur 2 registers
|
||||
ldp x2,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
/***************************************************/
|
||||
/* Appel récursif Tri Rapide quicksort */
|
||||
/***************************************************/
|
||||
/* x0 contains the address of table */
|
||||
/* x1 contains index of first item */
|
||||
/* x2 contains the number of elements > 0 */
|
||||
quickSort:
|
||||
stp x2,lr,[sp,-16]! // save registers
|
||||
stp x3,x4,[sp,-16]! // save registers
|
||||
str x5, [sp,-16]! // save registers
|
||||
sub x2,x2,1 // last item index
|
||||
cmp x1,x2 // first > last ?
|
||||
bge 100f // yes -> end
|
||||
mov x4,x0 // save x0
|
||||
mov x5,x2 // save x2
|
||||
bl partition1 // cutting into 2 parts
|
||||
mov x2,x0 // index partition
|
||||
mov x0,x4 // table address
|
||||
bl quickSort // sort lower part
|
||||
add x1,x2,1 // index begin = index partition + 1
|
||||
add x2,x5,1 // number of elements
|
||||
bl quickSort // sort higter part
|
||||
|
||||
100: // end function
|
||||
ldr x5, [sp],16 // restaur 1 register
|
||||
ldp x3,x4,[sp],16 // restaur 2 registers
|
||||
ldp x2,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
|
||||
/******************************************************************/
|
||||
/* Partition table elements */
|
||||
/******************************************************************/
|
||||
/* x0 contains the address of table */
|
||||
/* x1 contains index of first item */
|
||||
/* x2 contains index of last item */
|
||||
partition1:
|
||||
stp x1,lr,[sp,-16]! // save registers
|
||||
stp x2,x3,[sp,-16]! // save registers
|
||||
stp x4,x5,[sp,-16]! // save registers
|
||||
stp x6,x7,[sp,-16]! // save registers
|
||||
ldr x3,[x0,x2,lsl 3] // load value last index
|
||||
mov x4,x1 // init with first index
|
||||
mov x5,x1 // init with first index
|
||||
1: // begin loop
|
||||
ldr x6,[x0,x5,lsl 3] // load value
|
||||
cmp x6,x3 // compare value
|
||||
bge 2f
|
||||
ldr x7,[x0,x4,lsl 3] // if < swap value table
|
||||
str x6,[x0,x4,lsl 3]
|
||||
str x7,[x0,x5,lsl 3]
|
||||
add x4,x4,1 // and increment index 1
|
||||
2:
|
||||
add x5,x5,1 // increment index 2
|
||||
cmp x5,x2 // end ?
|
||||
blt 1b // no loop
|
||||
ldr x7,[x0,x4,lsl 3] // swap value
|
||||
str x3,[x0,x4,lsl 3]
|
||||
str x7,[x0,x2,lsl 3]
|
||||
mov x0,x4 // return index partition
|
||||
100:
|
||||
ldp x6,x7,[sp],16 // restaur 2 registers
|
||||
ldp x4,x5,[sp],16 // restaur 2 registers
|
||||
ldp x2,x3,[sp],16 // restaur 2 registers
|
||||
ldp x1,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
|
||||
/******************************************************************/
|
||||
/* Display table elements */
|
||||
/******************************************************************/
|
||||
/* x0 contains the address of table */
|
||||
displayTable:
|
||||
stp x1,lr,[sp,-16]! // save registers
|
||||
stp x2,x3,[sp,-16]! // save registers
|
||||
mov x2,x0 // table address
|
||||
mov x3,0
|
||||
1: // loop display table
|
||||
ldr x0,[x2,x3,lsl 3]
|
||||
ldr x1,qAdrsZoneConv
|
||||
bl conversion10S // décimal conversion
|
||||
ldr x0,qAdrsMessResult
|
||||
ldr x1,qAdrsZoneConv
|
||||
bl strInsertAtCharInc // insert result at // character
|
||||
bl affichageMess // display message
|
||||
add x3,x3,1
|
||||
cmp x3,NBELEMENTS - 1
|
||||
ble 1b
|
||||
ldr x0,qAdrszCarriageReturn
|
||||
bl affichageMess
|
||||
mov x0,x2
|
||||
100:
|
||||
ldp x2,x3,[sp],16 // restaur 2 registers
|
||||
ldp x1,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
/********************************************************/
|
||||
/* File Include fonctions */
|
||||
/********************************************************/
|
||||
/* for this file see task include a file in language AArch64 assembly */
|
||||
.include "../includeARM64.inc"
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
report z_quicksort.
|
||||
|
||||
data(numbers) = value int4_table( ( 4 ) ( 65 ) ( 2 ) ( -31 ) ( 0 ) ( 99 ) ( 2 ) ( 83 ) ( 782 ) ( 1 ) ).
|
||||
perform quicksort changing numbers.
|
||||
|
||||
write `[`.
|
||||
loop at numbers assigning field-symbol(<numbers>).
|
||||
write <numbers>.
|
||||
endloop.
|
||||
write `]`.
|
||||
|
||||
form quicksort changing numbers type int4_table.
|
||||
data(less) = value int4_table( ).
|
||||
data(equal) = value int4_table( ).
|
||||
data(greater) = value int4_table( ).
|
||||
|
||||
if lines( numbers ) > 1.
|
||||
data(pivot) = numbers[ lines( numbers ) / 2 ].
|
||||
|
||||
loop at numbers assigning field-symbol(<number>).
|
||||
if <number> < pivot.
|
||||
append <number> to less.
|
||||
elseif <number> = pivot.
|
||||
append <number> to equal.
|
||||
elseif <number> > pivot.
|
||||
append <number> to greater.
|
||||
endif.
|
||||
endloop.
|
||||
|
||||
perform quicksort changing less.
|
||||
perform quicksort changing greater.
|
||||
|
||||
clear numbers.
|
||||
append lines of less to numbers.
|
||||
append lines of equal to numbers.
|
||||
append lines of greater to numbers.
|
||||
endif.
|
||||
endform.
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
(defun partition (p xs)
|
||||
(if (endp xs)
|
||||
(mv nil nil)
|
||||
(mv-let (less more)
|
||||
(partition p (rest xs))
|
||||
(if (< (first xs) p)
|
||||
(mv (cons (first xs) less) more)
|
||||
(mv less (cons (first xs) more))))))
|
||||
|
||||
(defun qsort (xs)
|
||||
(if (endp xs)
|
||||
nil
|
||||
(mv-let (less more)
|
||||
(partition (first xs) (rest xs))
|
||||
(append (qsort less)
|
||||
(list (first xs))
|
||||
(qsort more)))))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
> (qsort '(8 6 7 5 3 0 9))
|
||||
(0 3 5 6 7 8 9)
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
#--- Swap function ---#
|
||||
PROC swap = (REF []INT array, INT first, INT second) VOID:
|
||||
(
|
||||
INT temp := array[first];
|
||||
array[first] := array[second];
|
||||
array[second]:= temp
|
||||
);
|
||||
|
||||
#--- Quick sort 3 arg function ---#
|
||||
PROC quick = (REF [] INT array, INT first, INT last) VOID:
|
||||
(
|
||||
INT smaller := first + 1,
|
||||
larger := last,
|
||||
pivot := array[first];
|
||||
|
||||
WHILE smaller <= larger DO
|
||||
WHILE array[smaller] < pivot AND smaller < last DO
|
||||
smaller +:= 1
|
||||
OD;
|
||||
WHILE array[larger] > pivot AND larger > first DO
|
||||
larger -:= 1
|
||||
OD;
|
||||
IF smaller < larger THEN
|
||||
swap(array, smaller, larger);
|
||||
smaller +:= 1;
|
||||
larger -:= 1
|
||||
ELSE
|
||||
smaller +:= 1
|
||||
FI
|
||||
OD;
|
||||
|
||||
swap(array, first, larger);
|
||||
|
||||
IF first < larger-1 THEN
|
||||
quick(array, first, larger-1)
|
||||
FI;
|
||||
IF last > larger +1 THEN
|
||||
quick(array, larger+1, last)
|
||||
FI
|
||||
);
|
||||
|
||||
#--- Quick sort 1 arg function ---#
|
||||
PROC quicksort = (REF []INT array) VOID:
|
||||
(
|
||||
IF UPB array > 1 THEN
|
||||
quick(array, 1, UPB array)
|
||||
FI
|
||||
);
|
||||
|
||||
#***************************************************************#
|
||||
main:
|
||||
(
|
||||
[10]INT a;
|
||||
FOR i FROM 1 TO UPB a DO
|
||||
a[i] := ROUND(random*1000)
|
||||
OD;
|
||||
|
||||
print(("Before:", a));
|
||||
quicksort(a);
|
||||
print((newline, newline));
|
||||
print(("After: ", a))
|
||||
)
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
% Quicksorts in-place the array of integers v, from lb to ub %
|
||||
procedure quicksort ( integer array v( * )
|
||||
; integer value lb, ub
|
||||
) ;
|
||||
if ub > lb then begin
|
||||
% more than one element, so must sort %
|
||||
integer left, right, pivot;
|
||||
left := lb;
|
||||
right := ub;
|
||||
% choosing the middle element of the array as the pivot %
|
||||
pivot := v( left + ( ( right + 1 ) - left ) div 2 );
|
||||
while begin
|
||||
while left <= ub and v( left ) < pivot do left := left + 1;
|
||||
while right >= lb and v( right ) > pivot do right := right - 1;
|
||||
left <= right
|
||||
end do begin
|
||||
integer swap;
|
||||
swap := v( left );
|
||||
v( left ) := v( right );
|
||||
v( right ) := swap;
|
||||
left := left + 1;
|
||||
right := right - 1
|
||||
end while_left_le_right ;
|
||||
quicksort( v, lb, right );
|
||||
quicksort( v, left, ub )
|
||||
end quicksort ;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
qsort ← {1≥⍴⍵:⍵ ⋄ e←⍵[?⍴⍵] ⋄ (∇(⍵<e)/⍵) , ((⍵=e)/⍵) , (∇(⍵>e)/⍵)}
|
||||
qsort 31 4 1 5 9 2 6 5 3 5 8
|
||||
1 2 3 4 5 5 5 6 8 9 31
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
sort ← {⍵[⍋⍵]}
|
||||
sort 31 4 1 5 9 2 6 5 3 5 8
|
||||
1 2 3 4 5 5 5 6 8 9 31
|
||||
|
|
@ -0,0 +1,254 @@
|
|||
/* ARM assembly Raspberry PI */
|
||||
/* program quickSort.s */
|
||||
/* look pseudo code in wikipedia quicksort */
|
||||
|
||||
/************************************/
|
||||
/* Constantes */
|
||||
/************************************/
|
||||
.equ STDOUT, 1 @ Linux output console
|
||||
.equ EXIT, 1 @ Linux syscall
|
||||
.equ WRITE, 4 @ Linux syscall
|
||||
/*********************************/
|
||||
/* Initialized data */
|
||||
/*********************************/
|
||||
.data
|
||||
szMessSortOk: .asciz "Table sorted.\n"
|
||||
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
|
||||
sMessResult: .ascii "Value : "
|
||||
sMessValeur: .fill 11, 1, ' ' @ size => 11
|
||||
szCarriageReturn: .asciz "\n"
|
||||
|
||||
.align 4
|
||||
iGraine: .int 123456
|
||||
.equ NBELEMENTS, 10
|
||||
#TableNumber: .int 9,5,6,1,2,3,10,8,4,7
|
||||
#TableNumber: .int 1,3,5,2,4,6,10,8,4,7
|
||||
#TableNumber: .int 1,3,5,2,4,6,10,8,4,7
|
||||
#TableNumber: .int 1,2,3,4,5,6,10,8,4,7
|
||||
TableNumber: .int 10,9,8,7,6,5,4,3,2,1
|
||||
#TableNumber: .int 13,12,11,10,9,8,7,6,5,4,3,2,1
|
||||
/*********************************/
|
||||
/* UnInitialized data */
|
||||
/*********************************/
|
||||
.bss
|
||||
/*********************************/
|
||||
/* code section */
|
||||
/*********************************/
|
||||
.text
|
||||
.global main
|
||||
main: @ entry of program
|
||||
|
||||
1:
|
||||
ldr r0,iAdrTableNumber @ address number table
|
||||
|
||||
mov r1,#0 @ indice first item
|
||||
mov r2,#NBELEMENTS @ number of élements
|
||||
bl triRapide @ call quicksort
|
||||
ldr r0,iAdrTableNumber @ address number table
|
||||
bl displayTable
|
||||
|
||||
ldr r0,iAdrTableNumber @ address number table
|
||||
mov r1,#NBELEMENTS @ number of élements
|
||||
bl isSorted @ control sort
|
||||
cmp r0,#1 @ sorted ?
|
||||
beq 2f
|
||||
ldr r0,iAdrszMessSortNok @ no !! error sort
|
||||
bl affichageMess
|
||||
b 100f
|
||||
2: @ yes
|
||||
ldr r0,iAdrszMessSortOk
|
||||
bl affichageMess
|
||||
100: @ standard end of the program
|
||||
mov r0, #0 @ return code
|
||||
mov r7, #EXIT @ request to exit program
|
||||
svc #0 @ perform the system call
|
||||
|
||||
iAdrsMessValeur: .int sMessValeur
|
||||
iAdrszCarriageReturn: .int szCarriageReturn
|
||||
iAdrsMessResult: .int sMessResult
|
||||
iAdrTableNumber: .int TableNumber
|
||||
iAdrszMessSortOk: .int szMessSortOk
|
||||
iAdrszMessSortNok: .int szMessSortNok
|
||||
/******************************************************************/
|
||||
/* control sorted table */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of table */
|
||||
/* r1 contains the number of elements > 0 */
|
||||
/* r0 return 0 if not sorted 1 if sorted */
|
||||
isSorted:
|
||||
push {r2-r4,lr} @ save registers
|
||||
mov r2,#0
|
||||
ldr r4,[r0,r2,lsl #2]
|
||||
1:
|
||||
add r2,#1
|
||||
cmp r2,r1
|
||||
movge r0,#1
|
||||
bge 100f
|
||||
ldr r3,[r0,r2, lsl #2]
|
||||
cmp r3,r4
|
||||
movlt r0,#0
|
||||
blt 100f
|
||||
mov r4,r3
|
||||
b 1b
|
||||
100:
|
||||
pop {r2-r4,lr}
|
||||
bx lr @ return
|
||||
|
||||
|
||||
/***************************************************/
|
||||
/* Appel récursif Tri Rapide quicksort */
|
||||
/***************************************************/
|
||||
/* r0 contains the address of table */
|
||||
/* r1 contains index of first item */
|
||||
/* r2 contains the number of elements > 0 */
|
||||
triRapide:
|
||||
push {r2-r5,lr} @ save registers
|
||||
sub r2,#1 @ last item index
|
||||
cmp r1,r2 @ first > last ?
|
||||
bge 100f @ yes -> end
|
||||
mov r4,r0 @ save r0
|
||||
mov r5,r2 @ save r2
|
||||
bl partition1 @ cutting into 2 parts
|
||||
mov r2,r0 @ index partition
|
||||
mov r0,r4 @ table address
|
||||
bl triRapide @ sort lower part
|
||||
add r1,r2,#1 @ index begin = index partition + 1
|
||||
add r2,r5,#1 @ number of elements
|
||||
bl triRapide @ sort higter part
|
||||
|
||||
100: @ end function
|
||||
pop {r2-r5,lr} @ restaur registers
|
||||
bx lr @ return
|
||||
|
||||
|
||||
/******************************************************************/
|
||||
/* Partition table elements */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of table */
|
||||
/* r1 contains index of first item */
|
||||
/* r2 contains index of last item */
|
||||
|
||||
partition1:
|
||||
push {r1-r7,lr} @ save registers
|
||||
ldr r3,[r0,r2,lsl #2] @ load value last index
|
||||
mov r4,r1 @ init with first index
|
||||
mov r5,r1 @ init with first index
|
||||
1: @ begin loop
|
||||
ldr r6,[r0,r5,lsl #2] @ load value
|
||||
cmp r6,r3 @ compare value
|
||||
ldrlt r7,[r0,r4,lsl #2] @ if < swap value table
|
||||
strlt r6,[r0,r4,lsl #2]
|
||||
strlt r7,[r0,r5,lsl #2]
|
||||
addlt r4,#1 @ and increment index 1
|
||||
add r5,#1 @ increment index 2
|
||||
cmp r5,r2 @ end ?
|
||||
blt 1b @ no loop
|
||||
ldr r7,[r0,r4,lsl #2] @ swap value
|
||||
str r3,[r0,r4,lsl #2]
|
||||
str r7,[r0,r2,lsl #2]
|
||||
mov r0,r4 @ return index partition
|
||||
100:
|
||||
pop {r1-r7,lr}
|
||||
bx lr
|
||||
|
||||
/******************************************************************/
|
||||
/* Display table elements */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of table */
|
||||
displayTable:
|
||||
push {r0-r3,lr} @ save registers
|
||||
mov r2,r0 @ table address
|
||||
mov r3,#0
|
||||
1: @ loop display table
|
||||
ldr r0,[r2,r3,lsl #2]
|
||||
ldr r1,iAdrsMessValeur @ display value
|
||||
bl conversion10 @ call function
|
||||
ldr r0,iAdrsMessResult
|
||||
bl affichageMess @ display message
|
||||
add r3,#1
|
||||
cmp r3,#NBELEMENTS - 1
|
||||
ble 1b
|
||||
ldr r0,iAdrszCarriageReturn
|
||||
bl affichageMess
|
||||
100:
|
||||
pop {r0-r3,lr}
|
||||
bx lr
|
||||
/******************************************************************/
|
||||
/* display text with size calculation */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of the message */
|
||||
affichageMess:
|
||||
push {r0,r1,r2,r7,lr} @ save registres
|
||||
mov r2,#0 @ counter length
|
||||
1: @ loop length calculation
|
||||
ldrb r1,[r0,r2] @ read octet start position + index
|
||||
cmp r1,#0 @ if 0 its over
|
||||
addne r2,r2,#1 @ else add 1 in the length
|
||||
bne 1b @ and loop
|
||||
@ so here r2 contains the length of the message
|
||||
mov r1,r0 @ address message in r1
|
||||
mov r0,#STDOUT @ code to write to the standard output Linux
|
||||
mov r7, #WRITE @ code call system "write"
|
||||
svc #0 @ call systeme
|
||||
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */
|
||||
bx lr @ return
|
||||
/******************************************************************/
|
||||
/* Converting a register to a decimal unsigned */
|
||||
/******************************************************************/
|
||||
/* r0 contains value and r1 address area */
|
||||
/* r0 return size of result (no zero final in area) */
|
||||
/* area size => 11 bytes */
|
||||
.equ LGZONECAL, 10
|
||||
conversion10:
|
||||
push {r1-r4,lr} @ save registers
|
||||
mov r3,r1
|
||||
mov r2,#LGZONECAL
|
||||
|
||||
1: @ start loop
|
||||
bl divisionpar10U @ unsigned r0 <- dividende. quotient ->r0 reste -> r1
|
||||
add r1,#48 @ digit
|
||||
strb r1,[r3,r2] @ store digit on area
|
||||
cmp r0,#0 @ stop if quotient = 0
|
||||
subne r2,#1 @ else previous position
|
||||
bne 1b @ and loop
|
||||
@ and move digit from left of area
|
||||
mov r4,#0
|
||||
2:
|
||||
ldrb r1,[r3,r2]
|
||||
strb r1,[r3,r4]
|
||||
add r2,#1
|
||||
add r4,#1
|
||||
cmp r2,#LGZONECAL
|
||||
ble 2b
|
||||
@ and move spaces in end on area
|
||||
mov r0,r4 @ result length
|
||||
mov r1,#' ' @ space
|
||||
3:
|
||||
strb r1,[r3,r4] @ store space in area
|
||||
add r4,#1 @ next position
|
||||
cmp r4,#LGZONECAL
|
||||
ble 3b @ loop if r4 <= area size
|
||||
|
||||
100:
|
||||
pop {r1-r4,lr} @ restaur registres
|
||||
bx lr @return
|
||||
|
||||
/***************************************************/
|
||||
/* division par 10 unsigned */
|
||||
/***************************************************/
|
||||
/* r0 dividende */
|
||||
/* r0 quotient */
|
||||
/* r1 remainder */
|
||||
divisionpar10U:
|
||||
push {r2,r3,r4, lr}
|
||||
mov r4,r0 @ save value
|
||||
//mov r3,#0xCCCD @ r3 <- magic_number lower raspberry 3
|
||||
//movt r3,#0xCCCC @ r3 <- magic_number higter raspberry 3
|
||||
ldr r3,iMagicNumber @ r3 <- magic_number raspberry 1 2
|
||||
umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
|
||||
mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3
|
||||
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5
|
||||
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10)
|
||||
pop {r2,r3,r4,lr}
|
||||
bx lr @ leave function
|
||||
iMagicNumber: .int 0xCCCCCCCD
|
||||
|
|
@ -0,0 +1,153 @@
|
|||
(*------------------------------------------------------------------*)
|
||||
(* Quicksort in ATS2, for non-linear lists. *)
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
#define NIL list_nil ()
|
||||
#define :: list_cons
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
(* A simple quicksort working on "garbage-collected" linked lists,
|
||||
with first element as pivot. This is meant as a demonstration, not
|
||||
as a superior sort algorithm.
|
||||
|
||||
It is based on the "not-in-place" task pseudocode. *)
|
||||
|
||||
datatype comparison_result =
|
||||
| first_is_less_than_second of ()
|
||||
| first_is_equal_to_second of ()
|
||||
| first_is_greater_than_second of ()
|
||||
|
||||
extern fun {a : t@ype}
|
||||
list_quicksort$comparison (x : a, y : a) :<> comparison_result
|
||||
|
||||
extern fun {a : t@ype}
|
||||
list_quicksort {n : int}
|
||||
(lst : list (a, n)) :<> list (a, n)
|
||||
|
||||
(* - - - - - - - - - - - - - - - - - - - - - - *)
|
||||
|
||||
implement {a}
|
||||
list_quicksort {n} (lst) =
|
||||
let
|
||||
fun
|
||||
partition {n : nat}
|
||||
.<n>. (* Proof of termination. *)
|
||||
(lst : list (a, n),
|
||||
pivot : a)
|
||||
:<> [n1, n2, n3 : int | n1 + n2 + n3 == n]
|
||||
@(list (a, n1), list (a, n2), list (a, n3)) =
|
||||
(* This implementation is *not* tail recursive. I may get a
|
||||
scolding for using ATS to risk stack overflow! However, I
|
||||
need more practice writing non-tail routines. :) Also, a lot
|
||||
of programmers in other languages would do it this
|
||||
way--especially if the lists are evaluated lazily. *)
|
||||
case+ lst of
|
||||
| NIL => @(NIL, NIL, NIL)
|
||||
| head :: tail =>
|
||||
let
|
||||
val @(lt, eq, gt) = partition (tail, pivot)
|
||||
prval () = lemma_list_param lt
|
||||
prval () = lemma_list_param eq
|
||||
prval () = lemma_list_param gt
|
||||
in
|
||||
case+ list_quicksort$comparison<a> (head, pivot) of
|
||||
| first_is_less_than_second () => @(head :: lt, eq, gt)
|
||||
| first_is_equal_to_second () => @(lt, head :: eq, gt)
|
||||
| first_is_greater_than_second () => @(lt, eq, head :: gt)
|
||||
end
|
||||
|
||||
fun
|
||||
quicksort {n : nat}
|
||||
.<n>. (* Proof of termination. *)
|
||||
(lst : list (a, n))
|
||||
:<> list (a, n) =
|
||||
case+ lst of
|
||||
| NIL => lst
|
||||
| _ :: NIL => lst
|
||||
| head :: tail =>
|
||||
let
|
||||
(* We are careful here to run "partition" on "tail" rather
|
||||
than "lst", so the termination metric will be provably
|
||||
decreasing. (Really the compiler *forces* us to take such
|
||||
care, or else to change :<> to :<!ntm>) *)
|
||||
val pivot = head
|
||||
prval () = lemma_list_param tail
|
||||
val @(lt, eq, gt) = partition {n - 1} (tail, pivot)
|
||||
prval () = lemma_list_param lt
|
||||
prval () = lemma_list_param eq
|
||||
prval () = lemma_list_param gt
|
||||
val eq = pivot :: eq
|
||||
and lt = quicksort lt
|
||||
and gt = quicksort gt
|
||||
in
|
||||
lt + (eq + gt)
|
||||
end
|
||||
|
||||
prval () = lemma_list_param lst
|
||||
in
|
||||
quicksort {n} lst
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
val example_strings =
|
||||
$list ("choose", "any", "element", "of", "the", "array",
|
||||
"to", "be", "the", "pivot",
|
||||
"divide", "all", "other", "elements", "except",
|
||||
"the", "pivot", "into", "two", "partitions",
|
||||
"all", "elements", "less", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "first", "partition",
|
||||
"all", "elements", "greater", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "second", "partition",
|
||||
"use", "recursion", "to", "sort", "both", "partitions",
|
||||
"join", "the", "first", "sorted", "partition", "the",
|
||||
"pivot", "and", "the", "second", "sorted", "partition")
|
||||
|
||||
implement
|
||||
list_quicksort$comparison<string> (x, y) =
|
||||
let
|
||||
val i = strcmp (x, y)
|
||||
in
|
||||
if i < 0 then
|
||||
first_is_less_than_second
|
||||
else if i = 0 then
|
||||
first_is_equal_to_second
|
||||
else
|
||||
first_is_greater_than_second
|
||||
end
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
val sorted_strings = list_quicksort<string> example_strings
|
||||
|
||||
fun
|
||||
print_strings {n : nat} .<n>.
|
||||
(strings : list (string, n),
|
||||
i : int) : void =
|
||||
case+ strings of
|
||||
| NIL => if i <> 1 then println! () else ()
|
||||
| head :: tail =>
|
||||
begin
|
||||
print! head;
|
||||
if i = 8 then
|
||||
begin
|
||||
println! ();
|
||||
print_strings (tail, 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
print! " ";
|
||||
print_strings (tail, succ i)
|
||||
end
|
||||
end
|
||||
in
|
||||
println! (length example_strings);
|
||||
println! (length sorted_strings);
|
||||
print_strings (sorted_strings, 1)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,170 @@
|
|||
(*------------------------------------------------------------------*)
|
||||
(* Quicksort in ATS2, for linear lists. *)
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
#define NIL list_vt_nil ()
|
||||
#define :: list_vt_cons
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
(* A simple quicksort working on linear linked lists, with first
|
||||
element as pivot. This is meant as a demonstration, not as a
|
||||
superior sort algorithm.
|
||||
|
||||
It is based on the "not-in-place" task pseudocode. *)
|
||||
|
||||
#define FIRST_IS_LESS_THAN_SECOND 1
|
||||
#define FIRST_IS_EQUAL_TO_SECOND 2
|
||||
#define FIRST_IS_GREATER_THAN_SECOND 3
|
||||
|
||||
typedef comparison_result =
|
||||
[i : int | (i == FIRST_IS_LESS_THAN_SECOND ||
|
||||
i == FIRST_IS_EQUAL_TO_SECOND ||
|
||||
i == FIRST_IS_GREATER_THAN_SECOND)]
|
||||
int i
|
||||
|
||||
extern fun {a : vt@ype}
|
||||
list_vt_quicksort$comparison (x : !a, y : !a) :<> comparison_result
|
||||
|
||||
extern fun {a : vt@ype}
|
||||
list_vt_quicksort {n : int}
|
||||
(lst : list_vt (a, n)) :<!wrt> list_vt (a, n)
|
||||
|
||||
(* - - - - - - - - - - - - - - - - - - - - - - *)
|
||||
|
||||
implement {a}
|
||||
list_vt_quicksort {n} (lst) =
|
||||
let
|
||||
fun
|
||||
partition {n : nat}
|
||||
.<n>. (* Proof of termination. *)
|
||||
(lst : list_vt (a, n),
|
||||
pivot : !a)
|
||||
:<> [n1, n2, n3 : int | n1 + n2 + n3 == n]
|
||||
@(list_vt (a, n1), list_vt (a, n2), list_vt (a, n3)) =
|
||||
(* This implementation is *not* tail recursive. I may get a
|
||||
scolding for using ATS to risk stack overflow! However, I
|
||||
need more practice writing non-tail routines. :) Also, a lot
|
||||
of programmers in other languages would do it this
|
||||
way--especially if the lists are evaluated lazily. *)
|
||||
case+ lst of
|
||||
| ~ NIL => @(NIL, NIL, NIL)
|
||||
| ~ head :: tail =>
|
||||
let
|
||||
val @(lt, eq, gt) = partition (tail, pivot)
|
||||
prval () = lemma_list_vt_param lt
|
||||
prval () = lemma_list_vt_param eq
|
||||
prval () = lemma_list_vt_param gt
|
||||
in
|
||||
case+ list_vt_quicksort$comparison<a> (head, pivot) of
|
||||
| FIRST_IS_LESS_THAN_SECOND => @(head :: lt, eq, gt)
|
||||
| FIRST_IS_EQUAL_TO_SECOND => @(lt, head :: eq, gt)
|
||||
| FIRST_IS_GREATER_THAN_SECOND => @(lt, eq, head :: gt)
|
||||
end
|
||||
|
||||
fun
|
||||
quicksort {n : nat}
|
||||
.<n>. (* Proof of termination. *)
|
||||
(lst : list_vt (a, n))
|
||||
:<!wrt> list_vt (a, n) =
|
||||
case+ lst of
|
||||
| NIL => lst
|
||||
| _ :: NIL => lst
|
||||
| ~ head :: tail =>
|
||||
let
|
||||
(* We are careful here to run "partition" on "tail" rather
|
||||
than "lst", so the termination metric will be provably
|
||||
decreasing. (Really the compiler *forces* us to take such
|
||||
care, or else to add !ntm to the effects.) *)
|
||||
val pivot = head
|
||||
prval () = lemma_list_vt_param tail
|
||||
val @(lt, eq, gt) = partition {n - 1} (tail, pivot)
|
||||
prval () = lemma_list_vt_param lt
|
||||
prval () = lemma_list_vt_param eq
|
||||
prval () = lemma_list_vt_param gt
|
||||
val eq = pivot :: eq
|
||||
and lt = quicksort lt
|
||||
and gt = quicksort gt
|
||||
in
|
||||
list_vt_append (lt, list_vt_append (eq, gt))
|
||||
end
|
||||
|
||||
prval () = lemma_list_vt_param lst
|
||||
in
|
||||
quicksort {n} lst
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
implement
|
||||
list_vt_quicksort$comparison<Strptr1> (x, y) =
|
||||
let
|
||||
val i = compare (x, y)
|
||||
in
|
||||
if i < 0 then
|
||||
FIRST_IS_LESS_THAN_SECOND
|
||||
else if i = 0 then
|
||||
FIRST_IS_EQUAL_TO_SECOND
|
||||
else
|
||||
FIRST_IS_GREATER_THAN_SECOND
|
||||
end
|
||||
|
||||
implement
|
||||
list_vt_map$fopr<string><Strptr1> (s) = string0_copy s
|
||||
|
||||
implement
|
||||
list_vt_freelin$clear<Strptr1> (x) = strptr_free x
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
val example_strings =
|
||||
$list_vt
|
||||
("choose", "any", "element", "of", "the", "array",
|
||||
"to", "be", "the", "pivot",
|
||||
"divide", "all", "other", "elements", "except",
|
||||
"the", "pivot", "into", "two", "partitions",
|
||||
"all", "elements", "less", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "first", "partition",
|
||||
"all", "elements", "greater", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "second", "partition",
|
||||
"use", "recursion", "to", "sort", "both", "partitions",
|
||||
"join", "the", "first", "sorted", "partition", "the",
|
||||
"pivot", "and", "the", "second", "sorted", "partition")
|
||||
|
||||
val example_strptrs =
|
||||
list_vt_map<string><Strptr1> (example_strings)
|
||||
val sorted_strptrs = list_vt_quicksort<Strptr1> example_strptrs
|
||||
|
||||
fun
|
||||
print_strptrs {n : nat} .<n>.
|
||||
(strptrs : !list_vt (Strptr1, n),
|
||||
i : int) : void =
|
||||
case+ strptrs of
|
||||
| NIL => if i <> 1 then println! () else ()
|
||||
| @ head :: tail =>
|
||||
begin
|
||||
print! head;
|
||||
if i = 8 then
|
||||
begin
|
||||
println! ();
|
||||
print_strptrs (tail, 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
print! " ";
|
||||
print_strptrs (tail, succ i)
|
||||
end;
|
||||
fold@ strptrs
|
||||
end
|
||||
in
|
||||
println! (length example_strings);
|
||||
println! (length sorted_strptrs);
|
||||
print_strptrs (sorted_strptrs, 1);
|
||||
list_vt_freelin<Strptr1> sorted_strptrs;
|
||||
list_vt_free<string> example_strings
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,216 @@
|
|||
(*------------------------------------------------------------------*)
|
||||
(* Quicksort in ATS2, for arrays of non-linear values. *)
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
#define NIL list_nil ()
|
||||
#define :: list_cons
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
(* A simple quicksort working on arrays of non-linear values, using
|
||||
a programmer-selectible pivot.
|
||||
|
||||
It is based on the "in-place" task pseudocode. *)
|
||||
|
||||
extern fun {a : t@ype} (* A "less-than" predicate. *)
|
||||
array_quicksort$lt (x : a, y : a) : bool
|
||||
|
||||
extern fun {a : t@ype}
|
||||
array_quicksort$select_pivot {n : int}
|
||||
{i, j : nat | i < j; j < n}
|
||||
(arr : &array (a, n) >> _,
|
||||
first : size_t i,
|
||||
last : size_t j) : a
|
||||
|
||||
extern fun {a : t@ype}
|
||||
array_quicksort {n : int}
|
||||
(arr : &array (a, n) >> _,
|
||||
n : size_t n) : void
|
||||
|
||||
(* - - - - - - - - - - - - - - - - - - - - - - *)
|
||||
|
||||
fn {a : t@ype}
|
||||
swap {n : int}
|
||||
{i, j : nat | i < n; j < n}
|
||||
(arr : &array(a, n) >> _,
|
||||
i : size_t i,
|
||||
j : size_t j) : void =
|
||||
{
|
||||
val x = arr[i] and y = arr[j]
|
||||
val () = (arr[i] := y) and () = (arr[j] := x)
|
||||
}
|
||||
|
||||
implement {a}
|
||||
array_quicksort {n} (arr, n) =
|
||||
let
|
||||
sortdef index = {i : nat | i < n}
|
||||
typedef index (i : int) = [0 <= i; i < n] size_t i
|
||||
typedef index = [i : index] index i
|
||||
|
||||
macdef lt = array_quicksort$lt<a>
|
||||
|
||||
fun
|
||||
quicksort {i, j : index}
|
||||
(arr : &array(a, n) >> _,
|
||||
first : index i,
|
||||
last : index j) : void =
|
||||
if first < last then
|
||||
{
|
||||
val pivot : a =
|
||||
array_quicksort$select_pivot<a> (arr, first, last)
|
||||
|
||||
fun
|
||||
search_rightwards (arr : &array (a, n),
|
||||
left : index) : index =
|
||||
if arr[left] \lt pivot then
|
||||
let
|
||||
val () = assertloc (succ left <> n)
|
||||
in
|
||||
search_rightwards (arr, succ left)
|
||||
end
|
||||
else
|
||||
left
|
||||
|
||||
fun
|
||||
search_leftwards (arr : &array (a, n),
|
||||
left : index,
|
||||
right : index) : index =
|
||||
if right < left then
|
||||
right
|
||||
else if pivot \lt arr[right] then
|
||||
let
|
||||
val () = assertloc (right <> i2sz 0)
|
||||
in
|
||||
search_leftwards (arr, left, pred right)
|
||||
end
|
||||
else
|
||||
right
|
||||
|
||||
fun
|
||||
partition (arr : &array (a, n) >> _,
|
||||
left0 : index,
|
||||
right0 : index) : @(index, index) =
|
||||
let
|
||||
val left = search_rightwards (arr, left0)
|
||||
val right = search_leftwards (arr, left, right0)
|
||||
in
|
||||
if left <= right then
|
||||
let
|
||||
val () = assertloc (succ left <> n)
|
||||
and () = assertloc (right <> i2sz 0)
|
||||
in
|
||||
swap (arr, left, right);
|
||||
partition (arr, succ left, pred right)
|
||||
end
|
||||
else
|
||||
@(left, right)
|
||||
end
|
||||
|
||||
val @(left, right) = partition (arr, first, last)
|
||||
|
||||
val () = quicksort (arr, first, right)
|
||||
and () = quicksort (arr, left, last)
|
||||
}
|
||||
in
|
||||
if i2sz 2 <= n then
|
||||
quicksort {0, n - 1} (arr, i2sz 0, pred n)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
val example_strings =
|
||||
$list ("choose", "any", "element", "of", "the", "array",
|
||||
"to", "be", "the", "pivot",
|
||||
"divide", "all", "other", "elements", "except",
|
||||
"the", "pivot", "into", "two", "partitions",
|
||||
"all", "elements", "less", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "first", "partition",
|
||||
"all", "elements", "greater", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "second", "partition",
|
||||
"use", "recursion", "to", "sort", "both", "partitions",
|
||||
"join", "the", "first", "sorted", "partition", "the",
|
||||
"pivot", "and", "the", "second", "sorted", "partition")
|
||||
|
||||
implement
|
||||
array_quicksort$lt<string> (x, y) =
|
||||
strcmp (x, y) < 0
|
||||
|
||||
implement
|
||||
array_quicksort$select_pivot<string> {n} (arr, first, last) =
|
||||
(* Median of three, with swapping around of elements during pivot
|
||||
selection. See https://archive.ph/oYENx *)
|
||||
let
|
||||
macdef lt = array_quicksort$lt<string>
|
||||
|
||||
val middle = first + ((last - first) / i2sz 2)
|
||||
|
||||
val xfirst = arr[first]
|
||||
and xmiddle = arr[middle]
|
||||
and xlast = arr[last]
|
||||
in
|
||||
if (xmiddle \lt xfirst) xor (xlast \lt xfirst) then
|
||||
begin
|
||||
swap (arr, first, middle);
|
||||
if xlast \lt xmiddle then
|
||||
swap (arr, first, last);
|
||||
xfirst
|
||||
end
|
||||
else if (xmiddle \lt xfirst) xor (xmiddle \lt xlast) then
|
||||
begin
|
||||
if xlast \lt xfirst then
|
||||
swap (arr, first, last);
|
||||
xmiddle
|
||||
end
|
||||
else
|
||||
begin
|
||||
swap (arr, middle, last);
|
||||
if xmiddle \lt xfirst then
|
||||
swap (arr, first, last);
|
||||
xlast
|
||||
end
|
||||
end
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
prval () = lemma_list_param example_strings
|
||||
val n = length example_strings
|
||||
|
||||
val @(pf, pfgc | p) = array_ptr_alloc<string> (i2sz n)
|
||||
macdef arr = !p
|
||||
|
||||
val () = array_initize_list (arr, n, example_strings)
|
||||
val () = array_quicksort<string> (arr, i2sz n)
|
||||
val sorted_strings = list_vt2t (array2list (arr, i2sz n))
|
||||
|
||||
val () = array_ptr_free (pf, pfgc | p)
|
||||
|
||||
fun
|
||||
print_strings {n : nat} .<n>.
|
||||
(strings : list (string, n),
|
||||
i : int) : void =
|
||||
case+ strings of
|
||||
| NIL => if i <> 1 then println! () else ()
|
||||
| head :: tail =>
|
||||
begin
|
||||
print! head;
|
||||
if i = 8 then
|
||||
begin
|
||||
println! ();
|
||||
print_strings (tail, 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
print! " ";
|
||||
print_strings (tail, succ i)
|
||||
end
|
||||
end
|
||||
in
|
||||
println! (length example_strings);
|
||||
println! (length sorted_strings);
|
||||
print_strings (sorted_strings, 1)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,364 @@
|
|||
(*------------------------------------------------------------------*)
|
||||
(* Quicksort in ATS2, for arrays of (possibly) linear values. *)
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
#define NIL list_vt_nil ()
|
||||
#define :: list_vt_cons
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
(* A simple quicksort working on arrays of non-linear values, using
|
||||
a programmer-selectible pivot.
|
||||
|
||||
It is based on the "in-place" task pseudocode. *)
|
||||
|
||||
extern fun {a : vt@ype} (* A "less-than" predicate. *)
|
||||
array_quicksort$lt {px, py : addr}
|
||||
(pfx : !(a @ px),
|
||||
pfy : !(a @ py) |
|
||||
px : ptr px,
|
||||
py : ptr py) : bool
|
||||
|
||||
extern fun {a : vt@ype}
|
||||
array_quicksort$select_pivot_index {n : int}
|
||||
{i, j : nat | i < j; j < n}
|
||||
(arr : &array (a, n),
|
||||
first : size_t i,
|
||||
last : size_t j)
|
||||
: [k : int | i <= k; k <= j] size_t k
|
||||
|
||||
extern fun {a : vt@ype}
|
||||
array_quicksort {n : int}
|
||||
(arr : &array (a, n) >> _,
|
||||
n : size_t n) : void
|
||||
|
||||
(* - - - - - - - - - - - - - - - - - - - - - - *)
|
||||
|
||||
prfn (* Subdivide an array view into three views. *)
|
||||
array_v_subdivide3 {a : vt@ype} {p : addr} {n1, n2, n3 : nat}
|
||||
(pf : @[a][n1 + n2 + n3] @ p)
|
||||
:<prf> @(@[a][n1] @ p,
|
||||
@[a][n2] @ (p + n1 * sizeof a),
|
||||
@[a][n3] @ (p + (n1 + n2) * sizeof a)) =
|
||||
let
|
||||
prval (pf1, pf23) =
|
||||
array_v_split {a} {p} {n1 + n2 + n3} {n1} pf
|
||||
prval (pf2, pf3) =
|
||||
array_v_split {a} {p + n1 * sizeof a} {n2 + n3} {n2} pf23
|
||||
in
|
||||
@(pf1, pf2, pf3)
|
||||
end
|
||||
|
||||
prfn (* Join three contiguous array views into one view. *)
|
||||
array_v_join3 {a : vt@ype} {p : addr} {n1, n2, n3 : nat}
|
||||
(pf1 : @[a][n1] @ p,
|
||||
pf2 : @[a][n2] @ (p + n1 * sizeof a),
|
||||
pf3 : @[a][n3] @ (p + (n1 + n2) * sizeof a))
|
||||
:<prf> @[a][n1 + n2 + n3] @ p =
|
||||
let
|
||||
prval pf23 =
|
||||
array_v_unsplit {a} {p + n1 * sizeof a} {n2, n3} (pf2, pf3)
|
||||
prval pf = array_v_unsplit {a} {p} {n1, n2 + n3} (pf1, pf23)
|
||||
in
|
||||
pf
|
||||
end
|
||||
|
||||
fn {a : vt@ype} (* Safely swap two elements of an array. *)
|
||||
swap_elems_1 {n : int}
|
||||
{i, j : nat | i <= j; j < n}
|
||||
{p : addr}
|
||||
(pfarr : !array_v(a, p, n) >> _ |
|
||||
p : ptr p,
|
||||
i : size_t i,
|
||||
j : size_t j) : void =
|
||||
|
||||
let
|
||||
fn {a : vt@ype}
|
||||
swap {n : int}
|
||||
{i, j : nat | i < j; j < n}
|
||||
{p : addr}
|
||||
(pfarr : !array_v(a, p, n) >> _ |
|
||||
p : ptr p,
|
||||
i : size_t i,
|
||||
j : size_t j) : void =
|
||||
{
|
||||
|
||||
(* Safely swapping linear elements requires that views of
|
||||
those elements be split off from the rest of the
|
||||
array. Why? Because those elements will temporarily be in
|
||||
an uninitialized state. (Actually they will be "?!", but
|
||||
the difference is unimportant here.)
|
||||
|
||||
Remember, a linear value is consumed by using it.
|
||||
|
||||
The view for the whole array can be reassembled only after
|
||||
new values have been stored, making the entire array once
|
||||
again initialized. *)
|
||||
|
||||
prval @(pf1, pf2, pf3) =
|
||||
array_v_subdivide3 {a} {p} {i, j - i, n - j} pfarr
|
||||
prval @(pfi, pf2_) = array_v_uncons pf2
|
||||
prval @(pfj, pf3_) = array_v_uncons pf3
|
||||
|
||||
val pi = ptr_add<a> (p, i)
|
||||
and pj = ptr_add<a> (p, j)
|
||||
|
||||
val xi = ptr_get<a> (pfi | pi)
|
||||
and xj = ptr_get<a> (pfj | pj)
|
||||
|
||||
val () = ptr_set<a> (pfi | pi, xj)
|
||||
and () = ptr_set<a> (pfj | pj, xi)
|
||||
|
||||
prval pf2 = array_v_cons (pfi, pf2_)
|
||||
prval pf3 = array_v_cons (pfj, pf3_)
|
||||
prval () = pfarr := array_v_join3 (pf1, pf2, pf3)
|
||||
}
|
||||
in
|
||||
if i < j then
|
||||
swap {n} {i, j} {p} (pfarr | p, i, j)
|
||||
else
|
||||
() (* i = j must be handled specially, due to linear typing.*)
|
||||
end
|
||||
|
||||
fn {a : vt@ype} (* Safely swap two elements of an array. *)
|
||||
swap_elems_2 {n : int}
|
||||
{i, j : nat | i <= j; j < n}
|
||||
(arr : &array(a, n) >> _,
|
||||
i : size_t i,
|
||||
j : size_t j) : void =
|
||||
swap_elems_1 (view@ arr | addr@ arr, i, j)
|
||||
|
||||
overload swap_elems with swap_elems_1
|
||||
overload swap_elems with swap_elems_2
|
||||
overload swap with swap_elems
|
||||
|
||||
fn {a : vt@ype} (* Safely compare two elements of an array. *)
|
||||
lt_elems_1 {n : int}
|
||||
{i, j : nat | i < n; j < n}
|
||||
{p : addr}
|
||||
(pfarr : !array_v(a, p, n) |
|
||||
p : ptr p,
|
||||
i : size_t i,
|
||||
j : size_t j) : bool =
|
||||
let
|
||||
fn
|
||||
compare {n : int}
|
||||
{i, j : nat | i < j; j < n}
|
||||
{p : addr}
|
||||
(pfarr : !array_v(a, p, n) |
|
||||
p : ptr p,
|
||||
i : size_t i,
|
||||
j : size_t j,
|
||||
gt : bool) : bool =
|
||||
let
|
||||
prval @(pf1, pf2, pf3) =
|
||||
array_v_subdivide3 {a} {p} {i, j - i, n - j} pfarr
|
||||
prval @(pfi, pf2_) = array_v_uncons pf2
|
||||
prval @(pfj, pf3_) = array_v_uncons pf3
|
||||
|
||||
val pi = ptr_add<a> (p, i)
|
||||
and pj = ptr_add<a> (p, j)
|
||||
|
||||
val retval =
|
||||
if gt then
|
||||
array_quicksort$lt<a> (pfj, pfi | pj, pi)
|
||||
else
|
||||
array_quicksort$lt<a> (pfi, pfj | pi, pj)
|
||||
|
||||
prval pf2 = array_v_cons (pfi, pf2_)
|
||||
prval pf3 = array_v_cons (pfj, pf3_)
|
||||
prval () = pfarr := array_v_join3 (pf1, pf2, pf3)
|
||||
in
|
||||
retval
|
||||
end
|
||||
in
|
||||
if i < j then
|
||||
compare {n} {i, j} {p} (pfarr | p, i, j, false)
|
||||
else if j < i then
|
||||
compare {n} {j, i} {p} (pfarr | p, j, i, true)
|
||||
else
|
||||
false
|
||||
end
|
||||
|
||||
fn {a : vt@ype} (* Safely compare two elements of an array. *)
|
||||
lt_elems_2 {n : int}
|
||||
{i, j : nat | i < n; j < n}
|
||||
(arr : &array (a, n),
|
||||
i : size_t i,
|
||||
j : size_t j) : bool =
|
||||
lt_elems_1 (view@ arr | addr@ arr, i, j)
|
||||
|
||||
overload lt_elems with lt_elems_1
|
||||
overload lt_elems with lt_elems_2
|
||||
|
||||
implement {a}
|
||||
array_quicksort {n} (arr, n) =
|
||||
let
|
||||
sortdef index = {i : nat | i < n}
|
||||
typedef index (i : int) = [0 <= i; i < n] size_t i
|
||||
typedef index = [i : index] index i
|
||||
|
||||
macdef lt = array_quicksort$lt<a>
|
||||
|
||||
fun
|
||||
quicksort {i, j : index}
|
||||
(arr : &array(a, n) >> _,
|
||||
first : index i,
|
||||
last : index j) : void =
|
||||
if first < last then
|
||||
{
|
||||
val pivot =
|
||||
array_quicksort$select_pivot_index<a> (arr, first, last)
|
||||
|
||||
(* Swap the pivot with the last element. *)
|
||||
val () = swap (arr, pivot, last)
|
||||
val pivot = last
|
||||
|
||||
fun
|
||||
search_rightwards (arr : &array (a, n),
|
||||
left : index) : index =
|
||||
if lt_elems<a> (arr, left, pivot) then
|
||||
let
|
||||
val () = assertloc (succ left <> n)
|
||||
in
|
||||
search_rightwards (arr, succ left)
|
||||
end
|
||||
else
|
||||
left
|
||||
|
||||
fun
|
||||
search_leftwards (arr : &array (a, n),
|
||||
left : index,
|
||||
right : index) : index =
|
||||
if right < left then
|
||||
right
|
||||
else if lt_elems<a> (arr, pivot, right) then
|
||||
let
|
||||
val () = assertloc (right <> i2sz 0)
|
||||
in
|
||||
search_leftwards (arr, left, pred right)
|
||||
end
|
||||
else
|
||||
right
|
||||
|
||||
fun
|
||||
partition (arr : &array (a, n) >> _,
|
||||
left0 : index,
|
||||
right0 : index) : @(index, index) =
|
||||
let
|
||||
val left = search_rightwards (arr, left0)
|
||||
val right = search_leftwards (arr, left, right0)
|
||||
in
|
||||
if left <= right then
|
||||
let
|
||||
val () = assertloc (succ left <> n)
|
||||
and () = assertloc (right <> i2sz 0)
|
||||
in
|
||||
swap (arr, left, right);
|
||||
partition (arr, succ left, pred right)
|
||||
end
|
||||
else
|
||||
@(left, right)
|
||||
end
|
||||
|
||||
val @(left, right) = partition (arr, first, pred last)
|
||||
|
||||
val () = quicksort (arr, first, right)
|
||||
and () = quicksort (arr, left, last)
|
||||
}
|
||||
in
|
||||
if i2sz 2 <= n then
|
||||
quicksort {0, n - 1} (arr, i2sz 0, pred n)
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
implement
|
||||
array_quicksort$lt<Strptr1> (pfx, pfy | px, py) =
|
||||
compare (!px, !py) < 0
|
||||
|
||||
implement
|
||||
array_quicksort$select_pivot_index<Strptr1> {n} (arr, first, last) =
|
||||
(* Median of three. *)
|
||||
let
|
||||
val middle = first + ((last - first) / i2sz 2)
|
||||
in
|
||||
if lt_elems<Strptr1> (arr, middle, first)
|
||||
xor lt_elems<Strptr1> (arr, last, first) then
|
||||
first
|
||||
else if lt_elems<Strptr1> (arr, middle, first)
|
||||
xor lt_elems<Strptr1> (arr, middle, last) then
|
||||
middle
|
||||
else
|
||||
last
|
||||
end
|
||||
|
||||
implement
|
||||
list_vt_map$fopr<string><Strptr1> (s) = string0_copy s
|
||||
|
||||
implement
|
||||
list_vt_freelin$clear<Strptr1> (x) = strptr_free x
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
let
|
||||
val example_strings =
|
||||
$list_vt
|
||||
("choose", "any", "element", "of", "the", "array",
|
||||
"to", "be", "the", "pivot",
|
||||
"divide", "all", "other", "elements", "except",
|
||||
"the", "pivot", "into", "two", "partitions",
|
||||
"all", "elements", "less", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "first", "partition",
|
||||
"all", "elements", "greater", "than", "the", "pivot",
|
||||
"must", "be", "in", "the", "second", "partition",
|
||||
"use", "recursion", "to", "sort", "both", "partitions",
|
||||
"join", "the", "first", "sorted", "partition", "the",
|
||||
"pivot", "and", "the", "second", "sorted", "partition")
|
||||
|
||||
val example_strptrs =
|
||||
list_vt_map<string><Strptr1> (example_strings)
|
||||
|
||||
prval () = lemma_list_vt_param example_strptrs
|
||||
val n = length example_strptrs
|
||||
|
||||
val @(pf, pfgc | p) = array_ptr_alloc<Strptr1> (i2sz n)
|
||||
macdef arr = !p
|
||||
|
||||
val () = array_initize_list_vt<Strptr1> (arr, n, example_strptrs)
|
||||
val () = array_quicksort<Strptr1> (arr, i2sz n)
|
||||
val sorted_strptrs = array2list (arr, i2sz n)
|
||||
|
||||
fun
|
||||
print_strptrs {n : nat} .<n>.
|
||||
(strptrs : !list_vt (Strptr1, n),
|
||||
i : int) : void =
|
||||
case+ strptrs of
|
||||
| NIL => if i <> 1 then println! () else ()
|
||||
| @ head :: tail =>
|
||||
begin
|
||||
print! head;
|
||||
if i = 8 then
|
||||
begin
|
||||
println! ();
|
||||
print_strptrs (tail, 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
print! " ";
|
||||
print_strptrs (tail, succ i)
|
||||
end;
|
||||
fold@ strptrs
|
||||
end
|
||||
in
|
||||
println! (length example_strings);
|
||||
println! (length sorted_strptrs);
|
||||
print_strptrs (sorted_strptrs, 1);
|
||||
list_vt_freelin<Strptr1> sorted_strptrs;
|
||||
array_ptr_free (pf, pfgc | p);
|
||||
list_vt_free<string> example_strings
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,113 @@
|
|||
# the following qsort implementation extracted from:
|
||||
#
|
||||
# ftp://ftp.armory.com/pub/lib/awk/qsort
|
||||
#
|
||||
# Copyleft GPLv2 John DuBois
|
||||
#
|
||||
# @(#) qsort 1.2.1 2005-10-21
|
||||
# 1990 john h. dubois iii (john@armory.com)
|
||||
#
|
||||
# qsortArbIndByValue(): Sort an array according to the values of its elements.
|
||||
#
|
||||
# Input variables:
|
||||
#
|
||||
# Arr[] is an array of values with arbitrary (associative) indices.
|
||||
#
|
||||
# Output variables:
|
||||
#
|
||||
# k[] is returned with numeric indices 1..n. The values assigned to these
|
||||
# indices are the indices of Arr[], ordered so that if Arr[] is stepped
|
||||
# through in the order Arr[k[1]] .. Arr[k[n]], it will be stepped through in
|
||||
# order of the values of its elements.
|
||||
#
|
||||
# Return value: The number of elements in the arrays (n).
|
||||
#
|
||||
# NOTES:
|
||||
#
|
||||
# Full example for accessing results:
|
||||
#
|
||||
# foolist["second"] = 2;
|
||||
# foolist["zero"] = 0;
|
||||
# foolist["third"] = 3;
|
||||
# foolist["first"] = 1;
|
||||
#
|
||||
# outlist[1] = 0;
|
||||
# n = qsortArbIndByValue(foolist, outlist)
|
||||
#
|
||||
# for (i = 1; i <= n; i++) {
|
||||
# printf("item at %s has value %d\n", outlist[i], foolist[outlist[i]]);
|
||||
# }
|
||||
# delete outlist;
|
||||
#
|
||||
function qsortArbIndByValue(Arr, k,
|
||||
ArrInd, ElNum)
|
||||
{
|
||||
ElNum = 0;
|
||||
for (ArrInd in Arr) {
|
||||
k[++ElNum] = ArrInd;
|
||||
}
|
||||
qsortSegment(Arr, k, 1, ElNum);
|
||||
return ElNum;
|
||||
}
|
||||
#
|
||||
# qsortSegment(): Sort a segment of an array.
|
||||
#
|
||||
# Input variables:
|
||||
#
|
||||
# Arr[] contains data with arbitrary indices.
|
||||
#
|
||||
# k[] has indices 1..nelem, with the indices of Arr[] as values.
|
||||
#
|
||||
# Output variables:
|
||||
#
|
||||
# k[] is modified by this function. The elements of Arr[] that are pointed to
|
||||
# by k[start..end] are sorted, with the values of elements of k[] swapped
|
||||
# so that when this function returns, Arr[k[start..end]] will be in order.
|
||||
#
|
||||
# Return value: None.
|
||||
#
|
||||
function qsortSegment(Arr, k, start, end,
|
||||
left, right, sepval, tmp, tmpe, tmps)
|
||||
{
|
||||
if ((end - start) < 1) { # 0 or 1 elements
|
||||
return;
|
||||
}
|
||||
# handle two-element case explicitly for a tiny speedup
|
||||
if ((end - start) == 1) {
|
||||
if (Arr[tmps = k[start]] > Arr[tmpe = k[end]]) {
|
||||
k[start] = tmpe;
|
||||
k[end] = tmps;
|
||||
}
|
||||
return;
|
||||
}
|
||||
# Make sure comparisons act on these as numbers
|
||||
left = start + 0;
|
||||
right = end + 0;
|
||||
sepval = Arr[k[int((left + right) / 2)]];
|
||||
# Make every element <= sepval be to the left of every element > sepval
|
||||
while (left < right) {
|
||||
while (Arr[k[left]] < sepval) {
|
||||
left++;
|
||||
}
|
||||
while (Arr[k[right]] > sepval) {
|
||||
right--;
|
||||
}
|
||||
if (left < right) {
|
||||
tmp = k[left];
|
||||
k[left++] = k[right];
|
||||
k[right--] = tmp;
|
||||
}
|
||||
}
|
||||
if (left == right)
|
||||
if (Arr[k[left]] < sepval) {
|
||||
left++;
|
||||
} else {
|
||||
right--;
|
||||
}
|
||||
if (start < right) {
|
||||
qsortSegment(Arr, k, start, right);
|
||||
}
|
||||
if (left < end) {
|
||||
qsortSegment(Arr, k, left, end);
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
DEFINE MAX_COUNT="100"
|
||||
INT ARRAY stack(MAX_COUNT)
|
||||
INT stackSize
|
||||
|
||||
PROC PrintArray(INT ARRAY a INT size)
|
||||
INT i
|
||||
|
||||
Put('[)
|
||||
FOR i=0 TO size-1
|
||||
DO
|
||||
IF i>0 THEN Put(' ) FI
|
||||
PrintI(a(i))
|
||||
OD
|
||||
Put(']) PutE()
|
||||
RETURN
|
||||
|
||||
PROC InitStack()
|
||||
stackSize=0
|
||||
RETURN
|
||||
|
||||
BYTE FUNC IsEmpty()
|
||||
IF stackSize=0 THEN
|
||||
RETURN (1)
|
||||
FI
|
||||
RETURN (0)
|
||||
|
||||
PROC Push(INT low,high)
|
||||
stack(stackSize)=low stackSize==+1
|
||||
stack(stackSize)=high stackSize==+1
|
||||
RETURN
|
||||
|
||||
PROC Pop(INT POINTER low,high)
|
||||
stackSize==-1 high^=stack(stackSize)
|
||||
stackSize==-1 low^=stack(stackSize)
|
||||
RETURN
|
||||
|
||||
INT FUNC Partition(INT ARRAY a INT low,high)
|
||||
INT part,v,i,tmp
|
||||
|
||||
v=a(high)
|
||||
part=low-1
|
||||
|
||||
FOR i=low TO high-1
|
||||
DO
|
||||
IF a(i)<=v THEN
|
||||
part==+1
|
||||
tmp=a(part) a(part)=a(i) a(i)=tmp
|
||||
FI
|
||||
OD
|
||||
|
||||
part==+1
|
||||
tmp=a(part) a(part)=a(high) a(high)=tmp
|
||||
RETURN (part)
|
||||
|
||||
PROC QuickSort(INT ARRAY a INT size)
|
||||
INT low,high,part
|
||||
|
||||
InitStack()
|
||||
Push(0,size-1)
|
||||
WHILE IsEmpty()=0
|
||||
DO
|
||||
Pop(@low,@high)
|
||||
part=Partition(a,low,high)
|
||||
IF part-1>low THEN
|
||||
Push(low,part-1)
|
||||
FI
|
||||
IF part+1<high THEN
|
||||
Push(part+1,high)
|
||||
FI
|
||||
OD
|
||||
RETURN
|
||||
|
||||
PROC Test(INT ARRAY a INT size)
|
||||
PrintE("Array before sort:")
|
||||
PrintArray(a,size)
|
||||
QuickSort(a,size)
|
||||
PrintE("Array after sort:")
|
||||
PrintArray(a,size)
|
||||
PutE()
|
||||
RETURN
|
||||
|
||||
PROC Main()
|
||||
INT ARRAY
|
||||
a(10)=[1 4 65535 0 3 7 4 8 20 65530],
|
||||
b(21)=[10 9 8 7 6 5 4 3 2 1 0
|
||||
65535 65534 65533 65532 65531
|
||||
65530 65529 65528 65527 65526],
|
||||
c(8)=[101 102 103 104 105 106 107 108],
|
||||
d(12)=[1 65535 1 65535 1 65535 1
|
||||
65535 1 65535 1 65535]
|
||||
|
||||
Test(a,10)
|
||||
Test(b,21)
|
||||
Test(c,8)
|
||||
Test(d,12)
|
||||
RETURN
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
function quickSort (array:Array):Array
|
||||
{
|
||||
if (array.length <= 1)
|
||||
return array;
|
||||
|
||||
var pivot:Number = array[Math.round(array.length / 2)];
|
||||
|
||||
return quickSort(array.filter(function (x:Number, index:int, array:Array):Boolean { return x < pivot; })).concat(
|
||||
array.filter(function (x:Number, index:int, array:Array):Boolean { return x == pivot; })).concat(
|
||||
quickSort(array.filter(function (x:Number, index:int, array:Array):Boolean { return x > pivot; })));
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
function quickSort (array:Array):Array
|
||||
{
|
||||
if (array.length <= 1)
|
||||
return array;
|
||||
|
||||
var pivot:Number = array[Math.round(array.length / 2)];
|
||||
|
||||
var less:Array = [];
|
||||
var equal:Array = [];
|
||||
var greater:Array = [];
|
||||
|
||||
for each (var x:Number in array) {
|
||||
if (x < pivot)
|
||||
less.push(x);
|
||||
if (x == pivot)
|
||||
equal.push(x);
|
||||
if (x > pivot)
|
||||
greater.push(x);
|
||||
}
|
||||
|
||||
return quickSort(less).concat(
|
||||
equal).concat(
|
||||
quickSort(greater));
|
||||
}
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
-----------------------------------------------------------------------
|
||||
-- Generic Quick_Sort procedure
|
||||
-----------------------------------------------------------------------
|
||||
generic
|
||||
type Element is private;
|
||||
type Index is (<>);
|
||||
type Element_Array is array(Index range <>) of Element;
|
||||
with function "<" (Left, Right : Element) return Boolean is <>;
|
||||
procedure Quick_Sort(A : in out Element_Array);
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
-----------------------------------------------------------------------
|
||||
-- Generic Quick_Sort procedure
|
||||
-----------------------------------------------------------------------
|
||||
|
||||
procedure Quick_Sort (A : in out Element_Array) is
|
||||
|
||||
procedure Swap(Left, Right : Index) is
|
||||
Temp : Element := A (Left);
|
||||
begin
|
||||
A (Left) := A (Right);
|
||||
A (Right) := Temp;
|
||||
end Swap;
|
||||
|
||||
begin
|
||||
if A'Length > 1 then
|
||||
declare
|
||||
Pivot_Value : Element := A (A'First);
|
||||
Right : Index := A'Last;
|
||||
Left : Index := A'First;
|
||||
begin
|
||||
loop
|
||||
while Left < Right and not (Pivot_Value < A (Left)) loop
|
||||
Left := Index'Succ (Left);
|
||||
end loop;
|
||||
while Pivot_Value < A (Right) loop
|
||||
Right := Index'Pred (Right);
|
||||
end loop;
|
||||
exit when Right <= Left;
|
||||
Swap (Left, Right);
|
||||
Left := Index'Succ (Left);
|
||||
Right := Index'Pred (Right);
|
||||
end loop;
|
||||
if Right = A'Last then
|
||||
Right := Index'Pred (Right);
|
||||
Swap (A'First, A'Last);
|
||||
end if;
|
||||
if Left = A'First then
|
||||
Left := Index'Succ (Left);
|
||||
end if;
|
||||
Quick_Sort (A (A'First .. Right));
|
||||
Quick_Sort (A (Left .. A'Last));
|
||||
end;
|
||||
end if;
|
||||
end Quick_Sort;
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
with Ada.Text_Io;
|
||||
with Ada.Float_Text_IO; use Ada.Float_Text_IO;
|
||||
with Quick_Sort;
|
||||
|
||||
procedure Sort_Test is
|
||||
type Days is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
|
||||
type Sales is array (Days range <>) of Float;
|
||||
procedure Sort_Days is new Quick_Sort(Float, Days, Sales);
|
||||
|
||||
procedure Print (Item : Sales) is
|
||||
begin
|
||||
for I in Item'range loop
|
||||
Put(Item => Item(I), Fore => 5, Aft => 2, Exp => 0);
|
||||
end loop;
|
||||
end Print;
|
||||
|
||||
Weekly_Sales : Sales := (Mon => 300.0,
|
||||
Tue => 700.0,
|
||||
Wed => 800.0,
|
||||
Thu => 500.0,
|
||||
Fri => 200.0,
|
||||
Sat => 100.0,
|
||||
Sun => 900.0);
|
||||
|
||||
begin
|
||||
|
||||
Print(Weekly_Sales);
|
||||
Ada.Text_Io.New_Line(2);
|
||||
Sort_Days(Weekly_Sales);
|
||||
Print(Weekly_Sales);
|
||||
|
||||
end Sort_Test;
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
-- quickSort :: (Ord a) => [a] -> [a]
|
||||
on quickSort(xs)
|
||||
if length of xs > 1 then
|
||||
set {h, t} to uncons(xs)
|
||||
|
||||
-- lessOrEqual :: a -> Bool
|
||||
script lessOrEqual
|
||||
on |λ|(x)
|
||||
x ≤ h
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
set {less, more} to partition(lessOrEqual, t)
|
||||
|
||||
quickSort(less) & h & quickSort(more)
|
||||
else
|
||||
xs
|
||||
end if
|
||||
end quickSort
|
||||
|
||||
|
||||
-- TEST -----------------------------------------------------------------------
|
||||
on run
|
||||
|
||||
quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7])
|
||||
|
||||
--> {5.7, 8.5, 11.8, 14.1, 16.7, 21.3}
|
||||
|
||||
end run
|
||||
|
||||
|
||||
-- GENERIC FUNCTIONS ----------------------------------------------------------
|
||||
|
||||
-- partition :: predicate -> List -> (Matches, nonMatches)
|
||||
-- partition :: (a -> Bool) -> [a] -> ([a], [a])
|
||||
on partition(f, xs)
|
||||
tell mReturn(f)
|
||||
set lst to {{}, {}}
|
||||
repeat with x in xs
|
||||
set v to contents of x
|
||||
set end of item ((|λ|(v) as integer) + 1) of lst to v
|
||||
end repeat
|
||||
return {item 2 of lst, item 1 of lst}
|
||||
end tell
|
||||
end partition
|
||||
|
||||
-- uncons :: [a] -> Maybe (a, [a])
|
||||
on uncons(xs)
|
||||
if length of xs > 0 then
|
||||
{item 1 of xs, rest of xs}
|
||||
else
|
||||
missing value
|
||||
end if
|
||||
end uncons
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
|
@ -0,0 +1 @@
|
|||
{5.7, 8.5, 11.8, 14.1, 16.7, 21.3}
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
-- In-place Quicksort (basic algorithm).
|
||||
-- Algorithm: S.A.R. (Tony) Hoare, 1960.
|
||||
on quicksort(theList, l, r) -- Sort items l thru r of theList.
|
||||
set listLength to (count theList)
|
||||
if (listLength < 2) then return
|
||||
-- Convert negative and/or transposed range indices.
|
||||
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}
|
||||
|
||||
-- Script object containing the list as a property (to allow faster references to its items)
|
||||
-- and the recursive subhandler.
|
||||
script o
|
||||
property lst : theList
|
||||
|
||||
on qsrt(l, r)
|
||||
set pivot to my lst's item ((l + r) div 2)
|
||||
set i to l
|
||||
set j to r
|
||||
repeat until (i > j)
|
||||
set lv to my lst's item i
|
||||
repeat while (pivot > lv)
|
||||
set i to i + 1
|
||||
set lv to my lst's item i
|
||||
end repeat
|
||||
|
||||
set rv to my lst's item j
|
||||
repeat while (rv > pivot)
|
||||
set j to j - 1
|
||||
set rv to my lst's item j
|
||||
end repeat
|
||||
|
||||
if (j > i) then
|
||||
set my lst's item i to rv
|
||||
set my lst's item j to lv
|
||||
else if (i > j) then
|
||||
exit repeat
|
||||
end if
|
||||
|
||||
set i to i + 1
|
||||
set j to j - 1
|
||||
end repeat
|
||||
|
||||
if (j > l) then qsrt(l, j)
|
||||
if (i < r) then qsrt(i, r)
|
||||
end qsrt
|
||||
end script
|
||||
|
||||
tell o to qsrt(l, r)
|
||||
|
||||
return -- nothing.
|
||||
end quicksort
|
||||
property sort : quicksort
|
||||
|
||||
-- Demo:
|
||||
local aList
|
||||
set aList to {28, 9, 95, 22, 67, 55, 20, 41, 60, 53, 100, 72, 19, 67, 14, 42, 29, 20, 74, 39}
|
||||
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
|
||||
return aList
|
||||
|
|
@ -0,0 +1 @@
|
|||
{9, 14, 19, 20, 20, 22, 28, 29, 39, 41, 42, 53, 55, 60, 67, 67, 72, 74, 95, 100}
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(def qs (seq)
|
||||
(if (empty seq) nil
|
||||
(let pivot (car seq)
|
||||
(join (qs (keep [< _ pivot] (cdr seq)))
|
||||
(list pivot)
|
||||
(qs (keep [>= _ pivot] (cdr seq)))))))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
quickSort: function [items][
|
||||
if 2 > size items -> return items
|
||||
|
||||
pivot: first items
|
||||
left: select slice items 1 (size items)-1 'x -> x < pivot
|
||||
right: select slice items 1 (size items)-1 'x -> x >= pivot
|
||||
|
||||
((quickSort left) ++ pivot) ++ quickSort right
|
||||
]
|
||||
|
||||
print quickSort [3 1 2 8 5 7 9 4 6]
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
a := [4, 65, 2, -31, 0, 99, 83, 782, 7]
|
||||
for k, v in QuickSort(a)
|
||||
Out .= "," v
|
||||
MsgBox, % SubStr(Out, 2)
|
||||
return
|
||||
|
||||
QuickSort(a)
|
||||
{
|
||||
if (a.MaxIndex() <= 1)
|
||||
return a
|
||||
Less := [], Same := [], More := []
|
||||
Pivot := a[1]
|
||||
for k, v in a
|
||||
{
|
||||
if (v < Pivot)
|
||||
less.Insert(v)
|
||||
else if (v > Pivot)
|
||||
more.Insert(v)
|
||||
else
|
||||
same.Insert(v)
|
||||
}
|
||||
Less := QuickSort(Less)
|
||||
Out := QuickSort(More)
|
||||
if (Same.MaxIndex())
|
||||
Out.Insert(1, Same*) ; insert all values of same at index 1
|
||||
if (Less.MaxIndex())
|
||||
Out.Insert(1, Less*) ; insert all values of less at index 1
|
||||
return Out
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
MsgBox % quicksort("8,4,9,2,1")
|
||||
|
||||
quicksort(list)
|
||||
{
|
||||
StringSplit, list, list, `,
|
||||
If (list0 <= 1)
|
||||
Return list
|
||||
pivot := list1
|
||||
Loop, Parse, list, `,
|
||||
{
|
||||
If (A_LoopField < pivot)
|
||||
less = %less%,%A_LoopField%
|
||||
Else If (A_LoopField > pivot)
|
||||
more = %more%,%A_LoopField%
|
||||
Else
|
||||
pivotlist = %pivotlist%,%A_LoopField%
|
||||
}
|
||||
StringTrimLeft, less, less, 1
|
||||
StringTrimLeft, more, more, 1
|
||||
StringTrimLeft, pivotList, pivotList, 1
|
||||
less := quicksort(less)
|
||||
more := quicksort(more)
|
||||
Return less . pivotList . more
|
||||
}
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
DECLARE SUB quicksort (arr() AS INTEGER, leftN AS INTEGER, rightN AS INTEGER)
|
||||
|
||||
DIM q(99) AS INTEGER
|
||||
DIM n AS INTEGER
|
||||
|
||||
RANDOMIZE TIMER
|
||||
|
||||
FOR n = 0 TO 99
|
||||
q(n) = INT(RND * 9999)
|
||||
NEXT
|
||||
|
||||
OPEN "output.txt" FOR OUTPUT AS 1
|
||||
FOR n = 0 TO 99
|
||||
PRINT #1, q(n),
|
||||
NEXT
|
||||
PRINT #1,
|
||||
quicksort q(), 0, 99
|
||||
FOR n = 0 TO 99
|
||||
PRINT #1, q(n),
|
||||
NEXT
|
||||
CLOSE
|
||||
|
||||
SUB quicksort (arr() AS INTEGER, leftN AS INTEGER, rightN AS INTEGER)
|
||||
DIM pivot AS INTEGER, leftNIdx AS INTEGER, rightNIdx AS INTEGER
|
||||
leftNIdx = leftN
|
||||
rightNIdx = rightN
|
||||
IF (rightN - leftN) > 0 THEN
|
||||
pivot = (leftN + rightN) / 2
|
||||
WHILE (leftNIdx <= pivot) AND (rightNIdx >= pivot)
|
||||
WHILE (arr(leftNIdx) < arr(pivot)) AND (leftNIdx <= pivot)
|
||||
leftNIdx = leftNIdx + 1
|
||||
WEND
|
||||
WHILE (arr(rightNIdx) > arr(pivot)) AND (rightNIdx >= pivot)
|
||||
rightNIdx = rightNIdx - 1
|
||||
WEND
|
||||
SWAP arr(leftNIdx), arr(rightNIdx)
|
||||
leftNIdx = leftNIdx + 1
|
||||
rightNIdx = rightNIdx - 1
|
||||
IF (leftNIdx - 1) = pivot THEN
|
||||
rightNIdx = rightNIdx + 1
|
||||
pivot = rightNIdx
|
||||
ELSEIF (rightNIdx + 1) = pivot THEN
|
||||
leftNIdx = leftNIdx - 1
|
||||
pivot = leftNIdx
|
||||
END IF
|
||||
WEND
|
||||
quicksort arr(), leftN, pivot - 1
|
||||
quicksort arr(), pivot + 1, rightN
|
||||
END IF
|
||||
END SUB
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
DIM test(9)
|
||||
test() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
|
||||
PROCquicksort(test(), 0, 10)
|
||||
FOR i% = 0 TO 9
|
||||
PRINT test(i%) ;
|
||||
NEXT
|
||||
PRINT
|
||||
END
|
||||
|
||||
DEF PROCquicksort(a(), s%, n%)
|
||||
LOCAL l%, p, r%, t%
|
||||
IF n% < 2 THEN ENDPROC
|
||||
t% = s% + n% - 1
|
||||
l% = s%
|
||||
r% = t%
|
||||
p = a((l% + r%) DIV 2)
|
||||
REPEAT
|
||||
WHILE a(l%) < p l% += 1 : ENDWHILE
|
||||
WHILE a(r%) > p r% -= 1 : ENDWHILE
|
||||
IF l% <= r% THEN
|
||||
SWAP a(l%), a(r%)
|
||||
l% += 1
|
||||
r% -= 1
|
||||
ENDIF
|
||||
UNTIL l% > r%
|
||||
IF s% < r% PROCquicksort(a(), s%, r% - s% + 1)
|
||||
IF l% < t% PROCquicksort(a(), l%, t% - l% + 1 )
|
||||
ENDPROC
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.
|
||||
|
||||
GET "libhdr.h"
|
||||
|
||||
LET quicksort(v, n) BE qsort(v+1, v+n)
|
||||
|
||||
AND qsort(l, r) BE
|
||||
{ WHILE l+8<r DO
|
||||
{ LET midpt = (l+r)/2
|
||||
// Select a good(ish) median value.
|
||||
LET val = middle(!l, !midpt, !r)
|
||||
LET i = partition(val, l, r)
|
||||
// Only use recursion on the smaller partition.
|
||||
TEST i>midpt THEN { qsort(i, r); r := i-1 }
|
||||
ELSE { qsort(l, i-1); l := i }
|
||||
}
|
||||
|
||||
FOR p = l+1 TO r DO // Now perform insertion sort.
|
||||
FOR q = p-1 TO l BY -1 TEST q!0<=q!1 THEN BREAK
|
||||
ELSE { LET t = q!0
|
||||
q!0 := q!1
|
||||
q!1 := t
|
||||
}
|
||||
}
|
||||
|
||||
AND middle(a, b, c) = a<b -> b<c -> b,
|
||||
a<c -> c,
|
||||
a,
|
||||
b<c -> a<c -> a,
|
||||
c,
|
||||
b
|
||||
|
||||
AND partition(median, p, q) = VALOF
|
||||
{ LET t = ?
|
||||
WHILE !p < median DO p := p+1
|
||||
WHILE !q > median DO q := q-1
|
||||
IF p>=q RESULTIS p
|
||||
t := !p
|
||||
!p := !q
|
||||
!q := t
|
||||
p, q := p+1, q-1
|
||||
} REPEAT
|
||||
|
||||
LET start() = VALOF {
|
||||
LET v = VEC 1000
|
||||
FOR i = 1 TO 1000 DO v!i := randno(1_000_000)
|
||||
quicksort(v, 1000)
|
||||
FOR i = 1 TO 1000 DO
|
||||
{ IF i MOD 10 = 0 DO newline()
|
||||
writef(" %i6", v!i)
|
||||
}
|
||||
newline()
|
||||
}
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
beads 1 program Quicksort
|
||||
|
||||
calc main_init
|
||||
var arr = [1, 3, 5, 1, 7, 9, 8, 6, 4, 2]
|
||||
var arr2 = arr
|
||||
quicksort(arr, 1, tree_count(arr))
|
||||
var tempStr : str
|
||||
loop across:arr index:ix
|
||||
tempStr = tempStr & ' ' & to_str(arr[ix])
|
||||
log tempStr
|
||||
|
||||
calc quicksort(
|
||||
arr:array of num
|
||||
startIndex
|
||||
highIndex
|
||||
)
|
||||
if (startIndex < highIndex)
|
||||
var partitionIndex = partition(arr, startIndex, highIndex)
|
||||
quicksort(arr, startIndex, partitionIndex - 1)
|
||||
quicksort(arr, partitionIndex+1, highIndex)
|
||||
|
||||
calc partition(
|
||||
arr:array of num
|
||||
startIndex
|
||||
highIndex
|
||||
):num
|
||||
var pivot = arr[highIndex]
|
||||
var i = startIndex - 1
|
||||
var j = startIndex
|
||||
loop while:(j <= highIndex - 1)
|
||||
if arr[j] < pivot
|
||||
inc i
|
||||
swap arr[i] <=> arr[j]
|
||||
inc j
|
||||
swap arr[i+1] <=> arr[highIndex]
|
||||
return (i+1)
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
( ( Q
|
||||
= Less Greater Equal pivot element
|
||||
. !arg:%(?pivot:?Equal) %?arg
|
||||
& :?Less:?Greater
|
||||
& whl
|
||||
' ( !arg:%?element ?arg
|
||||
& (.!element)+(.!pivot) { BAD: 1900+90 adds to 1990, GOOD: (.1900)+(.90) is sorted to (.90)+(.1900) }
|
||||
: ( (.!element)+(.!pivot)
|
||||
& !element !Less:?Less
|
||||
| (.!pivot)+(.!element)
|
||||
& !element !Greater:?Greater
|
||||
| ?&!element !Equal:?Equal
|
||||
)
|
||||
)
|
||||
& Q$!Less !Equal Q$!Greater
|
||||
| !arg
|
||||
)
|
||||
& out$Q$(1900 optimized variants of 4001/2 Quicksort (quick,sort) are (quick,sober) features of 90 languages)
|
||||
);
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
#include <iterator>
|
||||
#include <algorithm> // for std::partition
|
||||
#include <functional> // for std::less
|
||||
|
||||
// helper function for median of three
|
||||
template<typename T>
|
||||
T median(T t1, T t2, T t3)
|
||||
{
|
||||
if (t1 < t2)
|
||||
{
|
||||
if (t2 < t3)
|
||||
return t2;
|
||||
else if (t1 < t3)
|
||||
return t3;
|
||||
else
|
||||
return t1;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (t1 < t3)
|
||||
return t1;
|
||||
else if (t2 < t3)
|
||||
return t3;
|
||||
else
|
||||
return t2;
|
||||
}
|
||||
}
|
||||
|
||||
// helper object to get <= from <
|
||||
template<typename Order> struct non_strict_op:
|
||||
public std::binary_function<typename Order::second_argument_type,
|
||||
typename Order::first_argument_type,
|
||||
bool>
|
||||
{
|
||||
non_strict_op(Order o): order(o) {}
|
||||
bool operator()(typename Order::second_argument_type arg1,
|
||||
typename Order::first_argument_type arg2) const
|
||||
{
|
||||
return !order(arg2, arg1);
|
||||
}
|
||||
private:
|
||||
Order order;
|
||||
};
|
||||
|
||||
template<typename Order> non_strict_op<Order> non_strict(Order o)
|
||||
{
|
||||
return non_strict_op<Order>(o);
|
||||
}
|
||||
|
||||
template<typename RandomAccessIterator,
|
||||
typename Order>
|
||||
void quicksort(RandomAccessIterator first, RandomAccessIterator last, Order order)
|
||||
{
|
||||
if (first != last && first+1 != last)
|
||||
{
|
||||
typedef typename std::iterator_traits<RandomAccessIterator>::value_type value_type;
|
||||
RandomAccessIterator mid = first + (last - first)/2;
|
||||
value_type pivot = median(*first, *mid, *(last-1));
|
||||
RandomAccessIterator split1 = std::partition(first, last, std::bind2nd(order, pivot));
|
||||
RandomAccessIterator split2 = std::partition(split1, last, std::bind2nd(non_strict(order), pivot));
|
||||
quicksort(first, split1, order);
|
||||
quicksort(split2, last, order);
|
||||
}
|
||||
}
|
||||
|
||||
template<typename RandomAccessIterator>
|
||||
void quicksort(RandomAccessIterator first, RandomAccessIterator last)
|
||||
{
|
||||
quicksort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>());
|
||||
}
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
#include <iterator>
|
||||
#include <algorithm> // for std::partition
|
||||
#include <functional> // for std::less
|
||||
|
||||
template<typename RandomAccessIterator,
|
||||
typename Order>
|
||||
void quicksort(RandomAccessIterator first, RandomAccessIterator last, Order order)
|
||||
{
|
||||
if (last - first > 1)
|
||||
{
|
||||
RandomAccessIterator split = std::partition(first+1, last, std::bind2nd(order, *first));
|
||||
std::iter_swap(first, split-1);
|
||||
quicksort(first, split-1, order);
|
||||
quicksort(split, last, order);
|
||||
}
|
||||
}
|
||||
|
||||
template<typename RandomAccessIterator>
|
||||
void quicksort(RandomAccessIterator first, RandomAccessIterator last)
|
||||
{
|
||||
quicksort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>());
|
||||
}
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
//
|
||||
// The Tripartite conditional enables Bentley-McIlroy 3-way Partitioning.
|
||||
// This performs additional compares to isolate islands of keys equal to
|
||||
// the pivot value. Use unless key-equivalent classes are of small size.
|
||||
//
|
||||
#define Tripartite
|
||||
|
||||
namespace RosettaCode {
|
||||
using System;
|
||||
using System.Diagnostics;
|
||||
|
||||
public class QuickSort<T> where T : IComparable {
|
||||
#region Constants
|
||||
public const UInt32 INSERTION_LIMIT_DEFAULT = 12;
|
||||
private const Int32 SAMPLES_MAX = 19;
|
||||
#endregion
|
||||
|
||||
#region Properties
|
||||
public UInt32 InsertionLimit { get; }
|
||||
private T[] Samples { get; }
|
||||
private Int32 Left { get; set; }
|
||||
private Int32 Right { get; set; }
|
||||
private Int32 LeftMedian { get; set; }
|
||||
private Int32 RightMedian { get; set; }
|
||||
#endregion
|
||||
|
||||
#region Constructors
|
||||
public QuickSort(UInt32 insertionLimit = INSERTION_LIMIT_DEFAULT) {
|
||||
this.InsertionLimit = insertionLimit;
|
||||
this.Samples = new T[SAMPLES_MAX];
|
||||
}
|
||||
#endregion
|
||||
|
||||
#region Sort Methods
|
||||
public void Sort(T[] entries) {
|
||||
Sort(entries, 0, entries.Length - 1);
|
||||
}
|
||||
|
||||
public void Sort(T[] entries, Int32 first, Int32 last) {
|
||||
var length = last + 1 - first;
|
||||
while (length > 1) {
|
||||
if (length < InsertionLimit) {
|
||||
InsertionSort<T>.Sort(entries, first, last);
|
||||
return;
|
||||
}
|
||||
|
||||
Left = first;
|
||||
Right = last;
|
||||
var median = pivot(entries);
|
||||
partition(median, entries);
|
||||
//[Note]Right < Left
|
||||
|
||||
var leftLength = Right + 1 - first;
|
||||
var rightLength = last + 1 - Left;
|
||||
|
||||
//
|
||||
// First recurse over shorter partition, then loop
|
||||
// on the longer partition to elide tail recursion.
|
||||
//
|
||||
if (leftLength < rightLength) {
|
||||
Sort(entries, first, Right);
|
||||
first = Left;
|
||||
length = rightLength;
|
||||
}
|
||||
else {
|
||||
Sort(entries, Left, last);
|
||||
last = Right;
|
||||
length = leftLength;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/// <summary>Return an odd sample size proportional to the log of a large interval size.</summary>
|
||||
private static Int32 sampleSize(Int32 length, Int32 max = SAMPLES_MAX) {
|
||||
var logLen = (Int32)Math.Log10(length);
|
||||
var samples = Math.Min(2 * logLen + 1, max);
|
||||
return Math.Min(samples, length);
|
||||
}
|
||||
|
||||
/// <summary>Estimate the median value of entries[Left:Right]</summary>
|
||||
/// <remarks>A sample median is used as an estimate the true median.</remarks>
|
||||
private T pivot(T[] entries) {
|
||||
var length = Right + 1 - Left;
|
||||
var samples = sampleSize(length);
|
||||
// Sample Linearly:
|
||||
for (var sample = 0; sample < samples; sample++) {
|
||||
// Guard against Arithmetic Overflow:
|
||||
var index = (Int64)length * sample / samples + Left;
|
||||
Samples[sample] = entries[index];
|
||||
}
|
||||
|
||||
InsertionSort<T>.Sort(Samples, 0, samples - 1);
|
||||
return Samples[samples / 2];
|
||||
}
|
||||
|
||||
private void partition(T median, T[] entries) {
|
||||
var first = Left;
|
||||
var last = Right;
|
||||
#if Tripartite
|
||||
LeftMedian = first;
|
||||
RightMedian = last;
|
||||
#endif
|
||||
while (true) {
|
||||
//[Assert]There exists some index >= Left where entries[index] >= median
|
||||
//[Assert]There exists some index <= Right where entries[index] <= median
|
||||
// So, there is no need for Left or Right bound checks
|
||||
while (median.CompareTo(entries[Left]) > 0) Left++;
|
||||
while (median.CompareTo(entries[Right]) < 0) Right--;
|
||||
|
||||
//[Assert]entries[Right] <= median <= entries[Left]
|
||||
if (Right <= Left) break;
|
||||
|
||||
Swap(entries, Left, Right);
|
||||
swapOut(median, entries);
|
||||
Left++;
|
||||
Right--;
|
||||
//[Assert]entries[first:Left - 1] <= median <= entries[Right + 1:last]
|
||||
}
|
||||
|
||||
if (Left == Right) {
|
||||
Left++;
|
||||
Right--;
|
||||
}
|
||||
//[Assert]Right < Left
|
||||
swapIn(entries, first, last);
|
||||
|
||||
//[Assert]entries[first:Right] <= median <= entries[Left:last]
|
||||
//[Assert]entries[Right + 1:Left - 1] == median when non-empty
|
||||
}
|
||||
#endregion
|
||||
|
||||
#region Swap Methods
|
||||
[Conditional("Tripartite")]
|
||||
private void swapOut(T median, T[] entries) {
|
||||
if (median.CompareTo(entries[Left]) == 0) Swap(entries, LeftMedian++, Left);
|
||||
if (median.CompareTo(entries[Right]) == 0) Swap(entries, Right, RightMedian--);
|
||||
}
|
||||
|
||||
[Conditional("Tripartite")]
|
||||
private void swapIn(T[] entries, Int32 first, Int32 last) {
|
||||
// Restore Median entries
|
||||
while (first < LeftMedian) Swap(entries, first++, Right--);
|
||||
while (RightMedian < last) Swap(entries, Left++, last--);
|
||||
}
|
||||
|
||||
/// <summary>Swap entries at the left and right indicies.</summary>
|
||||
public void Swap(T[] entries, Int32 left, Int32 right) {
|
||||
Swap(ref entries[left], ref entries[right]);
|
||||
}
|
||||
|
||||
/// <summary>Swap two entities of type T.</summary>
|
||||
public static void Swap(ref T e1, ref T e2) {
|
||||
var e = e1;
|
||||
e1 = e2;
|
||||
e2 = e;
|
||||
}
|
||||
#endregion
|
||||
}
|
||||
|
||||
#region Insertion Sort
|
||||
static class InsertionSort<T> where T : IComparable {
|
||||
public static void Sort(T[] entries, Int32 first, Int32 last) {
|
||||
for (var next = first + 1; next <= last; next++)
|
||||
insert(entries, first, next);
|
||||
}
|
||||
|
||||
/// <summary>Bubble next entry up to its sorted location, assuming entries[first:next - 1] are already sorted.</summary>
|
||||
private static void insert(T[] entries, Int32 first, Int32 next) {
|
||||
var entry = entries[next];
|
||||
while (next > first && entries[next - 1].CompareTo(entry) > 0)
|
||||
entries[next] = entries[--next];
|
||||
entries[next] = entry;
|
||||
}
|
||||
}
|
||||
#endregion
|
||||
}
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
using Sort;
|
||||
using System;
|
||||
|
||||
class Program {
|
||||
static void Main(String[] args) {
|
||||
var entries = new Int32[] { 1, 3, 5, 7, 9, 8, 6, 4, 2 };
|
||||
var sorter = new QuickSort<Int32>();
|
||||
sorter.Sort(entries);
|
||||
Console.WriteLine(String.Join(" ", entries));
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
using System;
|
||||
using System.Collections.Generic;
|
||||
using System.Linq;
|
||||
|
||||
namespace QSort
|
||||
{
|
||||
class QSorter
|
||||
{
|
||||
private static IEnumerable<IComparable> empty = new List<IComparable>();
|
||||
|
||||
public static IEnumerable<IComparable> QSort(IEnumerable<IComparable> iEnumerable)
|
||||
{
|
||||
if(iEnumerable.Any())
|
||||
{
|
||||
var pivot = iEnumerable.First();
|
||||
return QSort(iEnumerable.Where((anItem) => pivot.CompareTo(anItem) > 0)).
|
||||
Concat(iEnumerable.Where((anItem) => pivot.CompareTo(anItem) == 0)).
|
||||
Concat(QSort(iEnumerable.Where((anItem) => pivot.CompareTo(anItem) < 0)));
|
||||
}
|
||||
return empty;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
#include <stdio.h>
|
||||
|
||||
void quicksort(int *A, int len);
|
||||
|
||||
int main (void) {
|
||||
int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
|
||||
int n = sizeof a / sizeof a[0];
|
||||
|
||||
int i;
|
||||
for (i = 0; i < n; i++) {
|
||||
printf("%d ", a[i]);
|
||||
}
|
||||
printf("\n");
|
||||
|
||||
quicksort(a, n);
|
||||
|
||||
for (i = 0; i < n; i++) {
|
||||
printf("%d ", a[i]);
|
||||
}
|
||||
printf("\n");
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
void quicksort(int *A, int len) {
|
||||
if (len < 2) return;
|
||||
|
||||
int pivot = A[len / 2];
|
||||
|
||||
int i, j;
|
||||
for (i = 0, j = len - 1; ; i++, j--) {
|
||||
while (A[i] < pivot) i++;
|
||||
while (A[j] > pivot) j--;
|
||||
|
||||
if (i >= j) break;
|
||||
|
||||
int temp = A[i];
|
||||
A[i] = A[j];
|
||||
A[j] = temp;
|
||||
}
|
||||
|
||||
quicksort(A, i);
|
||||
quicksort(A + i, len - i);
|
||||
}
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
#include <stdlib.h> // REQ: rand()
|
||||
|
||||
void swap(int *a, int *b) {
|
||||
int c = *a;
|
||||
*a = *b;
|
||||
*b = c;
|
||||
}
|
||||
|
||||
int partition(int A[], int p, int q) {
|
||||
swap(&A[p + (rand() % (q - p + 1))], &A[q]); // PIVOT = A[q]
|
||||
|
||||
int i = p - 1;
|
||||
for(int j = p; j <= q; j++) {
|
||||
if(A[j] <= A[q]) {
|
||||
swap(&A[++i], &A[j]);
|
||||
}
|
||||
}
|
||||
|
||||
return i;
|
||||
}
|
||||
|
||||
void quicksort(int A[], int p, int q) {
|
||||
if(p < q) {
|
||||
int pivotIndx = partition(A, p, q);
|
||||
|
||||
quicksort(A, p, pivotIndx - 1);
|
||||
quicksort(A, pivotIndx + 1, q);
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. quicksort RECURSIVE.
|
||||
|
||||
DATA DIVISION.
|
||||
LOCAL-STORAGE SECTION.
|
||||
01 temp PIC S9(8).
|
||||
|
||||
01 pivot PIC S9(8).
|
||||
|
||||
01 left-most-idx PIC 9(5).
|
||||
01 right-most-idx PIC 9(5).
|
||||
|
||||
01 left-idx PIC 9(5).
|
||||
01 right-idx PIC 9(5).
|
||||
|
||||
LINKAGE SECTION.
|
||||
78 Arr-Length VALUE 50.
|
||||
|
||||
01 arr-area.
|
||||
03 arr PIC S9(8) OCCURS Arr-Length TIMES.
|
||||
|
||||
01 left-val PIC 9(5).
|
||||
01 right-val PIC 9(5).
|
||||
|
||||
PROCEDURE DIVISION USING REFERENCE arr-area, OPTIONAL left-val,
|
||||
OPTIONAL right-val.
|
||||
IF left-val IS OMITTED OR right-val IS OMITTED
|
||||
MOVE 1 TO left-most-idx, left-idx
|
||||
MOVE Arr-Length TO right-most-idx, right-idx
|
||||
ELSE
|
||||
MOVE left-val TO left-most-idx, left-idx
|
||||
MOVE right-val TO right-most-idx, right-idx
|
||||
END-IF
|
||||
|
||||
IF right-most-idx - left-most-idx < 1
|
||||
GOBACK
|
||||
END-IF
|
||||
|
||||
COMPUTE pivot = arr ((left-most-idx + right-most-idx) / 2)
|
||||
|
||||
PERFORM UNTIL left-idx > right-idx
|
||||
PERFORM VARYING left-idx FROM left-idx BY 1
|
||||
UNTIL arr (left-idx) >= pivot
|
||||
END-PERFORM
|
||||
|
||||
PERFORM VARYING right-idx FROM right-idx BY -1
|
||||
UNTIL arr (right-idx) <= pivot
|
||||
END-PERFORM
|
||||
|
||||
IF left-idx <= right-idx
|
||||
MOVE arr (left-idx) TO temp
|
||||
MOVE arr (right-idx) TO arr (left-idx)
|
||||
MOVE temp TO arr (right-idx)
|
||||
|
||||
ADD 1 TO left-idx
|
||||
SUBTRACT 1 FROM right-idx
|
||||
END-IF
|
||||
END-PERFORM
|
||||
|
||||
CALL "quicksort" USING REFERENCE arr-area,
|
||||
CONTENT left-most-idx, right-idx
|
||||
CALL "quicksort" USING REFERENCE arr-area, CONTENT left-idx,
|
||||
right-most-idx
|
||||
|
||||
GOBACK
|
||||
.
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
mod! SIMPLE-LIST(X :: TRIV){
|
||||
[NeList < List ]
|
||||
op [] : -> List
|
||||
op [_] : Elt -> List
|
||||
op (_:_) : Elt List -> NeList -- consr
|
||||
op _++_ : List List -> List {assoc} -- concatenate
|
||||
var E : Elt
|
||||
vars L L' : List
|
||||
eq [ E ] = E : [] .
|
||||
eq [] ++ L = L .
|
||||
eq (E : L) ++ L' = E : (L ++ L') .
|
||||
}
|
||||
|
||||
mod! QUICKSORT{
|
||||
pr(SIMPLE-LIST(NAT))
|
||||
op qsort_ : List -> List
|
||||
op smaller__ : List Nat -> List
|
||||
op larger__ : List Nat -> List
|
||||
|
||||
vars x y : Nat
|
||||
vars xs ys : List
|
||||
|
||||
eq qsort [] = [] .
|
||||
eq qsort (x : xs) = (qsort (smaller xs x)) ++ [ x ] ++ (qsort (larger xs x)) .
|
||||
|
||||
eq smaller [] x = [] .
|
||||
eq smaller (x : xs) y = if x <= y then (x : (smaller xs y)) else (smaller xs y) fi .
|
||||
eq larger [] x = [] .
|
||||
eq larger (x : xs) y = if x <= y then (larger xs y) else (x : (larger xs y)) fi .
|
||||
|
||||
}
|
||||
open QUICKSORT .
|
||||
red qsort(5 : 4 : 3 : 2 : 1 : 0 : []) .
|
||||
red qsort(5 : 5 : 4 : 3 : 5 : 2 : 1 : 1 : 0 : []) .
|
||||
eof
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
(defn qsort [L]
|
||||
(if (empty? L)
|
||||
'()
|
||||
(let [[pivot & L2] L]
|
||||
(lazy-cat (qsort (for [y L2 :when (< y pivot)] y))
|
||||
(list pivot)
|
||||
(qsort (for [y L2 :when (>= y pivot)] y))))))
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
(defn qsort [[pvt & rs]]
|
||||
(if pvt
|
||||
`(~@(qsort (filter #(< % pvt) rs))
|
||||
~pvt
|
||||
~@(qsort (filter #(>= % pvt) rs)))))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(defn qsort [[pivot & xs]]
|
||||
(when pivot
|
||||
(let [smaller #(< % pivot)]
|
||||
(lazy-cat (qsort (filter smaller xs))
|
||||
[pivot]
|
||||
(qsort (remove smaller xs))))))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
(defn qsort3 [[pvt :as coll]]
|
||||
(when pvt
|
||||
(let [{left -1 mid 0 right 1} (group-by #(compare % pvt) coll)]
|
||||
(lazy-cat (qsort3 left) mid (qsort3 right)))))
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
(defn qsort3 [[pivot :as coll]]
|
||||
(when pivot
|
||||
(lazy-cat (qsort (filter #(< % pivot) coll))
|
||||
(filter #{pivot} coll)
|
||||
(qsort (filter #(> % pivot) coll)))))
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
quicksort = ([x, xs...]) ->
|
||||
return [] unless x?
|
||||
smallerOrEqual = (a for a in xs when a <= x)
|
||||
larger = (a for a in xs when a > x)
|
||||
(quicksort smallerOrEqual).concat(x).concat(quicksort larger)
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(defun quicksort (list &aux (pivot (car list)) )
|
||||
(if (cdr list)
|
||||
(nconc (quicksort (remove-if-not #'(lambda (x) (< x pivot)) list))
|
||||
(remove-if-not #'(lambda (x) (= x pivot)) list)
|
||||
(quicksort (remove-if-not #'(lambda (x) (> x pivot)) list)))
|
||||
list))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(defun qs (list)
|
||||
(if (cdr list)
|
||||
(flet ((pivot (test)
|
||||
(remove (car list) list :test-not test)))
|
||||
(nconc (qs (pivot #'>)) (pivot #'=) (qs (pivot #'<))))
|
||||
list))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(defun quicksort (sequence)
|
||||
(labels ((swap (a b) (rotatef (elt sequence a) (elt sequence b)))
|
||||
(sub-sort (left right)
|
||||
(when (< left right)
|
||||
(let ((pivot (elt sequence right))
|
||||
(index left))
|
||||
(loop for i from left below right
|
||||
when (<= (elt sequence i) pivot)
|
||||
do (swap i (prog1 index (incf index))))
|
||||
(swap right index)
|
||||
(sub-sort left (1- index))
|
||||
(sub-sort (1+ index) right)))))
|
||||
(sub-sort 0 (1- (length sequence)))
|
||||
sequence))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(defun quicksort (list)
|
||||
(when list
|
||||
(destructuring-bind (x . xs) list
|
||||
(nconc (quicksort (remove-if (lambda (a) (> a x)) xs))
|
||||
`(,x)
|
||||
(quicksort (remove-if (lambda (a) (<= a x)) xs))))))
|
||||
|
|
@ -0,0 +1,102 @@
|
|||
include "cowgol.coh";
|
||||
|
||||
# Comparator interface, on the model of C, i.e:
|
||||
# foo < bar => -1, foo == bar => 0, foo > bar => 1
|
||||
typedef CompRslt is int(-1, 1);
|
||||
interface Comparator(foo: intptr, bar: intptr): (rslt: CompRslt);
|
||||
|
||||
# Quicksort an array of pointer-sized integers given a comparator function
|
||||
# (This is the closest you can get to polymorphism in Cowgol).
|
||||
# Because Cowgol does not support recursion, a pointer to free memory
|
||||
# for a stack must also be given.
|
||||
sub qsort(A: [intptr], len: intptr, comp: Comparator, stack: [intptr]) is
|
||||
# The partition function can be taken almost verbatim from Wikipedia
|
||||
sub partition(lo: intptr, hi: intptr): (p: intptr) is
|
||||
# This is not quite as bad as it looks: /2 compiles into a single shift
|
||||
# and "@bytesof intptr" is always power of 2 so compiles into shift(s).
|
||||
var pivot := [A + (hi/2 + lo/2) * @bytesof intptr];
|
||||
var i := lo - 1;
|
||||
var j := hi + 1;
|
||||
loop
|
||||
loop
|
||||
i := i + 1;
|
||||
if comp([A + i*@bytesof intptr], pivot) != -1 then
|
||||
break;
|
||||
end if;
|
||||
end loop;
|
||||
loop
|
||||
j := j - 1;
|
||||
if comp([A + j*@bytesof intptr], pivot) != 1 then
|
||||
break;
|
||||
end if;
|
||||
end loop;
|
||||
if i >= j then
|
||||
p := j;
|
||||
return;
|
||||
end if;
|
||||
var ii := i * @bytesof intptr;
|
||||
var jj := j * @bytesof intptr;
|
||||
var t := [A+ii];
|
||||
[A+ii] := [A+jj];
|
||||
[A+jj] := t;
|
||||
end loop;
|
||||
end sub;
|
||||
|
||||
# Cowgol lacks recursion, so we'll have to solve it by implementing
|
||||
# the stack ourselves.
|
||||
var sp: intptr := 0; # stack index
|
||||
sub push(n: intptr) is
|
||||
sp := sp + 1;
|
||||
[stack] := n;
|
||||
stack := @next stack;
|
||||
end sub;
|
||||
sub pop(): (n: intptr) is
|
||||
sp := sp - 1;
|
||||
stack := @prev stack;
|
||||
n := [stack];
|
||||
end sub;
|
||||
|
||||
# start by sorting [0..length-1]
|
||||
push(len-1);
|
||||
push(0);
|
||||
while sp != 0 loop
|
||||
var lo := pop();
|
||||
var hi := pop();
|
||||
if lo < hi then
|
||||
var p := partition(lo, hi);
|
||||
push(hi); # note the order - we need to push the high pair
|
||||
push(p+1); # first for it to be done last
|
||||
push(p);
|
||||
push(lo);
|
||||
end if;
|
||||
end loop;
|
||||
end sub;
|
||||
|
||||
# Test: sort a list of numbers
|
||||
sub NumComp implements Comparator is
|
||||
# Compare the inputs as numbers
|
||||
if foo < bar then rslt := -1;
|
||||
elseif foo > bar then rslt := 1;
|
||||
else rslt := 0;
|
||||
end if;
|
||||
end sub;
|
||||
|
||||
# Numbers
|
||||
var numbers: intptr[] := {
|
||||
65,13,4,84,29,5,96,73,5,11,17,76,38,26,44,20,36,12,44,51,79,8,99,7,19,95,26
|
||||
};
|
||||
|
||||
# Room for the stack
|
||||
var stackbuf: intptr[256];
|
||||
|
||||
# Sort the numbers in place
|
||||
qsort(&numbers as [intptr], @sizeof numbers, NumComp, &stackbuf as [intptr]);
|
||||
|
||||
# Print the numbers (hopefully in order)
|
||||
var i: @indexof numbers := 0;
|
||||
while i < @sizeof numbers loop
|
||||
print_i32(numbers[i] as uint32);
|
||||
print_char(' ');
|
||||
i := i + 1;
|
||||
end loop;
|
||||
print_nl();
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
define size = 10, point = 0, top = 0
|
||||
define high = 0, low = 0, pivot = 0
|
||||
|
||||
dim list[size]
|
||||
dim stack[size]
|
||||
|
||||
gosub fill
|
||||
gosub sort
|
||||
gosub show
|
||||
|
||||
end
|
||||
|
||||
sub fill
|
||||
|
||||
for i = 0 to size - 1
|
||||
|
||||
let list[i] = int(rnd * 100)
|
||||
|
||||
next i
|
||||
|
||||
return
|
||||
|
||||
sub sort
|
||||
|
||||
let low = 0
|
||||
let high = size - 1
|
||||
let top = -1
|
||||
|
||||
let top = top + 1
|
||||
let stack[top] = low
|
||||
let top = top + 1
|
||||
let stack[top] = high
|
||||
|
||||
do
|
||||
|
||||
if top < 0 then
|
||||
|
||||
break
|
||||
|
||||
endif
|
||||
|
||||
let high = stack[top]
|
||||
let top = top - 1
|
||||
let low = stack[top]
|
||||
let top = top - 1
|
||||
|
||||
let i = low - 1
|
||||
|
||||
for j = low to high - 1
|
||||
|
||||
if list[j] <= list[high] then
|
||||
|
||||
let i = i + 1
|
||||
let t = list[i]
|
||||
let list[i] = list[j]
|
||||
let list[j] = t
|
||||
|
||||
endif
|
||||
|
||||
next j
|
||||
|
||||
let point = i + 1
|
||||
let t = list[point]
|
||||
let list[point] = list[high]
|
||||
let list[high] = t
|
||||
let pivot = i + 1
|
||||
|
||||
if pivot - 1 > low then
|
||||
|
||||
let top = top + 1
|
||||
let stack[top] = low
|
||||
let top = top + 1
|
||||
let stack[top] = pivot - 1
|
||||
|
||||
endif
|
||||
|
||||
if pivot + 1 < high then
|
||||
|
||||
let top = top + 1
|
||||
let stack[top] = pivot + 1
|
||||
let top = top + 1
|
||||
let stack[top] = high
|
||||
|
||||
endif
|
||||
|
||||
wait
|
||||
|
||||
loop top >= 0
|
||||
|
||||
return
|
||||
|
||||
sub show
|
||||
|
||||
for i = 0 to size - 1
|
||||
|
||||
print i, ": ", list[i]
|
||||
|
||||
next i
|
||||
|
||||
return
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
def quick_sort(a : Array(Int32)) : Array(Int32)
|
||||
return a if a.size <= 1
|
||||
p = a[0]
|
||||
lt, rt = a[1 .. -1].partition { |x| x < p }
|
||||
return quick_sort(lt) + [p] + quick_sort(rt)
|
||||
end
|
||||
|
||||
a = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
|
||||
puts quick_sort(a) # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
-- quicksort using higher-order functions:
|
||||
|
||||
qsort :: [Int] -> [Int]
|
||||
qsort [] = []
|
||||
qsort (x:l) = qsort (filter (<x) l) ++ x : qsort (filter (>=x) l)
|
||||
|
||||
goal = qsort [2,3,1,0]
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
import std.stdio : writefln, writeln;
|
||||
import std.algorithm: filter;
|
||||
import std.array;
|
||||
|
||||
T[] quickSort(T)(T[] xs) =>
|
||||
xs.length == 0 ? [] :
|
||||
xs[1 .. $].filter!(x => x< xs[0]).array.quickSort ~
|
||||
xs[0 .. 1] ~
|
||||
xs[1 .. $].filter!(x => x>=xs[0]).array.quickSort;
|
||||
|
||||
void main() =>
|
||||
[4, 65, 2, -31, 0, 99, 2, 83, 782, 1].quickSort.writeln;
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
import std.stdio, std.array;
|
||||
|
||||
T[] quickSort(T)(T[] items) pure nothrow {
|
||||
if (items.empty)
|
||||
return items;
|
||||
T[] less, notLess;
|
||||
foreach (x; items[1 .. $])
|
||||
(x < items[0] ? less : notLess) ~= x;
|
||||
return less.quickSort ~ items[0] ~ notLess.quickSort;
|
||||
}
|
||||
|
||||
void main() {
|
||||
[4, 65, 2, -31, 0, 99, 2, 83, 782, 1].quickSort.writeln;
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
import std.stdio, std.algorithm;
|
||||
|
||||
void quickSort(T)(T[] items) pure nothrow @safe @nogc {
|
||||
if (items.length >= 2) {
|
||||
auto parts = partition3(items, items[$ / 2]);
|
||||
parts[0].quickSort;
|
||||
parts[2].quickSort;
|
||||
}
|
||||
}
|
||||
|
||||
void main() {
|
||||
auto items = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1];
|
||||
items.quickSort;
|
||||
items.writeln;
|
||||
}
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
quickSort(List a) {
|
||||
if (a.length <= 1) {
|
||||
return a;
|
||||
}
|
||||
|
||||
var pivot = a[0];
|
||||
var less = [];
|
||||
var more = [];
|
||||
var pivotList = [];
|
||||
|
||||
// Partition
|
||||
a.forEach((var i){
|
||||
if (i.compareTo(pivot) < 0) {
|
||||
less.add(i);
|
||||
} else if (i.compareTo(pivot) > 0) {
|
||||
more.add(i);
|
||||
} else {
|
||||
pivotList.add(i);
|
||||
}
|
||||
});
|
||||
|
||||
// Recursively sort sublists
|
||||
less = quickSort(less);
|
||||
more = quickSort(more);
|
||||
|
||||
// Concatenate results
|
||||
less.addAll(pivotList);
|
||||
less.addAll(more);
|
||||
return less;
|
||||
}
|
||||
|
||||
void main() {
|
||||
var arr=[1,5,2,7,3,9,4,6,8];
|
||||
print("Before sort");
|
||||
arr.forEach((var i)=>print("$i"));
|
||||
arr = quickSort(arr);
|
||||
print("After sort");
|
||||
arr.forEach((var i)=>print("$i"));
|
||||
}
|
||||
|
|
@ -0,0 +1,140 @@
|
|||
{Dynamic array of pointers}
|
||||
|
||||
type TPointerArray = array of Pointer;
|
||||
|
||||
procedure QuickSort(SortList: TPointerArray; L, R: Integer; SCompare: TListSortCompare);
|
||||
{Do quick sort on items held in TPointerArray}
|
||||
{SCompare controls how the pointers are interpreted}
|
||||
var I, J: Integer;
|
||||
var P,T: Pointer;
|
||||
begin
|
||||
repeat
|
||||
begin
|
||||
I := L;
|
||||
J := R;
|
||||
P := SortList[(L + R) shr 1];
|
||||
repeat
|
||||
begin
|
||||
while SCompare(SortList[I], P) < 0 do Inc(I);
|
||||
while SCompare(SortList[J], P) > 0 do Dec(J);
|
||||
if I <= J then
|
||||
begin
|
||||
{Exchange itesm}
|
||||
T:=SortList[I];
|
||||
SortList[I]:=SortList[J];
|
||||
SortList[J]:=T;
|
||||
if P = SortList[I] then P := SortList[J]
|
||||
else if P = SortList[J] then P := SortList[I];
|
||||
Inc(I);
|
||||
Dec(J);
|
||||
end;
|
||||
end
|
||||
until I > J;
|
||||
if L < J then QuickSort(SortList, L, J, SCompare);
|
||||
L := I;
|
||||
end
|
||||
until I >= R;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure DisplayStrings(Memo: TMemo; PA: TPointerArray);
|
||||
{Display pointers as strings}
|
||||
var I: integer;
|
||||
var S: string;
|
||||
begin
|
||||
S:='[';
|
||||
for I:=0 to High(PA) do
|
||||
begin
|
||||
if I>0 then S:=S+' ';
|
||||
S:=S+string(PA[I]^);
|
||||
end;
|
||||
S:=S+']';
|
||||
Memo.Lines.Add(S);
|
||||
end;
|
||||
|
||||
|
||||
procedure DisplayIntegers(Memo: TMemo; PA: TPointerArray);
|
||||
{Display pointer array as integers}
|
||||
var I: integer;
|
||||
var S: string;
|
||||
begin
|
||||
S:='[';
|
||||
for I:=0 to High(PA) do
|
||||
begin
|
||||
if I>0 then S:=S+' ';
|
||||
S:=S+IntToStr(Integer(PA[I]));
|
||||
end;
|
||||
S:=S+']';
|
||||
Memo.Lines.Add(S);
|
||||
end;
|
||||
|
||||
|
||||
function IntCompare(Item1, Item2: Pointer): Integer;
|
||||
{Compare for integer sort}
|
||||
begin
|
||||
Result:=Integer(Item1)-Integer(Item2);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function StringCompare(Item1, Item2: Pointer): Integer;
|
||||
{Compare for alphabetical string sort}
|
||||
begin
|
||||
Result:=AnsiCompareText(string(Item1^),string(Item2^));
|
||||
end;
|
||||
|
||||
function StringRevCompare(Item1, Item2: Pointer): Integer;
|
||||
{Compare for reverse alphabetical order}
|
||||
begin
|
||||
Result:=AnsiCompareText(string(Item2^),string(Item1^));
|
||||
end;
|
||||
|
||||
|
||||
function StringLenCompare(Item1, Item2: Pointer): Integer;
|
||||
{Compare for string length sort}
|
||||
begin
|
||||
Result:=Length(string(Item1^))-Length(string(Item2^));
|
||||
end;
|
||||
|
||||
{Arrays of strings and integers}
|
||||
|
||||
var IA: array [0..9] of integer = (23, 14, 62, 28, 56, 91, 33, 30, 75, 5);
|
||||
var SA: array [0..15] of string = ('Now','is','the','time','for','all','good','men','to','come','to','the','aid','of','the','party.');
|
||||
|
||||
procedure ShowQuickSort(Memo: TMemo);
|
||||
var L: TStringList;
|
||||
var PA: TPointerArray;
|
||||
var I: integer;
|
||||
begin
|
||||
Memo.Lines.Add('Integer Sort');
|
||||
SetLength(PA,Length(IA));
|
||||
for I:=0 to High(IA) do PA[I]:=Pointer(IA[I]);
|
||||
Memo.Lines.Add('Before Sorting');
|
||||
DisplayIntegers(Memo,PA);
|
||||
QuickSort(PA,0,High(PA),IntCompare);
|
||||
Memo.Lines.Add('After Sorting');
|
||||
DisplayIntegers(Memo,PA);
|
||||
|
||||
Memo.Lines.Add('');
|
||||
Memo.Lines.Add('String Sort - Alphabetical');
|
||||
SetLength(PA,Length(SA));
|
||||
for I:=0 to High(SA) do PA[I]:=Pointer(@SA[I]);
|
||||
Memo.Lines.Add('Before Sorting');
|
||||
DisplayStrings(Memo,PA);
|
||||
QuickSort(PA,0,High(PA),StringCompare);
|
||||
Memo.Lines.Add('After Sorting');
|
||||
DisplayStrings(Memo,PA);
|
||||
|
||||
Memo.Lines.Add('');
|
||||
Memo.Lines.Add('String Sort - Reverse Alphabetical');
|
||||
QuickSort(PA,0,High(PA),StringRevCompare);
|
||||
Memo.Lines.Add('After Sorting');
|
||||
DisplayStrings(Memo,PA);
|
||||
|
||||
Memo.Lines.Add('');
|
||||
Memo.Lines.Add('String Sort - By Length');
|
||||
QuickSort(PA,0,High(PA),StringLenCompare);
|
||||
Memo.Lines.Add('After Sorting');
|
||||
DisplayStrings(Memo,PA);
|
||||
end;
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
def quicksort := {
|
||||
|
||||
def swap(container, ixA, ixB) {
|
||||
def temp := container[ixA]
|
||||
container[ixA] := container[ixB]
|
||||
container[ixB] := temp
|
||||
}
|
||||
|
||||
def partition(array, var first :int, var last :int) {
|
||||
if (last <= first) { return }
|
||||
|
||||
# Choose a pivot
|
||||
def pivot := array[def pivotIndex := (first + last) // 2]
|
||||
|
||||
# Move pivot to end temporarily
|
||||
swap(array, pivotIndex, last)
|
||||
|
||||
var swapWith := first
|
||||
|
||||
# Scan array except for pivot, and...
|
||||
for i in first..!last {
|
||||
if (array[i] <= pivot) { # items ≤ the pivot
|
||||
swap(array, i, swapWith) # are moved to consecutive positions on the left
|
||||
swapWith += 1
|
||||
}
|
||||
}
|
||||
|
||||
# Swap pivot into between-partition position.
|
||||
# Because of the swapping we know that everything before swapWith is less
|
||||
# than or equal to the pivot, and the item at swapWith (since it was not
|
||||
# swapped) is greater than the pivot, so inserting the pivot at swapWith
|
||||
# will preserve the partition.
|
||||
swap(array, swapWith, last)
|
||||
return swapWith
|
||||
}
|
||||
|
||||
def quicksortR(array, first :int, last :int) {
|
||||
if (last <= first) { return }
|
||||
def pivot := partition(array, first, last)
|
||||
quicksortR(array, first, pivot - 1)
|
||||
quicksortR(array, pivot + 1, last)
|
||||
}
|
||||
|
||||
def quicksort(array) { # returned from block
|
||||
quicksortR(array, 0, array.size() - 1)
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
PROGRAM QUICKSORT_DEMO
|
||||
|
||||
DIM ARRAY[21]
|
||||
|
||||
!$DYNAMIC
|
||||
DIM QSTACK[0]
|
||||
|
||||
!$INCLUDE="PC.LIB"
|
||||
|
||||
PROCEDURE QSORT(ARRAY[],START,NUM)
|
||||
FIRST=START ! initialize work variables
|
||||
LAST=START+NUM-1
|
||||
LOOP
|
||||
REPEAT
|
||||
TEMP=ARRAY[(LAST+FIRST) DIV 2] ! seek midpoint
|
||||
I=FIRST
|
||||
J=LAST
|
||||
REPEAT ! reverse both < and > below to sort descending
|
||||
WHILE ARRAY[I]<TEMP DO
|
||||
I=I+1
|
||||
END WHILE
|
||||
WHILE ARRAY[J]>TEMP DO
|
||||
J=J-1
|
||||
END WHILE
|
||||
EXIT IF I>J
|
||||
IF I<J THEN SWAP(ARRAY[I],ARRAY[J]) END IF
|
||||
I=I+1
|
||||
J=J-1
|
||||
UNTIL NOT(I<=J)
|
||||
IF I<LAST THEN ! Done
|
||||
QSTACK[SP]=I ! Push I
|
||||
QSTACK[SP+1]=LAST ! Push Last
|
||||
SP=SP+2
|
||||
END IF
|
||||
LAST=J
|
||||
UNTIL NOT(FIRST<LAST)
|
||||
|
||||
EXIT IF SP=0
|
||||
SP=SP-2
|
||||
FIRST=QSTACK[SP] ! Pop First
|
||||
LAST=QSTACK[SP+1] ! Pop Last
|
||||
END LOOP
|
||||
END PROCEDURE
|
||||
|
||||
BEGIN
|
||||
RANDOMIZE(TIMER) ! generate a new series each run
|
||||
|
||||
! create an array
|
||||
FOR X=1 TO 21 DO ! fill with random numbers
|
||||
ARRAY[X]=RND(1)*500 ! between 0 and 500
|
||||
END FOR
|
||||
PRIMO=6 ! sort starting here
|
||||
NUM=10 ! sort this many elements
|
||||
CLS
|
||||
PRINT("Before Sorting:";TAB(31);"After sorting:")
|
||||
PRINT("===============";TAB(31);"==============")
|
||||
FOR X=1 TO 21 DO ! show them before sorting
|
||||
IF X>=PRIMO AND X<=PRIMO+NUM-1 THEN
|
||||
PRINT("==>";)
|
||||
END IF
|
||||
PRINT(TAB(5);)
|
||||
WRITE("###.##";ARRAY[X])
|
||||
END FOR
|
||||
|
||||
! create a stack
|
||||
!$DIM QSTACK[INT(NUM/5)+10]
|
||||
QSORT(ARRAY[],PRIMO,NUM)
|
||||
!$ERASE QSTACK
|
||||
|
||||
LOCATE(2,1)
|
||||
FOR X=1 TO 21 DO ! print them after sorting
|
||||
LOCATE(2+X,30)
|
||||
IF X>=PRIMO AND X<=PRIMO+NUM-1 THEN
|
||||
PRINT("==>";) ! point to sorted items
|
||||
END IF
|
||||
LOCATE(2+X,35)
|
||||
WRITE("###.##";ARRAY[X])
|
||||
END FOR
|
||||
END PROGRAM
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
proc qsort left right . d[] .
|
||||
while left < right
|
||||
# partition
|
||||
piv = d[left]
|
||||
mid = left
|
||||
for i = left + 1 to right
|
||||
if d[i] < piv
|
||||
mid += 1
|
||||
swap d[i] d[mid]
|
||||
.
|
||||
.
|
||||
swap d[left] d[mid]
|
||||
#
|
||||
if mid < (right + left) / 2
|
||||
call qsort left mid - 1 d[]
|
||||
left = mid + 1
|
||||
else
|
||||
call qsort mid + 1 right d[]
|
||||
right = mid - 1
|
||||
.
|
||||
.
|
||||
.
|
||||
func sort . d[] .
|
||||
call qsort 1 len d[] d[]
|
||||
.
|
||||
d[] = [ 29 4 72 44 55 26 27 77 92 5 ]
|
||||
call sort d[]
|
||||
print d[]
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(lib 'list) ;; list-partition
|
||||
|
||||
(define compare 0) ;; counter
|
||||
|
||||
(define (quicksort L compare-predicate: proc aux: (part null))
|
||||
(if (<= (length L) 1) L
|
||||
(begin
|
||||
;; counting the number of comparisons
|
||||
(set! compare (+ compare (length (rest L))))
|
||||
;; pivot = first element of list
|
||||
(set! part (list-partition (rest L) proc (first L)))
|
||||
(append (quicksort (first part) proc )
|
||||
(list (first L))
|
||||
(quicksort (second part) proc)))))
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
(shuffle (iota 15))
|
||||
→ (10 0 14 11 13 9 2 5 4 8 1 7 12 3 6)
|
||||
(quicksort (shuffle (iota 15)) <)
|
||||
→ (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14)
|
||||
|
||||
;; random list of numbers in [0 .. n[
|
||||
;; count number of comparisons
|
||||
(define (qtest (n 10000))
|
||||
(set! compare 0)
|
||||
(quicksort (shuffle (iota n)) >)
|
||||
(writeln 'n n 'compare# compare ))
|
||||
|
||||
(qtest 1000)
|
||||
n 1000 compare# 12764
|
||||
(qtest 10000)
|
||||
n 10000 compare# 277868
|
||||
(qtest 100000)
|
||||
n 100000 compare# 6198601
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
|
||||
void quicksortInPlace(MutableArray array, const long first, const long last)
|
||||
if first >= last
|
||||
return
|
||||
Value pivot = array[(first + last) / 2]
|
||||
left := first
|
||||
right := last
|
||||
while left <= right
|
||||
while array[left] < pivot
|
||||
left++
|
||||
while array[right] > pivot
|
||||
right--
|
||||
if left <= right
|
||||
array.exchangeObjectAtIndex: left++, withObjectAtIndex: right--
|
||||
|
||||
quicksortInPlace(array, first, right)
|
||||
quicksortInPlace(array, left, last)
|
||||
|
||||
Array quicksort(Array unsorted)
|
||||
a := []
|
||||
a.addObjectsFromArray: unsorted
|
||||
quicksortInPlace(a, 0, a.count - 1)
|
||||
return a
|
||||
|
||||
|
||||
int main(int argc, const char * argv[])
|
||||
autoreleasepool
|
||||
a := [1, 3, 5, 7, 9, 8, 6, 4, 2]
|
||||
Log( 'Unsorted: %@', a)
|
||||
Log( 'Sorted: %@', quicksort(a) )
|
||||
b := ['Emil', 'Peg', 'Helen', 'Juergen', 'David', 'Rick', 'Barb', 'Mike', 'Tom']
|
||||
Log( 'Unsorted: %@', b)
|
||||
Log( 'Sorted: %@', quicksort(b) )
|
||||
|
||||
return 0
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
#import <Foundation/Foundation.h>
|
||||
|
||||
implementation Array (Quicksort)
|
||||
|
||||
plus: Array array, return Array =
|
||||
self.arrayByAddingObjectsFromArray: array
|
||||
|
||||
filter: BOOL (^)(id) predicate, return Array
|
||||
array := []
|
||||
for id item in self
|
||||
if predicate(item)
|
||||
array.addObject: item
|
||||
return array.copy
|
||||
|
||||
quicksort, return Array = self
|
||||
if self.count > 1
|
||||
id x = self[self.count / 2]
|
||||
lesser := self.filter: (id y | return y < x)
|
||||
greater := self.filter: (id y | return y > x)
|
||||
return lesser.quicksort + [x] + greater.quicksort
|
||||
|
||||
end
|
||||
|
||||
int main()
|
||||
autoreleasepool
|
||||
a := [1, 3, 5, 7, 9, 8, 6, 4, 2]
|
||||
Log( 'Unsorted: %@', a)
|
||||
Log( 'Sorted: %@', a.quicksort )
|
||||
b := ['Emil', 'Peg', 'Helen', 'Juergen', 'David', 'Rick', 'Barb', 'Mike', 'Tom']
|
||||
Log( 'Unsorted: %@', b)
|
||||
Log( 'Sorted: %@', b.quicksort )
|
||||
|
||||
return 0
|
||||
|
|
@ -0,0 +1 @@
|
|||
QUICKSORT
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
class
|
||||
QUICKSORT [G -> COMPARABLE]
|
||||
|
||||
create
|
||||
make
|
||||
|
||||
feature {NONE} --Implementation
|
||||
|
||||
is_sorted (list: ARRAY [G]): BOOLEAN
|
||||
require
|
||||
not_void: list /= Void
|
||||
local
|
||||
i: INTEGER
|
||||
do
|
||||
Result := True
|
||||
from
|
||||
i := list.lower + 1
|
||||
invariant
|
||||
i >= list.lower + 1 and i <= list.upper + 1
|
||||
until
|
||||
i > list.upper
|
||||
loop
|
||||
Result := Result and list [i - 1] <= list [i]
|
||||
i := i + 1
|
||||
variant
|
||||
list.upper + 1 - i
|
||||
end
|
||||
end
|
||||
|
||||
concatenate_array (a: ARRAY [G] b: ARRAY [G]): ARRAY [G]
|
||||
require
|
||||
not_void: a /= Void and b /= Void
|
||||
do
|
||||
create Result.make_from_array (a)
|
||||
across
|
||||
b as t
|
||||
loop
|
||||
Result.force (t.item, Result.upper + 1)
|
||||
end
|
||||
ensure
|
||||
same_size: a.count + b.count = Result.count
|
||||
end
|
||||
|
||||
quicksort_array (list: ARRAY [G]): ARRAY [G]
|
||||
require
|
||||
not_void: list /= Void
|
||||
local
|
||||
less_a: ARRAY [G]
|
||||
equal_a: ARRAY [G]
|
||||
more_a: ARRAY [G]
|
||||
pivot: G
|
||||
do
|
||||
create less_a.make_empty
|
||||
create more_a.make_empty
|
||||
create equal_a.make_empty
|
||||
create Result.make_empty
|
||||
if list.count <= 1 then
|
||||
Result := list
|
||||
else
|
||||
pivot := list [list.lower]
|
||||
across
|
||||
list as li
|
||||
invariant
|
||||
less_a.count + equal_a.count + more_a.count <= list.count
|
||||
loop
|
||||
if li.item < pivot then
|
||||
less_a.force (li.item, less_a.upper + 1)
|
||||
elseif li.item = pivot then
|
||||
equal_a.force (li.item, equal_a.upper + 1)
|
||||
elseif li.item > pivot then
|
||||
more_a.force (li.item, more_a.upper + 1)
|
||||
end
|
||||
end
|
||||
Result := concatenate_array (Result, quicksort_array (less_a))
|
||||
Result := concatenate_array (Result, equal_a)
|
||||
Result := concatenate_array (Result, quicksort_array (more_a))
|
||||
end
|
||||
ensure
|
||||
same_size: list.count = Result.count
|
||||
sorted: is_sorted (Result)
|
||||
end
|
||||
|
||||
feature -- Initialization
|
||||
|
||||
make
|
||||
do
|
||||
end
|
||||
|
||||
quicksort (a: ARRAY [G]): ARRAY [G]
|
||||
do
|
||||
Result := quicksort_array (a)
|
||||
end
|
||||
|
||||
end
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
class
|
||||
APPLICATION
|
||||
|
||||
create
|
||||
make
|
||||
|
||||
feature {NONE} -- Initialization
|
||||
|
||||
make
|
||||
-- Run application.
|
||||
local
|
||||
test: ARRAY [INTEGER]
|
||||
sorted: ARRAY [INTEGER]
|
||||
sorter: QUICKSORT [INTEGER]
|
||||
do
|
||||
create sorter.make
|
||||
test := <<1, 3, 2, 4, 5, 5, 7, -1>>
|
||||
sorted := sorter.quicksort (test)
|
||||
across
|
||||
sorted as s
|
||||
loop
|
||||
print (s.item)
|
||||
print (" ")
|
||||
end
|
||||
print ("%N")
|
||||
end
|
||||
|
||||
end
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
import extensions;
|
||||
import system'routines;
|
||||
import system'collections;
|
||||
|
||||
extension op
|
||||
{
|
||||
quickSort()
|
||||
{
|
||||
if (self.isEmpty()) { ^ self };
|
||||
|
||||
var pivot := self[0];
|
||||
|
||||
auto less := new ArrayList();
|
||||
auto pivotList := new ArrayList();
|
||||
auto more := new ArrayList();
|
||||
|
||||
self.forEach:(item)
|
||||
{
|
||||
if (item < pivot)
|
||||
{
|
||||
less.append(item)
|
||||
}
|
||||
else if (item > pivot)
|
||||
{
|
||||
more.append(item)
|
||||
}
|
||||
else
|
||||
{
|
||||
pivotList.append(item)
|
||||
}
|
||||
};
|
||||
|
||||
less := less.quickSort();
|
||||
more := more.quickSort();
|
||||
|
||||
less.appendRange(pivotList);
|
||||
less.appendRange(more);
|
||||
|
||||
^ less
|
||||
}
|
||||
}
|
||||
|
||||
public program()
|
||||
{
|
||||
var list := new int[]{3, 14, 1, 5, 9, 2, 6, 3};
|
||||
|
||||
console.printLine("before:", list.asEnumerable());
|
||||
console.printLine("after :", list.quickSort().asEnumerable());
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
defmodule Sort do
|
||||
def qsort([]), do: []
|
||||
def qsort([h | t]) do
|
||||
{lesser, greater} = Enum.split_with(t, &(&1 < h))
|
||||
qsort(lesser) ++ [h] ++ qsort(greater)
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(require 'seq)
|
||||
|
||||
(defun quicksort (xs)
|
||||
(if (null xs)
|
||||
()
|
||||
(let* ((head (car xs))
|
||||
(tail (cdr xs))
|
||||
(lower-part (quicksort (seq-filter (lambda (x) (<= x head)) tail)))
|
||||
(higher-part (quicksort (seq-filter (lambda (x) (> x head)) tail))))
|
||||
(append lower-part (list head) higher-part))))
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
-module( quicksort ).
|
||||
|
||||
-export( [qsort/1] ).
|
||||
|
||||
qsort([]) -> [];
|
||||
qsort([X|Xs]) ->
|
||||
qsort([ Y || Y <- Xs, Y < X]) ++ [X] ++ qsort([ Y || Y <- Xs, Y >= X]).
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
quick_sort(L) -> qs(L, trunc(math:log2(erlang:system_info(schedulers)))).
|
||||
|
||||
qs([],_) -> [];
|
||||
qs([H|T], N) when N > 0 ->
|
||||
{Parent, Ref} = {self(), make_ref()},
|
||||
spawn(fun()-> Parent ! {l1, Ref, qs([E||E<-T, E<H], N-1)} end),
|
||||
spawn(fun()-> Parent ! {l2, Ref, qs([E||E<-T, H =< E], N-1)} end),
|
||||
{L1, L2} = receive_results(Ref, undefined, undefined),
|
||||
L1 ++ [H] ++ L2;
|
||||
qs([H|T],_) ->
|
||||
qs([E||E<-T, E<H],0) ++ [H] ++ qs([E||E<-T, H =< E],0).
|
||||
|
||||
receive_results(Ref, L1, L2) ->
|
||||
receive
|
||||
{l1, Ref, L1R} when L2 == undefined -> receive_results(Ref, L1R, L2);
|
||||
{l2, Ref, L2R} when L1 == undefined -> receive_results(Ref, L1, L2R);
|
||||
{l1, Ref, L1R} -> {L1R, L2};
|
||||
{l2, Ref, L2R} -> {L1, L2R}
|
||||
after 5000 -> receive_results(Ref, L1, L2)
|
||||
end.
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
let rec qsort = function
|
||||
hd :: tl ->
|
||||
let less, greater = List.partition ((>=) hd) tl
|
||||
List.concat [qsort less; [hd]; qsort greater]
|
||||
| _ -> []
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
: qsort ( seq -- seq )
|
||||
dup empty? [
|
||||
unclip [ [ < ] curry partition [ qsort ] bi@ ] keep
|
||||
prefix append
|
||||
] unless ;
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
; utility for list joining
|
||||
(= join (fn (a b)
|
||||
(if (is a nil) b (is b nil) a (do
|
||||
(let res a)
|
||||
(while (cdr a) (= a (cdr a)))
|
||||
(setcdr a b)
|
||||
res))))
|
||||
|
||||
(= quicksort (fn (lst)
|
||||
(if (not (cdr lst)) lst (do
|
||||
(let pivot (car lst))
|
||||
(let less nil)
|
||||
(let equal nil)
|
||||
(let greater nil)
|
||||
; filter list for less than pivot, equal to pivot and greater than pivot
|
||||
(while lst
|
||||
(let x (car lst))
|
||||
(if (< x pivot) (= less (cons x less))
|
||||
(< pivot x) (= greater (cons x greater))
|
||||
(= equal (cons x equal)))
|
||||
(= lst (cdr lst)))
|
||||
; sort 'less' and 'greater' partitions ('equal' partition is always sorted)
|
||||
(= less (quicksort less))
|
||||
(= greater (quicksort greater))
|
||||
; join partitions to one
|
||||
(join less (join equal greater))))))
|
||||
|
||||
(print '(4 65 0 2 -31 99 2 0 83 782 1))
|
||||
(print (quicksort '(4 65 0 2 -31 99 2 0 83 782 1)))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
(4 65 0 2 -31 99 2 0 83 782 1)
|
||||
(-31 0 0 1 2 2 4 65 83 99 782)
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
# (sort xs) is the ordered list of all elements in list xs.
|
||||
# This version preserves duplicates.
|
||||
\sort==
|
||||
(\xs
|
||||
xs [] \x\xs
|
||||
append (sort; filter (gt x) xs); # all the items less than x
|
||||
cons x; append (filter (eq x) xs); # all the items equal to x
|
||||
sort; filter (lt x) xs # all the items greater than x
|
||||
)
|
||||
|
||||
# (unique xs) is the ordered list of unique elements in list xs.
|
||||
\unique==
|
||||
(\xs
|
||||
xs [] \x\xs
|
||||
append (unique; filter (gt x) xs); # all the items less than x
|
||||
cons x; # x itself
|
||||
unique; filter (lt x) xs # all the items greater than x
|
||||
)
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
: mid ( l r -- mid ) over - 2/ -cell and + ;
|
||||
|
||||
: exch ( addr1 addr2 -- ) dup @ >r over @ swap ! r> swap ! ;
|
||||
|
||||
: partition ( l r -- l r r2 l2 )
|
||||
2dup mid @ >r ( r: pivot )
|
||||
2dup begin
|
||||
swap begin dup @ r@ < while cell+ repeat
|
||||
swap begin r@ over @ < while cell- repeat
|
||||
2dup <= if 2dup exch >r cell+ r> cell- then
|
||||
2dup > until r> drop ;
|
||||
|
||||
: qsort ( l r -- )
|
||||
partition swap rot
|
||||
\ 2over 2over - + < if 2swap then
|
||||
2dup < if recurse else 2drop then
|
||||
2dup < if recurse else 2drop then ;
|
||||
|
||||
: sort ( array len -- )
|
||||
dup 2 < if 2drop exit then
|
||||
1- cells over + qsort ;
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
MODULE qsort_mod
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
TYPE group
|
||||
INTEGER :: order ! original order of unsorted data
|
||||
REAL :: VALUE ! values to be sorted by
|
||||
END TYPE group
|
||||
|
||||
CONTAINS
|
||||
|
||||
RECURSIVE SUBROUTINE QSort(a,na)
|
||||
|
||||
! DUMMY ARGUMENTS
|
||||
INTEGER, INTENT(in) :: nA
|
||||
TYPE (group), DIMENSION(nA), INTENT(in out) :: A
|
||||
|
||||
! LOCAL VARIABLES
|
||||
INTEGER :: left, right
|
||||
REAL :: random
|
||||
REAL :: pivot
|
||||
TYPE (group) :: temp
|
||||
INTEGER :: marker
|
||||
|
||||
IF (nA > 1) THEN
|
||||
|
||||
CALL random_NUMBER(random)
|
||||
pivot = A(INT(random*REAL(nA-1))+1)%VALUE ! Choice a random pivot (not best performance, but avoids worst-case)
|
||||
left = 1
|
||||
right = nA
|
||||
! Partition loop
|
||||
DO
|
||||
IF (left >= right) EXIT
|
||||
DO
|
||||
IF (A(right)%VALUE <= pivot) EXIT
|
||||
right = right - 1
|
||||
END DO
|
||||
DO
|
||||
IF (A(left)%VALUE >= pivot) EXIT
|
||||
left = left + 1
|
||||
END DO
|
||||
IF (left < right) THEN
|
||||
temp = A(left)
|
||||
A(left) = A(right)
|
||||
A(right) = temp
|
||||
END IF
|
||||
END DO
|
||||
|
||||
IF (left == right) THEN
|
||||
marker = left + 1
|
||||
ELSE
|
||||
marker = left
|
||||
END IF
|
||||
|
||||
CALL QSort(A(:marker-1),marker-1)
|
||||
CALL QSort(A(marker:),nA-marker+1)
|
||||
|
||||
END IF
|
||||
|
||||
END SUBROUTINE QSort
|
||||
|
||||
END MODULE qsort_mod
|
||||
|
||||
! Test Qsort Module
|
||||
PROGRAM qsort_test
|
||||
USE qsort_mod
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER, PARAMETER :: nl = 10, nc = 5, l = nc*nl, ns=33
|
||||
TYPE (group), DIMENSION(l) :: A
|
||||
INTEGER, DIMENSION(ns) :: seed
|
||||
INTEGER :: i
|
||||
REAL :: random
|
||||
CHARACTER(LEN=80) :: fmt1, fmt2
|
||||
! Using the Fibonacci sequence to initialize seed:
|
||||
seed(1) = 1 ; seed(2) = 1
|
||||
DO i = 3,ns
|
||||
seed(i) = seed(i-1)+seed(i-2)
|
||||
END DO
|
||||
! Formats of the outputs
|
||||
WRITE(fmt1,'(A,I2,A)') '(', nc, '(I5,2X,F6.2))'
|
||||
WRITE(fmt2,'(A,I2,A)') '(3x', nc, '("Ord. Num.",3x))'
|
||||
PRINT *, "Unsorted Values:"
|
||||
PRINT fmt2,
|
||||
CALL random_SEED(put = seed)
|
||||
DO i = 1, l
|
||||
CALL random_NUMBER(random)
|
||||
A(i)%VALUE = NINT(1000*random)/10.0
|
||||
A(i)%order = i
|
||||
IF (MOD(i,nc) == 0) WRITE (*,fmt1) A(i-nc+1:i)
|
||||
END DO
|
||||
PRINT *
|
||||
CALL QSort(A,l)
|
||||
PRINT *, "Sorted Values:"
|
||||
PRINT fmt2,
|
||||
DO i = nc, l, nc
|
||||
IF (MOD(i,nc) == 0) WRITE (*,fmt1) A(i-nc+1:i)
|
||||
END DO
|
||||
STOP
|
||||
END PROGRAM qsort_test
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
' version 23-10-2016
|
||||
' compile with: fbc -s console
|
||||
|
||||
' sort from lower bound to the highter bound
|
||||
' array's can have subscript range from -2147483648 to +2147483647
|
||||
|
||||
Sub quicksort(qs() As Long, l As Long, r As Long)
|
||||
|
||||
Dim As ULong size = r - l +1
|
||||
If size < 2 Then Exit Sub
|
||||
|
||||
Dim As Long i = l, j = r
|
||||
Dim As Long pivot = qs(l + size \ 2)
|
||||
|
||||
Do
|
||||
While qs(i) < pivot
|
||||
i += 1
|
||||
Wend
|
||||
While pivot < qs(j)
|
||||
j -= 1
|
||||
Wend
|
||||
If i <= j Then
|
||||
Swap qs(i), qs(j)
|
||||
i += 1
|
||||
j -= 1
|
||||
End If
|
||||
Loop Until i > j
|
||||
|
||||
If l < j Then quicksort(qs(), l, j)
|
||||
If i < r Then quicksort(qs(), i, r)
|
||||
|
||||
End Sub
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As Long i, array(-7 To 7)
|
||||
Dim As Long a = LBound(array), b = UBound(array)
|
||||
|
||||
Randomize Timer
|
||||
For i = a To b : array(i) = i : Next
|
||||
For i = a To b ' little shuffle
|
||||
Swap array(i), array(Int(Rnd * (b - a +1)) + a)
|
||||
Next
|
||||
|
||||
Print "unsorted ";
|
||||
For i = a To b : Print Using "####"; array(i); : Next : Print
|
||||
|
||||
quicksort(array(), LBound(array), UBound(array))
|
||||
|
||||
Print " sorted ";
|
||||
For i = a To b : Print Using "####"; array(i); : Next : Print
|
||||
|
||||
' empty keyboard buffer
|
||||
While Inkey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
def
|
||||
qsort( [] ) = []
|
||||
qsort( p:xs ) = qsort( xs.filter((< p)) ) + [p] + qsort( xs.filter((>= p)) )
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
def
|
||||
qsort( [] ) = []
|
||||
qsort( x:xs ) =
|
||||
val (ys, zs) = xs.partition( (< x) )
|
||||
qsort( ys ) + (x : qsort( zs ))
|
||||
|
||||
println( qsort([4, 2, 1, 3, 0, 2]) )
|
||||
println( qsort(["Juan", "Daniel", "Miguel", "William", "Liam", "Ethan", "Jacob"]) )
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
include "NSLog.incl"
|
||||
|
||||
local fn Quicksort( qs as CFMutableArrayRef, l as NSInteger, r as NSInteger )
|
||||
UInt64 size = r - l + 1
|
||||
|
||||
if size < 2 then exit fn
|
||||
|
||||
NSinteger i = l, j = r
|
||||
NSinteger pivot = fn NumberIntegerValue( qs[l+size / 2] )
|
||||
|
||||
do
|
||||
while fn NumberIntegerValue( qs[i] ) < pivot
|
||||
i++
|
||||
wend
|
||||
while pivot < fn NumberIntegerValue( qs[j] )
|
||||
j--
|
||||
wend
|
||||
if ( i <= j )
|
||||
MutableArrayExchangeObjects( qs, i, j )
|
||||
i++
|
||||
j--
|
||||
end if
|
||||
until i > j
|
||||
|
||||
if l < j then fn Quicksort( qs, l, j )
|
||||
if i < r then fn Quicksort( qs, i, r )
|
||||
end fn
|
||||
|
||||
CFMutableArrayRef qs
|
||||
CFArrayRef unsorted
|
||||
NSUInteger i, amount
|
||||
|
||||
qs = fn MutableArrayWithCapacity(0)
|
||||
|
||||
for i = 0 to 25
|
||||
if i mod 2 == 0 then amount = 100 else amount = 10000
|
||||
MutableArrayInsertObjectAtIndex( qs, fn NumberWithInteger( rnd(amount) ), i )
|
||||
next
|
||||
|
||||
unsorted = fn ArrayWithArray( qs )
|
||||
|
||||
fn QuickSort( qs, 0, len(qs) - 1 )
|
||||
|
||||
NSLog( @"\n-----------------\nUnsorted : Sorted\n-----------------" )
|
||||
for i = 0 to 25
|
||||
NSLog( @"%8ld : %-8ld", fn NumberIntegerValue( unsorted[i] ), fn NumberIntegerValue( qs[i] ) )
|
||||
next
|
||||
|
||||
randomize
|
||||
|
||||
HandleEvents
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
package main
|
||||
|
||||
import "fmt"
|
||||
|
||||
func main() {
|
||||
list := []int{31, 41, 59, 26, 53, 58, 97, 93, 23, 84}
|
||||
fmt.Println("unsorted:", list)
|
||||
|
||||
quicksort(list)
|
||||
fmt.Println("sorted! ", list)
|
||||
}
|
||||
|
||||
func quicksort(a []int) {
|
||||
var pex func(int, int)
|
||||
pex = func(lower, upper int) {
|
||||
for {
|
||||
switch upper - lower {
|
||||
case -1, 0: // 0 or 1 item in segment. nothing to do here!
|
||||
return
|
||||
case 1: // 2 items in segment
|
||||
// < operator respects strict weak order
|
||||
if a[upper] < a[lower] {
|
||||
// a quick exchange and we're done.
|
||||
a[upper], a[lower] = a[lower], a[upper]
|
||||
}
|
||||
return
|
||||
// Hoare suggests optimized sort-3 or sort-4 algorithms here,
|
||||
// but does not provide an algorithm.
|
||||
}
|
||||
|
||||
// Hoare stresses picking a bound in a way to avoid worst case
|
||||
// behavior, but offers no suggestions other than picking a
|
||||
// random element. A function call to get a random number is
|
||||
// relatively expensive, so the method used here is to simply
|
||||
// choose the middle element. This at least avoids worst case
|
||||
// behavior for the obvious common case of an already sorted list.
|
||||
bx := (upper + lower) / 2
|
||||
b := a[bx] // b = Hoare's "bound" (aka "pivot")
|
||||
lp := lower // lp = Hoare's "lower pointer"
|
||||
up := upper // up = Hoare's "upper pointer"
|
||||
outer:
|
||||
for {
|
||||
// use < operator to respect strict weak order
|
||||
for lp < upper && !(b < a[lp]) {
|
||||
lp++
|
||||
}
|
||||
for {
|
||||
if lp > up {
|
||||
// "pointers crossed!"
|
||||
break outer
|
||||
}
|
||||
// < operator for strict weak order
|
||||
if a[up] < b {
|
||||
break // inner
|
||||
}
|
||||
up--
|
||||
}
|
||||
// exchange
|
||||
a[lp], a[up] = a[up], a[lp]
|
||||
lp++
|
||||
up--
|
||||
}
|
||||
// segment boundary is between up and lp, but lp-up might be
|
||||
// 1 or 2, so just call segment boundary between lp-1 and lp.
|
||||
if bx < lp {
|
||||
// bound was in lower segment
|
||||
if bx < lp-1 {
|
||||
// exchange bx with lp-1
|
||||
a[bx], a[lp-1] = a[lp-1], b
|
||||
}
|
||||
up = lp - 2
|
||||
} else {
|
||||
// bound was in upper segment
|
||||
if bx > lp {
|
||||
// exchange
|
||||
a[bx], a[lp] = a[lp], b
|
||||
}
|
||||
up = lp - 1
|
||||
lp++
|
||||
}
|
||||
// "postpone the larger of the two segments" = recurse on
|
||||
// the smaller segment, then iterate on the remaining one.
|
||||
if up-lower < upper-lp {
|
||||
pex(lower, up)
|
||||
lower = lp
|
||||
} else {
|
||||
pex(lp, upper)
|
||||
upper = up
|
||||
}
|
||||
}
|
||||
}
|
||||
pex(0, len(a)-1)
|
||||
}
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"sort"
|
||||
"math/rand"
|
||||
)
|
||||
|
||||
func partition(a sort.Interface, first int, last int, pivotIndex int) int {
|
||||
a.Swap(first, pivotIndex) // move it to beginning
|
||||
left := first+1
|
||||
right := last
|
||||
for left <= right {
|
||||
for left <= last && a.Less(left, first) {
|
||||
left++
|
||||
}
|
||||
for right >= first && a.Less(first, right) {
|
||||
right--
|
||||
}
|
||||
if left <= right {
|
||||
a.Swap(left, right)
|
||||
left++
|
||||
right--
|
||||
}
|
||||
}
|
||||
a.Swap(first, right) // swap into right place
|
||||
return right
|
||||
}
|
||||
|
||||
func quicksortHelper(a sort.Interface, first int, last int) {
|
||||
if first >= last {
|
||||
return
|
||||
}
|
||||
pivotIndex := partition(a, first, last, rand.Intn(last - first + 1) + first)
|
||||
quicksortHelper(a, first, pivotIndex-1)
|
||||
quicksortHelper(a, pivotIndex+1, last)
|
||||
}
|
||||
|
||||
func quicksort(a sort.Interface) {
|
||||
quicksortHelper(a, 0, a.Len()-1)
|
||||
}
|
||||
|
||||
func main() {
|
||||
a := []int{1, 3, 5, 7, 9, 8, 6, 4, 2}
|
||||
fmt.Printf("Unsorted: %v\n", a)
|
||||
quicksort(sort.IntSlice(a))
|
||||
fmt.Printf("Sorted: %v\n", a)
|
||||
b := []string{"Emil", "Peg", "Helen", "Juergen", "David", "Rick", "Barb", "Mike", "Tom"}
|
||||
fmt.Printf("Unsorted: %v\n", b)
|
||||
quicksort(sort.StringSlice(b))
|
||||
fmt.Printf("Sorted: %v\n", b)
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
qsort [] = []
|
||||
qsort (x:xs) = qsort [y | y <- xs, y < x] ++ [x] ++ qsort [y | y <- xs, y >= x]
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
import Data.List (partition)
|
||||
|
||||
qsort :: Ord a => [a] -> [a]
|
||||
qsort [] = []
|
||||
qsort (x:xs) = qsort ys ++ [x] ++ qsort zs where
|
||||
(ys, zs) = partition (< x) xs
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
function qs, arr
|
||||
if (count = n_elements(arr)) lt 2 then return,arr
|
||||
pivot = total(arr) / count ; use the average for want of a better choice
|
||||
return,[qs(arr[where(arr le pivot)]),qs(arr[where(arr gt pivot)])]
|
||||
end
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
100 PROGRAM "QuickSrt.bas"
|
||||
110 RANDOMIZE
|
||||
120 NUMERIC A(5 TO 19)
|
||||
130 CALL INIT(A)
|
||||
140 CALL WRITE(A)
|
||||
150 CALL QSORT(LBOUND(A),UBOUND(A))
|
||||
160 CALL WRITE(A)
|
||||
170 DEF INIT(REF A)
|
||||
180 FOR I=LBOUND(A) TO UBOUND(A)
|
||||
190 LET A(I)=RND(98)+1
|
||||
200 NEXT
|
||||
210 END DEF
|
||||
220 DEF WRITE(REF A)
|
||||
230 FOR I=LBOUND(A) TO UBOUND(A)
|
||||
240 PRINT A(I);
|
||||
250 NEXT
|
||||
260 PRINT
|
||||
270 END DEF
|
||||
280 DEF QSORT(AH,FH)
|
||||
290 NUMERIC E
|
||||
300 LET E=AH:LET U=FH:LET K=A(E)
|
||||
310 DO UNTIL E=U
|
||||
320 DO UNTIL E=U OR A(U)<K
|
||||
330 LET U=U-1
|
||||
340 LOOP
|
||||
350 IF E<U THEN
|
||||
360 LET A(E)=A(U):LET E=E+1
|
||||
370 DO UNTIL E=U OR A(E)>K
|
||||
380 LET E=E+1
|
||||
390 LOOP
|
||||
400 IF E<U THEN LET A(U)=A(E):LET U=U-1
|
||||
410 END IF
|
||||
420 LOOP
|
||||
430 LET A(E)=K
|
||||
440 IF AH<E-1 THEN CALL QSORT(AH,E-1)
|
||||
450 IF E+1<FH THEN CALL QSORT(E+1,FH)
|
||||
460 END DEF
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
procedure main() #: demonstrate various ways to sort a list and string
|
||||
demosort(quicksort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
|
||||
end
|
||||
|
||||
procedure quicksort(X,op,lower,upper) #: return sorted list
|
||||
local pivot,x
|
||||
|
||||
if /lower := 1 then { # top level call setup
|
||||
upper := *X
|
||||
op := sortop(op,X) # select how and what we sort
|
||||
}
|
||||
|
||||
if upper - lower > 0 then {
|
||||
every x := quickpartition(X,op,lower,upper) do # find a pivot and sort ...
|
||||
/pivot | X := x # ... how to return 2 values w/o a structure
|
||||
X := quicksort(X,op,lower,pivot-1) # ... left
|
||||
X := quicksort(X,op,pivot,upper) # ... right
|
||||
}
|
||||
|
||||
return X
|
||||
end
|
||||
|
||||
procedure quickpartition(X,op,lower,upper) #: quicksort partitioner helper
|
||||
local pivot
|
||||
static pivotL
|
||||
initial pivotL := list(3)
|
||||
|
||||
pivotL[1] := X[lower] # endpoints
|
||||
pivotL[2] := X[upper] # ... and
|
||||
pivotL[3] := X[lower+?(upper-lower)] # ... random midpoint
|
||||
if op(pivotL[2],pivotL[1]) then pivotL[2] :=: pivotL[1] # mini-
|
||||
if op(pivotL[3],pivotL[2]) then pivotL[3] :=: pivotL[2] # ... sort
|
||||
pivot := pivotL[2] # median is pivot
|
||||
|
||||
lower -:= 1
|
||||
upper +:= 1
|
||||
while lower < upper do { # find values on wrong side of pivot ...
|
||||
while op(pivot,X[upper -:= 1]) # ... rightmost
|
||||
while op(X[lower +:=1],pivot) # ... leftmost
|
||||
if lower < upper then # not crossed yet
|
||||
X[lower] :=: X[upper] # ... swap
|
||||
}
|
||||
|
||||
suspend lower # 1st return pivot point
|
||||
suspend X # 2nd return modified X (in case immutable)
|
||||
end
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
quicksort : Ord elem => List elem -> List elem
|
||||
quicksort [] = []
|
||||
quicksort (x :: xs) =
|
||||
let lesser = filter (< x) xs
|
||||
greater = filter(>= x) xs in
|
||||
(quicksort lesser) ++ [x] ++ (quicksort greater)
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
List do(
|
||||
quickSort := method(
|
||||
if(size > 1) then(
|
||||
pivot := at(size / 2 floor)
|
||||
return select(x, x < pivot) quickSort appendSeq(
|
||||
select(x, x == pivot) appendSeq(select(x, x > pivot) quickSort)
|
||||
)
|
||||
) else(return self)
|
||||
)
|
||||
|
||||
quickSortInPlace := method(
|
||||
copy(quickSort)
|
||||
)
|
||||
)
|
||||
|
||||
lst := list(5, -1, -4, 2, 9)
|
||||
lst quickSort println # ==> list(-4, -1, 2, 5, 9)
|
||||
lst quickSortInPlace println # ==> list(-4, -1, 2, 5, 9)
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue