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
5
Task/Sorting-algorithms-Bead-sort/00-META.yaml
Normal file
5
Task/Sorting-algorithms-Bead-sort/00-META.yaml
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
---
|
||||
category:
|
||||
- Sorting
|
||||
from: http://rosettacode.org/wiki/Sorting_algorithms/Bead_sort
|
||||
note: Sorting Algorithms
|
||||
13
Task/Sorting-algorithms-Bead-sort/00-TASK.txt
Normal file
13
Task/Sorting-algorithms-Bead-sort/00-TASK.txt
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
{{Sorting Algorithm}}
|
||||
|
||||
;Task:
|
||||
Sort an array of positive integers using the [[wp:Bead_sort|Bead Sort Algorithm]].
|
||||
|
||||
A ''bead sort'' is also known as a ''gravity sort''.
|
||||
|
||||
|
||||
Algorithm has O(S), where S is the sum of the integers in the input set: Each bead is moved individually.
|
||||
|
||||
This is the case when bead sort is implemented without a mechanism to assist in finding empty spaces below the beads, such as in software implementations.
|
||||
<br><br>
|
||||
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
F bead_sort(&a)
|
||||
V maxv = max(a)
|
||||
V beads = [0] * (maxv * a.len)
|
||||
|
||||
L(i) 0 .< a.len
|
||||
L(j) 0 .< a[i]
|
||||
beads[i * maxv + j] = 1
|
||||
|
||||
L(j) 0 .< maxv
|
||||
V sum = 0
|
||||
L(i) 0 .< a.len
|
||||
sum += beads[i * maxv + j]
|
||||
beads[i * maxv + j] = 0
|
||||
|
||||
L(i) a.len - sum .< a.len
|
||||
beads[i * maxv + j] = 1
|
||||
|
||||
L(i) 0 .< a.len
|
||||
V j = 0
|
||||
L j < maxv & beads[i * maxv + j] > 0
|
||||
j++
|
||||
a[i] = j
|
||||
|
||||
V a = [5, 3, 1, 7, 4, 1, 1, 20]
|
||||
bead_sort(&a)
|
||||
print(a)
|
||||
|
|
@ -0,0 +1,99 @@
|
|||
* Bead Sort 11/05/2016
|
||||
BEADSORT CSECT
|
||||
USING BEADSORT,R13 base register
|
||||
SAVEAR B STM-SAVEAR(R15) skip savearea
|
||||
DC 17F'0' savearea
|
||||
STM STM R14,R12,12(R13) prolog
|
||||
ST R13,4(R15) "
|
||||
ST R15,8(R13) "
|
||||
LR R13,R15 "
|
||||
LA R6,1 i=1
|
||||
LOOPI1 CH R6,=AL2(N) do i=1 to hbound(z)
|
||||
BH ELOOPI1 leave i
|
||||
LR R1,R6 i
|
||||
SLA R1,1 <<1
|
||||
LH R2,Z-2(R1) z(i)
|
||||
CH R2,LO if z(i)<lo
|
||||
BNL EIHO then
|
||||
STH R2,LO lo=z(i)
|
||||
EIHLO CH R2,HI if z(i)>hi
|
||||
BNH EIHHI then
|
||||
STH R2,HI hi=z(i)
|
||||
EIHHI LA R6,1(R6) iterate i
|
||||
B LOOPI1 next i
|
||||
ELOOPI1 LA R9,1 1
|
||||
SH R9,LO -lo+1
|
||||
LA R6,1 i=1
|
||||
LOOPI2 CH R6,=AL2(N) do i=1 to hbound(z)
|
||||
BH ELOOPI2 leave i
|
||||
LR R1,R6 i
|
||||
SLA R1,1 <<1
|
||||
LH R3,Z-2(R1) z(i)
|
||||
AR R3,R9 z(i)+o
|
||||
IC R2,BEADS-1(R3) beads(l)
|
||||
LA R2,1(R2) beads(l)+1
|
||||
STC R2,BEADS-1(R3) beads(l)=beads(l)+1
|
||||
LA R6,1(R6) iterate i
|
||||
B LOOPI2 next i
|
||||
ELOOPI2 SR R8,R8 k=0
|
||||
LH R6,LO i=lo
|
||||
LOOPI3 CH R6,HI do i=lo to hi
|
||||
BH ELOOPI3 leave i
|
||||
LA R7,1 j=1
|
||||
SR R10,R10 clear r10
|
||||
LR R1,R6 i
|
||||
AR R1,R9 i+o
|
||||
IC R10,BEADS-1(R1) beads(i+o)
|
||||
LOOPJ3 CR R7,R10 do j=1 to beads(i+o)
|
||||
BH ELOOPJ3 leave j
|
||||
LA R8,1(R8) k=k+1
|
||||
LR R1,R8 k
|
||||
SLA R1,1 <<1
|
||||
STH R6,S-2(R1) s(k)=i
|
||||
LA R7,1(R7) iterate j
|
||||
B LOOPJ3 next j
|
||||
ELOOPJ3 AH R6,=H'1' iterate i
|
||||
B LOOPI3 next i
|
||||
ELOOPI3 LA R7,1 j=1
|
||||
LOOPJ4 CH R7,=H'2' do j=1 to 2
|
||||
BH ELOOPJ4 leave j
|
||||
CH R7,=H'1' if j<>1
|
||||
BE ONE then
|
||||
MVC PG(7),=C'sorted:' zap
|
||||
ONE LA R10,PG+7 pgi=@pg+7
|
||||
LA R6,1 i=1
|
||||
LOOPI4 CH R6,=AL2(N) do i=1 to hbound(z)
|
||||
BH ELOOPI4 leave i
|
||||
CH R7,=H'1' if j=1
|
||||
BNE TWO then
|
||||
LR R1,R6 i
|
||||
SLA R1,1 <<1
|
||||
LH R11,Z-2(R1) zs=z(i)
|
||||
B XDECO else
|
||||
TWO LR R1,R6 i
|
||||
SLA R1,1 <<1
|
||||
LH R11,S-2(R1) zs=s(i)
|
||||
XDECO XDECO R11,XDEC edit zs
|
||||
MVC 0(6,R10),XDEC+6 output zs
|
||||
LA R10,6(R10) pgi=pgi+6
|
||||
LA R6,1(R6) iterate i
|
||||
B LOOPI4 next i
|
||||
ELOOPI4 XPRNT PG,80 print buffer
|
||||
LA R7,1(R7) iterate j
|
||||
B LOOPJ4 next j
|
||||
ELOOPJ4 L R13,4(0,R13) epilog
|
||||
LM R14,R12,12(R13) "
|
||||
XR R15,R15 "
|
||||
BR R14 "
|
||||
LTORG literal table
|
||||
N EQU (S-Z)/2 number of items
|
||||
Z DC H'5',H'3',H'1',H'7',H'-1',H'4',H'9',H'-12'
|
||||
DC H'2001',H'-2010',H'17',H'0'
|
||||
S DS (N)H s same size as z
|
||||
LO DC H'32767' 2**31-1
|
||||
HI DC H'-32768' -2**31
|
||||
PG DC CL80' raw:' buffer
|
||||
XDEC DS CL12 temp
|
||||
BEADS DC 4096X'00' beads
|
||||
YREGS
|
||||
END BEADSORT
|
||||
|
|
@ -0,0 +1,234 @@
|
|||
/* ARM assembly AARCH64 Raspberry PI 3B */
|
||||
/* program beadSort64.s */
|
||||
/* En français tri par gravité ou tri par bille (ne pas confondre
|
||||
avec tri par bulle (bubble sort)) */
|
||||
|
||||
/*******************************************/
|
||||
/* 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
|
||||
TableNumber: .quad 10,9,8,7,6,5,4,3,2,1
|
||||
.equ NBELEMENTS, (. - TableNumber) / 8
|
||||
//.equ NBELEMENTS, 4 // for others tests
|
||||
/*********************************/
|
||||
/* UnInitialized data */
|
||||
/*********************************/
|
||||
.bss
|
||||
sZoneConv: .skip 24
|
||||
/*********************************/
|
||||
/* code section */
|
||||
/*********************************/
|
||||
.text
|
||||
.global main
|
||||
main: // entry of program
|
||||
|
||||
1:
|
||||
ldr x0,qAdrTableNumber // address number table
|
||||
mov x1,#NBELEMENTS // number of élements
|
||||
bl beadSort
|
||||
ldr x0,qAdrTableNumber // address number table
|
||||
mov x1,#NBELEMENTS // number of élements
|
||||
bl displayTable
|
||||
|
||||
ldr x0,qAdrTableNumber // address number table
|
||||
mov x1,#NBELEMENTS // number of élements
|
||||
bl isSorted // control sort
|
||||
cmp x0,#1 // sorted ?
|
||||
beq 2f
|
||||
ldr x0,qAdrszMessSortNok // no !! error sort
|
||||
bl affichageMess
|
||||
b 100f
|
||||
2: // 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
|
||||
|
||||
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] // load A[0]
|
||||
1:
|
||||
add x2,x2,#1
|
||||
cmp x2,x1 // end ?
|
||||
bge 99f
|
||||
ldr x3,[x0,x2, lsl #3] // load A[i]
|
||||
cmp x3,x4 // compare A[i],A[i-1]
|
||||
blt 98f // smaller -> error -> return
|
||||
mov x4,x3 // no -> A[i-1] = A[i]
|
||||
b 1b // and loop
|
||||
98:
|
||||
mov x0,#0 // error
|
||||
b 100f
|
||||
99:
|
||||
mov x0,#1 // ok -> return
|
||||
100:
|
||||
ldp x2,x3,[sp],16 // restaur 2 registers
|
||||
ldp x1,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
/******************************************************************/
|
||||
/* bead sort */
|
||||
/******************************************************************/
|
||||
/* x0 contains the address of table */
|
||||
/* x1 contains the number of element */
|
||||
/* Caution registers x2-x12 are not saved */
|
||||
beadSort:
|
||||
stp x1,lr,[sp,-16]! // save registers
|
||||
mov x12,x1 // save elements number
|
||||
//search max
|
||||
ldr x10,[x0] // load value A[0] in max
|
||||
mov x4,#1
|
||||
1: // loop search max
|
||||
cmp x4,x12 // end ?
|
||||
bge 21f // yes
|
||||
ldr x2,[x0,x4,lsl #3] // load value A[i]
|
||||
cmp x2,x10 // compare with max
|
||||
csel x10,x2,x10,gt // if greather
|
||||
add x4,x4,#1
|
||||
b 1b // loop
|
||||
21:
|
||||
mul x5,x10,x12 // max * elements number
|
||||
lsl x5,x5,#3 // 8 bytes for each number
|
||||
sub sp,sp,x5 // allocate on the stack
|
||||
mov fp,sp // frame pointer = stack address
|
||||
// marks beads
|
||||
mov x3,x0 // save table address
|
||||
mov x0,#0 // start index x
|
||||
2:
|
||||
mov x1,#0 // index y
|
||||
ldr x8,[x3,x0,lsl #3] // load A[x]
|
||||
mul x6,x0,x10 // compute bead x
|
||||
3:
|
||||
add x9,x6,x1 // compute bead y
|
||||
mov x4,#1 // value to store
|
||||
str x4,[fp,x9,lsl #3] // store to stack area
|
||||
add x1,x1,#1
|
||||
cmp x1,x8
|
||||
blt 3b
|
||||
31: // init to zéro the bead end
|
||||
cmp x1,x10 // max ?
|
||||
bge 32f
|
||||
add x9,x6,x1 // compute bead y
|
||||
mov x4,#0
|
||||
str x4,[fp,x9,lsl #3]
|
||||
add x1,x1,#1
|
||||
b 31b
|
||||
32:
|
||||
add x0,x0,#1 // increment x
|
||||
cmp x0,x12 // end ?
|
||||
blt 2b
|
||||
// count beads
|
||||
mov x1,#0 // y
|
||||
4:
|
||||
mov x0,#0 // start index x
|
||||
mov x8,#0 // sum
|
||||
5:
|
||||
mul x6,x0,x10 // compute bead x
|
||||
add x9,x6,x1 // compute bead y
|
||||
ldr x4,[fp,x9,lsl #3]
|
||||
add x8,x8,x4
|
||||
mov x4,#0
|
||||
str x4,[fp,x9,lsl #3] // raz bead
|
||||
add x0,x0,#1
|
||||
cmp x0,x12
|
||||
blt 5b
|
||||
sub x0,x12,x8 // compute end - sum
|
||||
6:
|
||||
mul x6,x0,x10 // compute bead x
|
||||
add x9,x6,x1 // compute bead y
|
||||
mov x4,#1
|
||||
str x4,[fp,x9,lsl #3] // store new bead at end
|
||||
add x0,x0,#1
|
||||
cmp x0,x12
|
||||
blt 6b
|
||||
|
||||
add x1,x1,#1
|
||||
cmp x1,x10
|
||||
blt 4b
|
||||
|
||||
// final compute
|
||||
mov x0,#0 // start index x
|
||||
7:
|
||||
mov x1,#0 // start index y
|
||||
mul x6,x0,x10 // compute bead x
|
||||
8:
|
||||
add x9,x6,x1 // compute bead y
|
||||
ldr x4,[fp,x9,lsl #3] // load bead [x,y]
|
||||
add x1,x1,#1 // add to x1 before str (index start at zéro)
|
||||
cmp x4,#1
|
||||
bne 9f
|
||||
str x1,[x3,x0, lsl #3] // store A[x]
|
||||
9:
|
||||
cmp x1,x10 // compare max
|
||||
blt 8b
|
||||
add x0,x0,#1
|
||||
cmp x0,x12 // end ?
|
||||
blt 7b
|
||||
|
||||
mov x0,#0
|
||||
add sp,sp,x5 // stack alignement
|
||||
100:
|
||||
ldp x1,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
/******************************************************************/
|
||||
/* Display table elements */
|
||||
/******************************************************************/
|
||||
/* x0 contains the address of table */
|
||||
/* x1 contains elements number */
|
||||
displayTable:
|
||||
stp x1,lr,[sp,-16]! // save registers
|
||||
stp x2,x3,[sp,-16]! // save registers
|
||||
mov x2,x0 // table address
|
||||
mov x4,x1 // elements number
|
||||
mov x3,#0
|
||||
1: // loop display table
|
||||
ldr x0,[x2,x3,lsl #3]
|
||||
ldr x1,qAdrsZoneConv
|
||||
bl conversion10 // décimal conversion
|
||||
ldr x0,qAdrsMessResult
|
||||
ldr x1,qAdrsZoneConv // insert conversion
|
||||
bl strInsertAtCharInc
|
||||
bl affichageMess // display message
|
||||
add x3,x3,#1
|
||||
cmp x3,x4 // end ?
|
||||
blt 1b // no -> loop
|
||||
ldr x0,qAdrszCarriageReturn
|
||||
bl affichageMess
|
||||
100:
|
||||
ldp x2,x3,[sp],16 // restaur 2 registers
|
||||
ldp x1,lr,[sp],16 // restaur 2 registers
|
||||
ret // return to address lr x30
|
||||
qAdrsZoneConv: .quad sZoneConv
|
||||
|
||||
/********************************************************/
|
||||
/* File Include fonctions */
|
||||
/********************************************************/
|
||||
/* for this file see task include a file in language AArch64 assembly */
|
||||
.include "../includeARM64.inc"
|
||||
|
|
@ -0,0 +1,226 @@
|
|||
/* ARM assembly Raspberry PI */
|
||||
/* program beadSort.s */
|
||||
/* En français tri par gravité ou tri par bille (ne pas confondre
|
||||
avec tri par bulle (bubble sort) */
|
||||
|
||||
/* REMARK 1 : this program use routines in a include file
|
||||
see task Include a file language arm assembly
|
||||
for the routine affichageMess conversion10
|
||||
see at end of this program the instruction include */
|
||||
/* for constantes see task include a file in arm assembly */
|
||||
/************************************/
|
||||
/* Constantes */
|
||||
/************************************/
|
||||
.include "../constantes.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: .int 1,3,6,2,5,9,10,8,4,7
|
||||
#TableNumber: .int 10,9,8,7,6,5,4,3,2,1
|
||||
.equ NBELEMENTS, (. - TableNumber) / 4
|
||||
@.equ NBELEMENTS, 4 @ for others tests
|
||||
/*********************************/
|
||||
/* UnInitialized data */
|
||||
/*********************************/
|
||||
.bss
|
||||
sZoneConv: .skip 24
|
||||
/*********************************/
|
||||
/* code section */
|
||||
/*********************************/
|
||||
.text
|
||||
.global main
|
||||
main: @ entry of program
|
||||
|
||||
1:
|
||||
ldr r0,iAdrTableNumber @ address number table
|
||||
mov r1,#NBELEMENTS @ number of élements
|
||||
bl beadSort
|
||||
ldr r0,iAdrTableNumber @ address number table
|
||||
mov r1,#NBELEMENTS @ number of élements
|
||||
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
|
||||
|
||||
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] @ load A[0]
|
||||
1:
|
||||
add r2,#1
|
||||
cmp r2,r1 @ end ?
|
||||
movge r0,#1 @ yes -> ok -> return
|
||||
bge 100f
|
||||
ldr r3,[r0,r2, lsl #2] @ load A[i]
|
||||
cmp r3,r4 @ compare A[i],A[i-1]
|
||||
movlt r0,#0 @ smaller ?
|
||||
blt 100f @ yes -> error -> return
|
||||
mov r4,r3 @ no -> A[i-1] = A[i]
|
||||
b 1b @ and loop
|
||||
100:
|
||||
pop {r2-r4,lr}
|
||||
bx lr @ return
|
||||
/******************************************************************/
|
||||
/* bead sort */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of table */
|
||||
/* r1 contains the number of element */
|
||||
beadSort:
|
||||
push {r1-r12,lr} @ save registers
|
||||
mov r12,r1 @ save elements number
|
||||
@search max
|
||||
ldr r10,[r0] @ load value A[0] in max
|
||||
mov r4,#1
|
||||
1: @ loop search max
|
||||
cmp r4,r12 @ end ?
|
||||
bge 21f @ yes
|
||||
ldr r2,[r0,r4,lsl #2] @ load value A[i]
|
||||
cmp r2,r10 @ compare with max
|
||||
movgt r10,r2 @ if greather
|
||||
add r4,r4,#1
|
||||
b 1b @ loop
|
||||
21:
|
||||
mul r5,r10,r12 @ max * elements number
|
||||
lsl r5,r5,#2 @ 4 bytes for each number
|
||||
sub sp,sp,r5 @ allocate on the stack
|
||||
mov fp,sp @ frame pointer = stack address
|
||||
@ marks beads
|
||||
mov r3,r0 @ save table address
|
||||
mov r0,#0 @ start index x
|
||||
2:
|
||||
mov r1,#0 @ index y
|
||||
ldr r7,[r3,r0,lsl #2] @ load A[x]
|
||||
mul r6,r0,r10 @ compute bead x
|
||||
3:
|
||||
add r9,r6,r1 @ compute bead y
|
||||
mov r4,#1 @ value to store
|
||||
str r4,[fp,r9,lsl #2] @ store to stack area
|
||||
add r1,r1,#1
|
||||
cmp r1,r7
|
||||
blt 3b
|
||||
31: @ init to zéro the bead end
|
||||
cmp r1,r10 @ max ?
|
||||
bge 32f
|
||||
add r9,r6,r1 @ compute bead y
|
||||
mov r4,#0
|
||||
str r4,[fp,r9,lsl #2]
|
||||
add r1,r1,#1
|
||||
b 31b
|
||||
32:
|
||||
add r0,r0,#1 @ increment x
|
||||
cmp r0,r12 @ end ?
|
||||
blt 2b
|
||||
@ count beads
|
||||
mov r1,#0 @ y
|
||||
4:
|
||||
mov r0,#0 @ start index x
|
||||
mov r8,#0 @ sum
|
||||
5:
|
||||
mul r6,r0,r10 @ compute bead x
|
||||
add r9,r6,r1 @ compute bead y
|
||||
ldr r4,[fp,r9,lsl #2]
|
||||
add r8,r8,r4
|
||||
mov r4,#0
|
||||
str r4,[fp,r9,lsl #2]
|
||||
add r0,r0,#1
|
||||
cmp r0,r12
|
||||
blt 5b
|
||||
sub r0,r12,r8
|
||||
6:
|
||||
mul r6,r0,r10 @ compute bead x
|
||||
add r9,r6,r1 @ compute bead y
|
||||
mov r4,#1
|
||||
str r4,[fp,r9,lsl #2]
|
||||
add r0,r0,#1
|
||||
cmp r0,r12
|
||||
blt 6b
|
||||
|
||||
add r1,r1,#1
|
||||
cmp r1,r10
|
||||
blt 4b
|
||||
|
||||
@ suite
|
||||
mov r0,#0 @ start index
|
||||
7:
|
||||
mov r1,#0
|
||||
mul r6,r0,r10 @ compute bead x
|
||||
8:
|
||||
add r9,r6,r1 @ compute bead y
|
||||
ldr r4,[fp,r9,lsl #2]
|
||||
add r1,r1,#1 @ add to r1 before str (index start at zéro)
|
||||
cmp r4,#1
|
||||
streq r1,[r3,r0, lsl #2] @ store A[i]
|
||||
cmp r1,r10 @ compare max
|
||||
blt 8b
|
||||
add r0,r0,#1
|
||||
cmp r0,r12 @ end ?
|
||||
blt 7b
|
||||
|
||||
mov r0,#0
|
||||
add sp,sp,r5 @ stack alignement
|
||||
100:
|
||||
pop {r1-r12,lr}
|
||||
bx lr @ return
|
||||
/******************************************************************/
|
||||
/* Display table elements */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of table */
|
||||
/* r1 contains elements number */
|
||||
displayTable:
|
||||
push {r0-r4,lr} @ save registers
|
||||
mov r2,r0 @ table address
|
||||
mov r4,r1 @ elements number
|
||||
mov r3,#0
|
||||
1: @ loop display table
|
||||
ldr r0,[r2,r3,lsl #2]
|
||||
ldr r1,iAdrsZoneConv
|
||||
bl conversion10 @ décimal conversion
|
||||
ldr r0,iAdrsMessResult
|
||||
ldr r1,iAdrsZoneConv @ insert conversion
|
||||
bl strInsertAtCharInc
|
||||
bl affichageMess @ display message
|
||||
add r3,r3,#1
|
||||
cmp r3,r4 @ end ?
|
||||
blt 1b @ no -> loop
|
||||
ldr r0,iAdrszCarriageReturn
|
||||
bl affichageMess
|
||||
100:
|
||||
pop {r0-r4,lr}
|
||||
bx lr
|
||||
iAdrsZoneConv: .int sZoneConv
|
||||
/***************************************************/
|
||||
/* ROUTINES INCLUDE */
|
||||
/***************************************************/
|
||||
.include "../affichage.inc"
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
beadSort: function [items][
|
||||
a: new items
|
||||
m: neg infinity
|
||||
s: 0
|
||||
|
||||
loop a 'x [
|
||||
if x > m -> m: x
|
||||
]
|
||||
|
||||
beads: array.of: m * size a 0
|
||||
|
||||
loop 0..dec size a 'i [
|
||||
loop 0..dec a\[i] 'j ->
|
||||
beads\[j + i * m]: 1
|
||||
]
|
||||
|
||||
loop 0..dec m 'j [
|
||||
s: 0
|
||||
loop 0..dec size a 'i [
|
||||
s: s + beads\[j + i*m]
|
||||
beads\[j + i*m]: 0
|
||||
]
|
||||
|
||||
loop ((size a)-s)..dec size a 'i ->
|
||||
beads\[j + i*m]: 1
|
||||
]
|
||||
|
||||
loop 0..dec size a 'i [
|
||||
j: 0
|
||||
while [and? [j < m] [beads\[j + i*m] > 0]] -> j: j + 1
|
||||
a\[i]: j
|
||||
]
|
||||
|
||||
return a
|
||||
]
|
||||
|
||||
print beadSort [3 1 2 8 5 7 9 4 6]
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
BeadSort(data){
|
||||
Pole:=[] , TempObj:=[], Result:=[]
|
||||
for, i, v in data {
|
||||
Row := i
|
||||
loop, % v
|
||||
MaxPole := MaxPole>A_Index?MaxPole:A_Index , Pole[A_Index, row] := 1
|
||||
}
|
||||
|
||||
for i , obj in Pole {
|
||||
TempVar:=0 , c := A_Index
|
||||
for n, v in obj
|
||||
TempVar += v
|
||||
loop, % TempVar
|
||||
TempObj[c, A_Index] := 1
|
||||
}
|
||||
|
||||
loop, % Row {
|
||||
TempVar:=0 , c := A_Index
|
||||
Loop, % MaxPole
|
||||
TempVar += TempObj[A_Index,c]
|
||||
Result[c] := TempVar
|
||||
}
|
||||
return Result
|
||||
}
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
for i, val in BeadSort([54,12,87,56,36])
|
||||
res := val (res?",":"") res
|
||||
MsgBox % res
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
get "libhdr"
|
||||
|
||||
let max(A, len) = valof
|
||||
$( let x = 0
|
||||
for i=0 to len-1
|
||||
if x<A!i do x := A!i
|
||||
resultis x
|
||||
$)
|
||||
|
||||
let beadsort(A, len) be
|
||||
$( let size = max(A, len)
|
||||
let tvec = getvec(size-1)
|
||||
for i=0 to size-1 do tvec!i := 0
|
||||
for i=0 to len-1
|
||||
for j=0 to A!i-1 do tvec!j := tvec!j + 1
|
||||
for i=len-1 to 0 by -1
|
||||
$( let n = 0
|
||||
for j=0 to size-1
|
||||
if tvec!j > 0
|
||||
$( tvec!j := tvec!j - 1
|
||||
n := n + 1
|
||||
$)
|
||||
A!i := n
|
||||
$)
|
||||
freevec(tvec)
|
||||
$)
|
||||
|
||||
let write(s, A, len) be
|
||||
$( writes(s)
|
||||
for i=0 to len-1 do writed(A!i, 4)
|
||||
wrch('*N')
|
||||
$)
|
||||
|
||||
let start() be
|
||||
$( let array = table 10,1,5,5,9,2,20,6,8,4
|
||||
let length = 10
|
||||
write("Before: ", array, length)
|
||||
beadsort(array, length)
|
||||
write("After: ", array, length)
|
||||
$)
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
//this algorithm only works with positive, whole numbers.
|
||||
//O(2n) time complexity where n is the summation of the whole list to be sorted.
|
||||
//O(3n) space complexity.
|
||||
|
||||
#include <iostream>
|
||||
#include <vector>
|
||||
|
||||
using std::cout;
|
||||
using std::vector;
|
||||
|
||||
void distribute(int dist, vector<int> &List) {
|
||||
//*beads* go down into different buckets using gravity (addition).
|
||||
if (dist > List.size() )
|
||||
List.resize(dist); //resize if too big for current vector
|
||||
|
||||
for (int i=0; i < dist; i++)
|
||||
List[i]++;
|
||||
}
|
||||
|
||||
vector<int> beadSort(int *myints, int n) {
|
||||
vector<int> list, list2, fifth (myints, myints + n);
|
||||
|
||||
cout << "#1 Beads falling down: ";
|
||||
for (int i=0; i < fifth.size(); i++)
|
||||
distribute (fifth[i], list);
|
||||
cout << '\n';
|
||||
|
||||
cout << "\nBeads on their sides: ";
|
||||
for (int i=0; i < list.size(); i++)
|
||||
cout << " " << list[i];
|
||||
cout << '\n';
|
||||
|
||||
//second part
|
||||
|
||||
cout << "#2 Beads right side up: ";
|
||||
for (int i=0; i < list.size(); i++)
|
||||
distribute (list[i], list2);
|
||||
cout << '\n';
|
||||
|
||||
return list2;
|
||||
}
|
||||
|
||||
int main() {
|
||||
int myints[] = {734,3,1,24,324,324,32,432,42,3,4,1,1};
|
||||
vector<int> sorted = beadSort(myints, sizeof(myints)/sizeof(int));
|
||||
cout << "Sorted list/array: ";
|
||||
for(unsigned int i=0; i<sorted.size(); i++)
|
||||
cout << sorted[i] << ' ';
|
||||
}
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
void bead_sort(int *a, int len)
|
||||
{
|
||||
int i, j, max, sum;
|
||||
unsigned char *beads;
|
||||
# define BEAD(i, j) beads[i * max + j]
|
||||
|
||||
for (i = 1, max = a[0]; i < len; i++)
|
||||
if (a[i] > max) max = a[i];
|
||||
|
||||
beads = calloc(1, max * len);
|
||||
|
||||
/* mark the beads */
|
||||
for (i = 0; i < len; i++)
|
||||
for (j = 0; j < a[i]; j++)
|
||||
BEAD(i, j) = 1;
|
||||
|
||||
for (j = 0; j < max; j++) {
|
||||
/* count how many beads are on each post */
|
||||
for (sum = i = 0; i < len; i++) {
|
||||
sum += BEAD(i, j);
|
||||
BEAD(i, j) = 0;
|
||||
}
|
||||
/* mark bottom sum beads */
|
||||
for (i = len - sum; i < len; i++) BEAD(i, j) = 1;
|
||||
}
|
||||
|
||||
for (i = 0; i < len; i++) {
|
||||
for (j = 0; j < max && BEAD(i, j); j++);
|
||||
a[i] = j;
|
||||
}
|
||||
free(beads);
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
int i, x[] = {5, 3, 1, 7, 4, 1, 1, 20};
|
||||
int len = sizeof(x)/sizeof(x[0]);
|
||||
|
||||
bead_sort(x, len);
|
||||
for (i = 0; i < len; i++)
|
||||
printf("%d\n", x[i]);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,98 @@
|
|||
>>SOURCE FORMAT FREE
|
||||
*> This code is dedicated to the public domain
|
||||
*> This is GNUCOBOL 2.0
|
||||
identification division.
|
||||
program-id. beadsort.
|
||||
environment division.
|
||||
configuration section.
|
||||
repository. function all intrinsic.
|
||||
data division.
|
||||
working-storage section.
|
||||
01 filler.
|
||||
03 row occurs 9 pic x(9).
|
||||
03 r pic 99.
|
||||
03 r1 pic 99.
|
||||
03 r2 pic 99.
|
||||
03 pole pic 99.
|
||||
03 a-lim pic 99 value 9.
|
||||
03 a pic 99.
|
||||
03 array occurs 9 pic 9.
|
||||
01 NL pic x value x'0A'.
|
||||
procedure division.
|
||||
start-beadsort.
|
||||
|
||||
*> fill the array
|
||||
compute a = random(seconds-past-midnight)
|
||||
perform varying a from 1 by 1 until a > a-lim
|
||||
compute array(a) = random() * 10
|
||||
end-perform
|
||||
|
||||
perform display-array
|
||||
display space 'initial array'
|
||||
|
||||
*> distribute the beads
|
||||
perform varying r from 1 by 1 until r > a-lim
|
||||
move all '.' to row(r)
|
||||
perform varying pole from 1 by 1 until pole > array(r)
|
||||
move 'o' to row(r)(pole:1)
|
||||
end-perform
|
||||
end-perform
|
||||
display NL 'initial beads'
|
||||
perform display-beads
|
||||
|
||||
*> drop the beads
|
||||
perform varying pole from 1 by 1 until pole > a-lim
|
||||
move a-lim to r2
|
||||
perform find-opening
|
||||
compute r1 = r2 - 1
|
||||
perform find-bead
|
||||
perform until r1 = 0 *> no bead or no opening
|
||||
*> drop the bead
|
||||
move '.' to row(r1)(pole:1)
|
||||
move 'o' to row(r2)(pole:1)
|
||||
*> continue up the pole
|
||||
compute r2 = r2 - 1
|
||||
perform find-opening
|
||||
compute r1 = r2 - 1
|
||||
perform find-bead
|
||||
end-perform
|
||||
end-perform
|
||||
display NL 'dropped beads'
|
||||
perform display-beads
|
||||
|
||||
*> count the beads in each row
|
||||
perform varying r from 1 by 1 until r > a-lim
|
||||
move 0 to array(r)
|
||||
inspect row(r) tallying array(r)
|
||||
for all 'o' before initial '.'
|
||||
end-perform
|
||||
|
||||
perform display-array
|
||||
display space 'sorted array'
|
||||
|
||||
stop run
|
||||
.
|
||||
find-opening.
|
||||
perform varying r2 from r2 by -1
|
||||
until r2 = 1 or row(r2)(pole:1) = '.'
|
||||
continue
|
||||
end-perform
|
||||
.
|
||||
find-bead.
|
||||
perform varying r1 from r1 by -1
|
||||
until r1 = 0 or row(r1)(pole:1) = 'o'
|
||||
continue
|
||||
end-perform
|
||||
.
|
||||
display-array.
|
||||
display space
|
||||
perform varying a from 1 by 1 until a > a-lim
|
||||
display space array(a) with no advancing
|
||||
end-perform
|
||||
.
|
||||
display-beads.
|
||||
perform varying r from 1 by 1 until r > a-lim
|
||||
display row(r)
|
||||
end-perform
|
||||
.
|
||||
end program beadsort.
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
(defn transpose [xs]
|
||||
(loop [ret [], remain xs]
|
||||
(if (empty? remain)
|
||||
ret
|
||||
(recur (conj ret (map first remain))
|
||||
(filter not-empty (map rest remain))))))
|
||||
|
||||
(defn bead-sort [xs]
|
||||
(->> xs
|
||||
(map #(repeat % 1))
|
||||
transpose
|
||||
transpose
|
||||
(map #(reduce + %))))
|
||||
|
||||
;; This algorithm does not work if collection has zero
|
||||
(-> [5 2 4 1 3 3 9] bead-sort println)
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(defun transpose (remain &optional (ret '()))
|
||||
(if (null remain)
|
||||
ret
|
||||
(transpose (remove-if #'null (mapcar #'cdr remain))
|
||||
(append ret (list (mapcar #'car remain))))))
|
||||
|
||||
(defun bead-sort (xs)
|
||||
(mapcar #'length (transpose (transpose (mapcar (lambda (x) (make-list x :initial-element 1)) xs)))))
|
||||
|
||||
(bead-sort '(5 2 4 1 3 3 9))
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
import std.stdio, std.algorithm, std.range, std.array, std.functional;
|
||||
|
||||
alias repeat0 = curry!(repeat, 0);
|
||||
|
||||
// Currenty std.range.transposed doesn't work.
|
||||
auto columns(R)(R m) pure /*nothrow*/ @safe /*@nogc*/ {
|
||||
return m
|
||||
.map!walkLength
|
||||
.reduce!max
|
||||
.iota
|
||||
.map!(i => m.filter!(s => s.length > i).walkLength.repeat0);
|
||||
}
|
||||
|
||||
auto beadSort(in uint[] data) pure /*nothrow @nogc*/ {
|
||||
return data.map!repeat0.columns.columns.map!walkLength;
|
||||
}
|
||||
|
||||
void main() {
|
||||
[5, 3, 1, 7, 4, 1, 1].beadSort.writeln;
|
||||
}
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
program BeadSortTest;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
procedure BeadSort(var a : array of integer);
|
||||
var
|
||||
i, j, max, sum : integer;
|
||||
beads : array of array of integer;
|
||||
begin
|
||||
max := a[Low(a)];
|
||||
for i := Low(a) + 1 to High(a) do
|
||||
if a[i] > max then
|
||||
max := a[i];
|
||||
|
||||
SetLength(beads, High(a) - Low(a) + 1, max);
|
||||
|
||||
// mark the beads
|
||||
|
||||
for i := Low(a) to High(a) do
|
||||
for j := 0 to a[i] - 1 do
|
||||
beads[i, j] := 1;
|
||||
|
||||
for j := 0 to max - 1 do
|
||||
begin
|
||||
// count how many beads are on each post
|
||||
sum := 0;
|
||||
for i := Low(a) to High(a) do
|
||||
begin
|
||||
sum := sum + beads[i, j];
|
||||
beads[i, j] := 0;
|
||||
end;
|
||||
//mark bottom sum beads
|
||||
for i := High(a) + 1 - sum to High(a) do
|
||||
beads[i, j] := 1;
|
||||
end;
|
||||
|
||||
for i := Low(a) to High(a) do
|
||||
begin
|
||||
j := 0;
|
||||
while (j < max) and (beads[i, j] <> 0) do
|
||||
inc(j);
|
||||
a[i] := j;
|
||||
end;
|
||||
|
||||
SetLength(beads, 0, 0);
|
||||
end;
|
||||
|
||||
const
|
||||
N = 8;
|
||||
var
|
||||
i : integer;
|
||||
x : array[1..N] of integer = (5, 3, 1, 7, 4, 1, 1, 20);
|
||||
begin
|
||||
for i := 1 to N do
|
||||
writeln(Format('x[%d] = %d', [i, x[i]]));
|
||||
|
||||
BeadSort(x);
|
||||
|
||||
for i := 1 to N do
|
||||
writeln(Format('x[%d] = %d', [i, x[i]]));
|
||||
|
||||
readln;
|
||||
end.
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
class
|
||||
BEAD_SORT
|
||||
|
||||
feature
|
||||
|
||||
bead_sort (ar: ARRAY [INTEGER]): ARRAY [INTEGER]
|
||||
-- Sorted array in descending order.
|
||||
require
|
||||
only_positive_integers: across ar as a all a.item > 0 end
|
||||
local
|
||||
max, count, i, j, k: INTEGER
|
||||
do
|
||||
max := max_item (ar)
|
||||
create Result.make_filled (0, 1, ar.count)
|
||||
from
|
||||
i := 1
|
||||
until
|
||||
i > max
|
||||
loop
|
||||
count := 0
|
||||
from
|
||||
k := 1
|
||||
until
|
||||
k > ar.count
|
||||
loop
|
||||
if ar.item (k) >= i then
|
||||
count := count + 1
|
||||
end
|
||||
k := k + 1
|
||||
end
|
||||
from
|
||||
j := 1
|
||||
until
|
||||
j > count
|
||||
loop
|
||||
Result [j] := i
|
||||
j := j + 1
|
||||
end
|
||||
i := i + 1
|
||||
end
|
||||
ensure
|
||||
array_is_sorted: is_sorted (Result)
|
||||
end
|
||||
|
||||
feature {NONE}
|
||||
|
||||
max_item (ar: ARRAY [INTEGER]): INTEGER
|
||||
-- Max item of 'ar'.
|
||||
require
|
||||
ar_not_void: ar /= Void
|
||||
do
|
||||
across
|
||||
ar as a
|
||||
loop
|
||||
if a.item > Result then
|
||||
Result := a.item
|
||||
end
|
||||
end
|
||||
ensure
|
||||
Result_is_max: across ar as a all a.item <= Result end
|
||||
end
|
||||
|
||||
is_sorted (ar: ARRAY [INTEGER]): BOOLEAN
|
||||
--- Is 'ar' sorted in descending order?
|
||||
require
|
||||
ar_not_empty: ar.is_empty = False
|
||||
local
|
||||
i: INTEGER
|
||||
do
|
||||
Result := True
|
||||
from
|
||||
i := ar.lower
|
||||
until
|
||||
i = ar.upper
|
||||
loop
|
||||
if ar [i] < ar [i + 1] then
|
||||
Result := False
|
||||
end
|
||||
i := i + 1
|
||||
end
|
||||
end
|
||||
|
||||
end
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
class
|
||||
APPLICATION
|
||||
|
||||
create
|
||||
make
|
||||
|
||||
feature
|
||||
|
||||
make
|
||||
do
|
||||
test := <<1, 5, 99, 2, 95, 7, 7>>
|
||||
create beadsort
|
||||
io.put_string ("unsorted:" + "%N")
|
||||
across
|
||||
test as ar
|
||||
loop
|
||||
io.put_string (ar.item.out + "%T")
|
||||
end
|
||||
io.put_string ("%N" + "sorted:" + "%N")
|
||||
test := beadsort.bead_sort (test)
|
||||
across
|
||||
test as ar
|
||||
loop
|
||||
io.put_string (ar.item.out + "%T")
|
||||
end
|
||||
end
|
||||
|
||||
beadsort: BEAD_SORT
|
||||
|
||||
test: ARRAY [INTEGER]
|
||||
|
||||
end
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
defmodule Sort do
|
||||
def bead_sort(list) when is_list(list), do: dist(dist(list))
|
||||
|
||||
defp dist(list), do: List.foldl(list, [], fn(n, acc) when n>0 -> dist(acc, n, []) end)
|
||||
|
||||
defp dist([], 0, acc), do: Enum.reverse(acc)
|
||||
defp dist([h|t], 0, acc), do: dist(t, 0, [h |acc])
|
||||
defp dist([], n, acc), do: dist([], n-1, [1 |acc])
|
||||
defp dist([h|t], n, acc), do: dist(t, n-1, [h+1|acc])
|
||||
end
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
-module(beadsort).
|
||||
|
||||
-export([sort/1]).
|
||||
|
||||
sort(L) ->
|
||||
dist(dist(L)).
|
||||
|
||||
dist(L) when is_list(L) ->
|
||||
lists:foldl(fun (N, Acc) -> dist(Acc, N, []) end, [], L).
|
||||
|
||||
dist([H | T], N, Acc) when N > 0 ->
|
||||
dist(T, N - 1, [H + 1 | Acc]);
|
||||
dist([], N, Acc) when N > 0 ->
|
||||
dist([], N - 1, [1 | Acc]);
|
||||
dist([H | T], 0, Acc) ->
|
||||
dist(T, 0, [H | Acc]);
|
||||
dist([], 0, Acc) ->
|
||||
lists:reverse(Acc).
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
1> beadsort:sort([1,734,24,3,324,324,32,432,42,3,4,1,1]).
|
||||
[734,432,324,324,42,32,24,4,3,3,1,1,1]
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
open System
|
||||
|
||||
let removeEmptyLists lists = lists |> List.filter (not << List.isEmpty)
|
||||
let flip f x y = f y x
|
||||
|
||||
let rec transpose = function
|
||||
| [] -> []
|
||||
| lists -> (List.map List.head lists) :: transpose(removeEmptyLists (List.map List.tail lists))
|
||||
|
||||
// Using the backward composition operator "<<" (equivalent to Haskells ".") ...
|
||||
let beadSort = List.map List.sum << transpose << transpose << List.map (flip List.replicate 1)
|
||||
|
||||
// Using the forward composition operator ">>" ...
|
||||
let beadSort2 = List.map (flip List.replicate 1) >> transpose >> transpose >> List.map List.sum
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
USING: kernel math math.order math.vectors sequences ;
|
||||
: fill ( seq len -- newseq ) [ dup length ] dip swap - 0 <repetition> append ;
|
||||
|
||||
: bead ( seq -- newseq )
|
||||
dup 0 [ max ] reduce
|
||||
[ swap 1 <repetition> swap fill ] curry map
|
||||
[ ] [ v+ ] map-reduce ;
|
||||
|
||||
: beadsort ( seq -- newseq ) bead bead ;
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
( scratchpad ) { 5 2 4 1 3 3 9 } beadsort .
|
||||
{ 9 5 4 3 3 2 1 }
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
program BeadSortTest
|
||||
use iso_fortran_env
|
||||
! for ERROR_UNIT; to make this a F95 code,
|
||||
! remove prev. line and declare ERROR_UNIT as an
|
||||
! integer parameter matching the unit associated with
|
||||
! standard error
|
||||
|
||||
integer, dimension(7) :: a = (/ 7, 3, 5, 1, 2, 1, 20 /)
|
||||
|
||||
call beadsort(a)
|
||||
print *, a
|
||||
|
||||
contains
|
||||
|
||||
subroutine beadsort(a)
|
||||
integer, dimension(:), intent(inout) :: a
|
||||
|
||||
integer, dimension(maxval(a), maxval(a)) :: t
|
||||
integer, dimension(maxval(a)) :: s
|
||||
integer :: i, m
|
||||
|
||||
m = maxval(a)
|
||||
|
||||
if ( any(a < 0) ) then
|
||||
write(ERROR_UNIT,*) "can't sort"
|
||||
return
|
||||
end if
|
||||
|
||||
t = 0
|
||||
forall(i=1:size(a)) t(i, 1:a(i)) = 1 ! set up abacus
|
||||
forall(i=1:m) ! let beads "fall"; instead of
|
||||
s(i) = sum(t(:, i)) ! moving them one by one, we just
|
||||
t(:, i) = 0 ! count how many should be at bottom,
|
||||
t(1:s(i), i) = 1 ! and then "reset" and set only those
|
||||
end forall
|
||||
|
||||
forall(i=1:size(a)) a(i) = sum(t(i,:))
|
||||
|
||||
end subroutine beadsort
|
||||
|
||||
end program BeadSortTest
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
#define MAXNUM 100
|
||||
|
||||
Sub beadSort(bs() As Long)
|
||||
Dim As Long i, j = 1, lb = Lbound(bs), ub = Ubound(bs)
|
||||
Dim As Long poles(MAXNUM)
|
||||
|
||||
For i = 1 To ub
|
||||
For j = 1 To bs(i)
|
||||
poles(j) += 1
|
||||
Next j
|
||||
Next i
|
||||
For j = 1 To ub
|
||||
bs(j) = 0
|
||||
Next j
|
||||
For i = 1 To Ubound(poles)
|
||||
For j = 1 To poles(i)
|
||||
bs(j) += 1
|
||||
Next j
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
'--- Programa Principal ---
|
||||
Dim As Long i
|
||||
Dim As Ulong array(1 To 8) => {5, 3, 1, 7, 4, 1, 1, 20}
|
||||
Dim As Long a = Lbound(array), b = Ubound(array)
|
||||
|
||||
Randomize Timer
|
||||
|
||||
Print "unsort ";
|
||||
For i = a To b : Print Using "####"; array(i); : Next i
|
||||
|
||||
beadSort(array())
|
||||
|
||||
Print !"\n sort ";
|
||||
For i = a To b : Print Using "####"; array(i); : Next i
|
||||
|
||||
Print !"\n--- terminado, pulsa RETURN---"
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"sync"
|
||||
)
|
||||
|
||||
var a = []int{170, 45, 75, 90, 802, 24, 2, 66}
|
||||
var aMax = 1000
|
||||
|
||||
const bead = 'o'
|
||||
|
||||
func main() {
|
||||
fmt.Println("before:", a)
|
||||
beadSort()
|
||||
fmt.Println("after: ", a)
|
||||
}
|
||||
|
||||
func beadSort() {
|
||||
// All space in the abacus = aMax poles x len(a) rows.
|
||||
all := make([]byte, aMax*len(a))
|
||||
// Slice up space by pole. (The space could be sliced by row instead,
|
||||
// but slicing by pole seemed a more intuitive model of a physical abacus.)
|
||||
abacus := make([][]byte, aMax)
|
||||
for pole, space := 0, all; pole < aMax; pole++ {
|
||||
abacus[pole] = space[:len(a)]
|
||||
space = space[len(a):]
|
||||
}
|
||||
// Use a sync.Waitgroup as the checkpoint mechanism.
|
||||
var wg sync.WaitGroup
|
||||
// Place beads for each number concurrently. (Presumably beads can be
|
||||
// "snapped on" to the middle of a pole without disturbing neighboring
|
||||
// beads.) Also note 'row' here is a row of the abacus.
|
||||
wg.Add(len(a))
|
||||
for row, n := range a {
|
||||
go func(row, n int) {
|
||||
for pole := 0; pole < n; pole++ {
|
||||
abacus[pole][row] = bead
|
||||
}
|
||||
wg.Done()
|
||||
}(row, n)
|
||||
}
|
||||
wg.Wait()
|
||||
// Now tip the abacus, letting beads fall on each pole concurrently.
|
||||
wg.Add(aMax)
|
||||
for _, pole := range abacus {
|
||||
go func(pole []byte) {
|
||||
// Track the top of the stack of beads that have already fallen.
|
||||
top := 0
|
||||
for row, space := range pole {
|
||||
if space == bead {
|
||||
// Move each bead individually, but move it from its
|
||||
// starting row to the top of stack in a single operation.
|
||||
// (More physical simulation such as discovering the top
|
||||
// of stack by inspection, or modeling gravity, are
|
||||
// possible, but didn't seem called for by the task.
|
||||
pole[row] = 0
|
||||
pole[top] = bead
|
||||
top++
|
||||
}
|
||||
}
|
||||
wg.Done()
|
||||
}(pole)
|
||||
}
|
||||
wg.Wait()
|
||||
// Read out sorted numbers by row.
|
||||
for row := range a {
|
||||
x := 0
|
||||
for pole := 0; pole < aMax && abacus[pole][row] == bead; pole++ {
|
||||
x++
|
||||
}
|
||||
a[len(a)-1-row] = x
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
def beadSort = { list ->
|
||||
final nPoles = list.max()
|
||||
list.collect {
|
||||
print "."
|
||||
([true] * it) + ([false] * (nPoles - it))
|
||||
}.transpose().collect { pole ->
|
||||
print "."
|
||||
pole.findAll { ! it } + pole.findAll { it }
|
||||
}.transpose().collect{ beadTally ->
|
||||
beadTally.findAll{ it }.size()
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
def beadSortVerbose = { list ->
|
||||
final nPoles = list.max()
|
||||
// each row is a number tally-arrayed across the abacus
|
||||
def beadTallies = list.collect { number ->
|
||||
print "."
|
||||
// true == bead, false == no bead
|
||||
([true] * number) + ([false] * (nPoles - number))
|
||||
}
|
||||
// each row is an abacus pole
|
||||
def abacusPoles = beadTallies.transpose()
|
||||
def abacusPolesDrop = abacusPoles.collect { pole ->
|
||||
print "."
|
||||
// beads drop to the BOTTOM of the pole
|
||||
pole.findAll { ! it } + pole.findAll { it }
|
||||
}
|
||||
// each row is a number again
|
||||
def beadTalliesDrop = abacusPolesDrop.transpose()
|
||||
beadTalliesDrop.collect{ beadTally -> beadTally.findAll{ it }.size() }
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
println beadSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4])
|
||||
println beadSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1])
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
import Data.List
|
||||
|
||||
beadSort :: [Int] -> [Int]
|
||||
beadSort = map sum. transpose. transpose. map (flip replicate 1)
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
*Main> beadSort [2,4,1,3,3]
|
||||
[4,3,3,2,1]
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
procedure main() #: demonstrate various ways to sort a list and string
|
||||
write("Sorting Demo using ",image(beadsort))
|
||||
writes(" on list : ")
|
||||
writex(UL := [3, 14, 1, 5, 9, 2, 6, 3])
|
||||
displaysort(beadsort,copy(UL))
|
||||
end
|
||||
|
||||
procedure beadsort(X) #: return sorted list ascending(or descending)
|
||||
local base,i,j,x # handles negatives and zeros, may also reduce storage
|
||||
|
||||
poles := list(max!X-(base := min!X -1),0) # set up poles, we will track sums not individual beads
|
||||
every x := !X do { # each item in the list
|
||||
if integer(x) ~= x then runerr(101,x) # ... must be an integer
|
||||
every poles[1 to x - base] +:= 1 # ... beads "fall" into the sum for that pole
|
||||
}
|
||||
|
||||
|
||||
every (X[j := *X to 1 by -1] := base) &
|
||||
(i := 1 to *poles) do # read from the bottom of the poles
|
||||
if poles[i] > 0 then { # if there's a bead on the pole ...
|
||||
poles[i] -:= 1 # ... remove it
|
||||
X[j] +:= 1 # ... and add it in place
|
||||
}
|
||||
return X
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
bead=: [: +/ #"0&1
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
bead bead 2 4 1 3 3
|
||||
4 3 3 2 1
|
||||
bead bead 5 3 1 7 4 1 1
|
||||
7 5 4 3 1 1 1
|
||||
|
|
@ -0,0 +1 @@
|
|||
bball=: ] (] + [: bead^:2 -) <./ - 1:
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
bball 2 0 _1 3 1 _2 _3 0
|
||||
3 2 1 0 0 _1 _2 _3
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
public class BeadSort
|
||||
{
|
||||
public static void main(String[] args)
|
||||
{
|
||||
BeadSort now=new BeadSort();
|
||||
int[] arr=new int[(int)(Math.random()*11)+5];
|
||||
for(int i=0;i<arr.length;i++)
|
||||
arr[i]=(int)(Math.random()*10);
|
||||
System.out.print("Unsorted: ");
|
||||
now.display1D(arr);
|
||||
|
||||
int[] sort=now.beadSort(arr);
|
||||
System.out.print("Sorted: ");
|
||||
now.display1D(sort);
|
||||
}
|
||||
int[] beadSort(int[] arr)
|
||||
{
|
||||
int max=a[0];
|
||||
for(int i=1;i<arr.length;i++)
|
||||
if(arr[i]>max)
|
||||
max=arr[i];
|
||||
|
||||
//Set up abacus
|
||||
char[][] grid=new char[arr.length][max];
|
||||
int[] levelcount=new int[max];
|
||||
for(int i=0;i<max;i++)
|
||||
{
|
||||
levelcount[i]=0;
|
||||
for(int j=0;j<arr.length;j++)
|
||||
grid[j][i]='_';
|
||||
}
|
||||
/*
|
||||
display1D(arr);
|
||||
display1D(levelcount);
|
||||
display2D(grid);
|
||||
*/
|
||||
|
||||
//Drop the beads
|
||||
for(int i=0;i<arr.length;i++)
|
||||
{
|
||||
int num=arr[i];
|
||||
for(int j=0;num>0;j++)
|
||||
{
|
||||
grid[levelcount[j]++][j]='*';
|
||||
num--;
|
||||
}
|
||||
}
|
||||
System.out.println();
|
||||
display2D(grid);
|
||||
//Count the beads
|
||||
int[] sorted=new int[arr.length];
|
||||
for(int i=0;i<arr.length;i++)
|
||||
{
|
||||
int putt=0;
|
||||
for(int j=0;j<max&&grid[arr.length-1-i][j]=='*';j++)
|
||||
putt++;
|
||||
sorted[i]=putt;
|
||||
}
|
||||
|
||||
return sorted;
|
||||
}
|
||||
void display1D(int[] arr)
|
||||
{
|
||||
for(int i=0;i<arr.length;i++)
|
||||
System.out.print(arr[i]+" ");
|
||||
System.out.println();
|
||||
}
|
||||
void display1D(char[] arr)
|
||||
{
|
||||
for(int i=0;i<arr.length;i++)
|
||||
System.out.print(arr[i]+" ");
|
||||
System.out.println();
|
||||
}
|
||||
void display2D(char[][] arr)
|
||||
{
|
||||
for(int i=0;i<arr.length;i++)
|
||||
display1D(arr[i]);
|
||||
System.out.println();
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
# ncols is the number of columns (i.e. vertical poles)
|
||||
def column_sums(ncols):
|
||||
. as $abacus
|
||||
| reduce range(0; ncols) as $col
|
||||
([];
|
||||
. + [reduce $abacus[] as $row
|
||||
(0; if $row > $col then .+1 else . end)]) ;
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
# Generic function to count the number of items in a stream:
|
||||
def count(stream): reduce stream as $i (0; .+1);
|
||||
|
||||
def readout:
|
||||
. as $sums
|
||||
| .[0] as $n
|
||||
| reduce range(0;$n) as $i
|
||||
([]; . + [count( $sums[] | select( . > $i) )]);
|
||||
|
|
@ -0,0 +1 @@
|
|||
def bead_sort: column_sums(max) | readout;
|
||||
|
|
@ -0,0 +1 @@
|
|||
[734,3,1,24,324,324,32,432,42,3,4,1,1] | bead_sort
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
$ jq -n -c -f bead_sort.jq
|
||||
[734,432,324,324,42,32,24,4,3,3,1,1,1]
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
function beadsort(a::Vector{<:Integer})
|
||||
lo, hi = extrema(a)
|
||||
if lo < 1 throw(DomainError()) end
|
||||
len = length(a)
|
||||
abacus = falses(len, hi)
|
||||
for (i, v) in enumerate(a)
|
||||
abacus[i, 1:v] = true
|
||||
end
|
||||
for i in 1:hi
|
||||
v = sum(abacus[:, i])
|
||||
if v < len
|
||||
abacus[1:end-v, i] = false
|
||||
abacus[end-v+1:end, i] = true
|
||||
end
|
||||
end
|
||||
return collect(eltype(a), sum(abacus[i,:]) for i in 1:len)
|
||||
end
|
||||
|
||||
v = rand(UInt8, 20)
|
||||
println("# unsorted bytes: $v\n -> sorted bytes: $(beadsort(v))")
|
||||
v = rand(1:2 ^ 10, 20)
|
||||
println("# unsorted integers: $v\n -> sorted integers: $(beadsort(v))")
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
// version 1.1.2
|
||||
|
||||
fun beadSort(a: IntArray) {
|
||||
val n = a.size
|
||||
if (n < 2) return
|
||||
var max = a.max()!!
|
||||
val beads = ByteArray(max * n)
|
||||
/* mark the beads */
|
||||
for (i in 0 until n)
|
||||
for (j in 0 until a[i])
|
||||
beads[i * max + j] = 1
|
||||
|
||||
for (j in 0 until max) {
|
||||
/* count how many beads are on each post */
|
||||
var sum = 0
|
||||
for (i in 0 until n) {
|
||||
sum += beads[i * max + j]
|
||||
beads[i * max + j] = 0
|
||||
}
|
||||
/* mark bottom sum beads */
|
||||
for (i in n - sum until n) beads[i * max + j] = 1
|
||||
}
|
||||
|
||||
for (i in 0 until n) {
|
||||
var j = 0
|
||||
while (j < max && beads[i * max + j] == 1.toByte()) j++
|
||||
a[i] = j
|
||||
}
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val a = intArrayOf(5, 3, 1, 7, 4, 1, 1, 20)
|
||||
println("Before sorting : ${a.contentToString()}")
|
||||
beadSort(a)
|
||||
println("After sorting : ${a.contentToString()}")
|
||||
}
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
-- Display message followed by all values of a table in one line
|
||||
function show (msg, t)
|
||||
io.write(msg .. ":\t")
|
||||
for _, v in pairs(t) do io.write(v .. " ") end
|
||||
print()
|
||||
end
|
||||
|
||||
-- Return a table of random numbers
|
||||
function randList (length, lo, hi)
|
||||
local t = {}
|
||||
for i = 1, length do table.insert(t, math.random(lo, hi)) end
|
||||
return t
|
||||
end
|
||||
|
||||
-- Count instances of numbers that appear in counting to each list value
|
||||
function tally (list)
|
||||
local tal = {}
|
||||
for k, v in pairs(list) do
|
||||
for i = 1, v do
|
||||
if tal[i] then tal[i] = tal[i] + 1 else tal[i] = 1 end
|
||||
end
|
||||
end
|
||||
return tal
|
||||
end
|
||||
|
||||
-- Sort a table of positive integers into descending order
|
||||
function beadSort (numList)
|
||||
show("Before sort", numList)
|
||||
local abacus = tally(numList)
|
||||
show("Tally list", abacus)
|
||||
local sorted = tally(abacus)
|
||||
show("After sort", sorted)
|
||||
end
|
||||
|
||||
-- Main procedure
|
||||
math.randomseed(os.time())
|
||||
beadSort(randList(10, 1, 10))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
beadsort[ a ] := Module[ { m, sorted, s ,t },
|
||||
sorted = a; m = Max[a]; t=ConstantArray[0, {m,m} ];
|
||||
If[ Min[a] < 0, Print["can't sort"]];
|
||||
For[ i = 1, i < Length[a], i++, t[[i,1;;a[[i]]]]=1 ]
|
||||
For[ i = 1 ,i <= m, i++, s = Total[t[[;;,i]]];
|
||||
t[[ ;; , i]] = 0; t[[1 ;; s , i]] = 1; ]
|
||||
For[ i=1,i<=Length[a],i++, sorted[[i]] = Total[t[[i,;;]]]; ]
|
||||
Print[sorted];
|
||||
]
|
||||
beadsort[{2,1,5,3,6}]
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
/* NetRexx */
|
||||
options replace format comments java crossref symbols nobinary
|
||||
|
||||
runSample(arg)
|
||||
return
|
||||
|
||||
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
method bead_sort(harry = Rexx[]) public static binary returns Rexx[]
|
||||
MIN_ = 'MIN'
|
||||
MAX_ = 'MAX'
|
||||
beads = Rexx 0
|
||||
beads[MIN_] = 0
|
||||
beads[MAX_] = 0
|
||||
|
||||
loop val over harry
|
||||
-- collect occurences of beads in indexed string indexed on value
|
||||
if val < beads[MIN_] then beads[MIN_] = val -- keep track of min value
|
||||
if val > beads[MAX_] then beads[MAX_] = val -- keep track of max value
|
||||
beads[val] = beads[val] + 1
|
||||
end val
|
||||
|
||||
harry_sorted = Rexx[harry.length]
|
||||
bi = 0
|
||||
loop xx = beads[MIN_] to beads[MAX_]
|
||||
-- extract beads in value order and insert in result array
|
||||
if beads[xx] == 0 then iterate xx
|
||||
loop for beads[xx]
|
||||
harry_sorted[bi] = xx
|
||||
bi = bi + 1
|
||||
end
|
||||
end xx
|
||||
|
||||
return harry_sorted
|
||||
|
||||
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
method runSample(arg) public static
|
||||
unsorted = [734, 3, 1, 24, 324, -1024, -666, -1, 0, 324, 32, 0, 432, 42, 3, 4, 1, 1]
|
||||
sorted = bead_sort(unsorted)
|
||||
say arrayToString(unsorted)
|
||||
say arrayToString(sorted)
|
||||
return
|
||||
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
method arrayToString(harry = Rexx[]) private static
|
||||
list = Rexx ''
|
||||
loop vv over harry
|
||||
list = list vv
|
||||
end vv
|
||||
return '['list.space(1, ',')']'
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
proc beadSort[T](a: var openarray[T]) =
|
||||
var max = low(T)
|
||||
var sum = 0
|
||||
|
||||
for x in a:
|
||||
if x > max: max = x
|
||||
|
||||
var beads = newSeq[int](max * a.len)
|
||||
|
||||
for i in 0 ..< a.len:
|
||||
for j in 0 ..< a[i]:
|
||||
beads[i * max + j] = 1
|
||||
|
||||
for j in 0 ..< max:
|
||||
sum = 0
|
||||
for i in 0 ..< a.len:
|
||||
sum += beads[i * max + j]
|
||||
beads[i * max + j] = 0
|
||||
|
||||
for i in a.len - sum ..< a.len:
|
||||
beads[i * max + j] = 1
|
||||
|
||||
for i in 0 ..< a.len:
|
||||
var j = 0
|
||||
while j < max and beads[i * max + j] > 0: inc j
|
||||
a[i] = j
|
||||
|
||||
var a = @[5, 3, 1, 7, 4, 1, 1, 20]
|
||||
beadSort a
|
||||
echo a
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
let rec columns l =
|
||||
match List.filter ((<>) []) l with
|
||||
[] -> []
|
||||
| l -> List.map List.hd l :: columns (List.map List.tl l)
|
||||
|
||||
let replicate n x = Array.to_list (Array.make n x)
|
||||
|
||||
let bead_sort l =
|
||||
List.map List.length (columns (columns (List.map (fun e -> replicate e 1) l)))
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
function sorted = beadsort(a)
|
||||
sorted = a;
|
||||
m = max(a);
|
||||
if ( any(a < 0) )
|
||||
error("can't sort");
|
||||
endif
|
||||
t = zeros(m, m);
|
||||
for i = 1:numel(a)
|
||||
t(i, 1:a(i)) = 1;
|
||||
endfor
|
||||
for i = 1:m
|
||||
s = sum(t(:, i));
|
||||
t(:, i) = 0;
|
||||
t(1:s, i) = 1;
|
||||
endfor
|
||||
for i = 1:numel(a)
|
||||
sorted(i) = sum(t(i, :));
|
||||
endfor
|
||||
endfunction
|
||||
|
||||
beadsort([5, 7, 1, 3, 1, 1, 20])
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
in='10 -12 1 0 999 8 2 2 4 4'
|
||||
Do i=1 To words(in)
|
||||
z.i=word(in,i)
|
||||
End
|
||||
n=i-1
|
||||
init=0
|
||||
Call minmax
|
||||
|
||||
beads.=0;
|
||||
Do i=1 To words(in)
|
||||
z=z.i
|
||||
beads.z+=1
|
||||
End
|
||||
j=0
|
||||
Do i=lo To hi
|
||||
Do While beads.i>0
|
||||
j+=1
|
||||
s.j=i
|
||||
beads.i-=1
|
||||
End;
|
||||
End;
|
||||
Call show ' Input:',z.,n
|
||||
Call show 'Sorted:',s.,n
|
||||
Exit
|
||||
|
||||
minmax:
|
||||
Do i=1 To n
|
||||
If init=0 Then Do
|
||||
init=1
|
||||
lo=z.i
|
||||
hi=z.i
|
||||
End
|
||||
Else Do
|
||||
lo=min(lo,z.i)
|
||||
hi=max(hi,z.i)
|
||||
End
|
||||
End
|
||||
Return
|
||||
|
||||
show: Procedure Expose n
|
||||
Use Arg txt,a.
|
||||
ol=txtg>
|
||||
Do i=1 To n
|
||||
ol=ol format(a.i,3)
|
||||
End
|
||||
Say ol
|
||||
Return
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
/*REXX program sorts a list of integers using a bead sort. */
|
||||
|
||||
/*get some grassHopper numbers. */
|
||||
grasshopper=,
|
||||
1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254 270
|
||||
|
||||
|
||||
|
||||
/*GreeenGrocer numbers are also called hexagonal pyramidal */
|
||||
/* numbers. */
|
||||
greengrocer=,
|
||||
0 4 16 40 80 140 224 336 480 660 880 1144 1456 1820 2240 2720 3264 3876 4560
|
||||
|
||||
|
||||
/*get some Bernoulli numerator numbers. */
|
||||
bernN='1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617 0 43867 0 -174611 0 854513'
|
||||
|
||||
|
||||
/*Psi is also called the Reduced Totient function, and */
|
||||
/* is also called Carmichale lambda, or LAMBDA function.*/
|
||||
psi=,
|
||||
1 1 2 2 4 2 6 2 6 4 10 2 12 6 4 4 16 6 18 4 6 10 22 2 20 12 18 6 28 4 30 8 10 16
|
||||
|
||||
|
||||
|
||||
list=grasshopper greengrocer bernN psi /*combine the four lists into one*/
|
||||
|
||||
|
||||
call showL 'before sort',list /*show list before sorting. */
|
||||
!=beadSort(list) /*invoke the bead sort. */
|
||||
call showL ' after sort',! /*show after array elements*/
|
||||
exit
|
||||
|
||||
|
||||
/*─────────────────────────────────beadSort@ subroutine────────────*/
|
||||
beadSort: procedure expose _.
|
||||
parse arg z
|
||||
!='' /*this'll be the sorted list*/
|
||||
low=999999999; high=-low /*define the low and high #s*/
|
||||
_.=0 /*define all beads to zero. */
|
||||
|
||||
|
||||
do j=1 until z=='' /*pick the meat off the bone*/
|
||||
parse var z x z
|
||||
if \datatype(x,'Whole') then
|
||||
do
|
||||
say
|
||||
say '*** error! ***'
|
||||
say
|
||||
say 'element' j "in list isn't numeric:" x
|
||||
say
|
||||
exit 13
|
||||
end
|
||||
|
||||
x=x/1 /*normalize number, it could*/
|
||||
/*be: +4 007 5. 2e3 etc.*/
|
||||
_.x=_.x+1 /*indicate this bead has a #*/
|
||||
low=min(low,x) /*keep track of the lowest #*/
|
||||
high=max(high,x) /* " " " " highest#*/
|
||||
end j
|
||||
|
||||
/*now, collect the beads and*/
|
||||
do m=low to high /*let them fall (to zero). */
|
||||
if _.m==0 then iterate /*No bead here? Keep looking*/
|
||||
do n=1 for _.m /*let the beads fall to 0. */
|
||||
!=! m /*add it to the sorted list.*/
|
||||
end n
|
||||
end m
|
||||
|
||||
return !
|
||||
|
||||
|
||||
/*─────────────────────────────────────SHOW@ subroutine────────────*/
|
||||
showL:
|
||||
widthH=length(words(arg(2))) /*maximum width of the index*/
|
||||
|
||||
do j=1 for words(arg(2))
|
||||
say 'element' right(j,widthH) arg(1)":" right(word(arg(2),j),10)
|
||||
end j
|
||||
|
||||
say copies('─',80) /*show a separator line. */
|
||||
return
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
FUNCTION beadSort RETURNS CHAR (
|
||||
i_c AS CHAR
|
||||
):
|
||||
|
||||
DEF VAR cresult AS CHAR.
|
||||
DEF VAR ii AS INT.
|
||||
DEF VAR inumbers AS INT.
|
||||
DEF VAR irod AS INT.
|
||||
DEF VAR irods AS INT.
|
||||
DEF VAR crod AS CHAR.
|
||||
DEF VAR cbeads AS CHAR EXTENT.
|
||||
|
||||
inumbers = NUM-ENTRIES( i_c ).
|
||||
|
||||
/* determine number of rods needed */
|
||||
DO ii = 1 TO inumbers:
|
||||
irods = MAXIMUM( irods, INTEGER( ENTRY( ii, i_c ) ) ).
|
||||
END.
|
||||
|
||||
/* put beads on rods */
|
||||
EXTENT( cbeads ) = inumbers.
|
||||
DO ii = 1 TO inumbers:
|
||||
cbeads[ ii ] = FILL( "X", INTEGER( ENTRY( ii, i_c ) ) ).
|
||||
END.
|
||||
|
||||
/* drop beads on each rod */
|
||||
DO irod = 1 TO irods:
|
||||
crod = "".
|
||||
DO ii = 1 TO inumbers:
|
||||
crod = crod + SUBSTRING( cbeads[ ii ], irod, 1 ).
|
||||
END.
|
||||
crod = REPLACE( crod, " ", "" ).
|
||||
DO ii = 1 TO inumbers.
|
||||
SUBSTRING( cbeads[ ii ], irod, 1 ) = STRING( ii <= LENGTH( crod ), "X/ " ).
|
||||
END.
|
||||
END.
|
||||
|
||||
/* get beads from rods */
|
||||
DO ii = 1 TO inumbers:
|
||||
cresult = cresult + "," + STRING( LENGTH( REPLACE( cbeads[ ii ], " ", "" ) ) ).
|
||||
END.
|
||||
|
||||
RETURN SUBSTRING( cresult, 2 ).
|
||||
|
||||
END FUNCTION. /* beadSort */
|
||||
|
||||
MESSAGE
|
||||
"5,2,4,1,3,3,9 -> " beadSort( "5,2,4,1,3,3,9" ) SKIP
|
||||
"5,3,1,7,4,1,1 -> " beadSort( "5,3,1,7,4,1,1" ) SKIP(1)
|
||||
beadSort( "88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1" )
|
||||
VIEW-AS ALERT-BOX.
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
beadsort(v)={
|
||||
my(sz=vecmax(v),M=matrix(#v,sz,i,j,v[i]>=j)); \\ Set up beads
|
||||
for(i=1,sz,M[,i]=countingSort(M[,i],0,1)~); \\ Let them fall
|
||||
vector(#v,i,value(M[i,])) \\ Convert back to numbers
|
||||
};
|
||||
|
||||
countingSort(v,mn,mx)={
|
||||
my(u=vector(#v),i=0);
|
||||
for(n=mn,mx,
|
||||
for(j=1,#v,if(v[j]==n,u[i++]=n))
|
||||
);
|
||||
u
|
||||
};
|
||||
|
||||
value(v)={
|
||||
if(#v==0 || !v[1], return(0));
|
||||
if(v[#v], return(#v));
|
||||
my(left=1, right=#v, mid);
|
||||
while (right - left > 1,
|
||||
mid=(right+left)\2;
|
||||
if(v[mid], left=mid, right=mid)
|
||||
);
|
||||
left
|
||||
};
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
<?php
|
||||
function columns($arr) {
|
||||
if (count($arr) == 0)
|
||||
return array();
|
||||
else if (count($arr) == 1)
|
||||
return array_chunk($arr[0], 1);
|
||||
|
||||
array_unshift($arr, NULL);
|
||||
// array_map(NULL, $arr[0], $arr[1], ...)
|
||||
$transpose = call_user_func_array('array_map', $arr);
|
||||
return array_map('array_filter', $transpose);
|
||||
}
|
||||
|
||||
function beadsort($arr) {
|
||||
foreach ($arr as $e)
|
||||
$poles []= array_fill(0, $e, 1);
|
||||
return array_map('count', columns(columns($poles)));
|
||||
}
|
||||
|
||||
print_r(beadsort(array(5,3,1,7,4,1,1)));
|
||||
?>
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
/* Handles both negative and positive values. */
|
||||
|
||||
maxval: procedure (z) returns (fixed binary);
|
||||
declare z(*) fixed binary;
|
||||
declare (maxv initial (0), i) fixed binary;
|
||||
do i = lbound(z,1) to hbound(z,1);
|
||||
maxv = max(z(i), maxv);
|
||||
end;
|
||||
put skip data (maxv); put skip;
|
||||
return (maxv);
|
||||
end maxval;
|
||||
minval: procedure (z) returns (fixed binary);
|
||||
declare z(*) fixed binary;
|
||||
declare (minv initial (0), i) fixed binary;
|
||||
|
||||
do i = lbound(z,1) to hbound(z,1);
|
||||
if z(i) < 0 then minv = min(z(i), minv);
|
||||
end;
|
||||
put skip data (minv); put skip;
|
||||
return (minv);
|
||||
end minval;
|
||||
|
||||
/* To deal with negative values, array elements are incremented */
|
||||
/* by the greatest (in magnitude) negative value, thus making */
|
||||
/* them positive. The resultant values are stored in an */
|
||||
/* unsigned array (PL/I provides both signed and unsigned data */
|
||||
/* types). At procedure end, the array values are restored to */
|
||||
/* original values. */
|
||||
|
||||
(subrg, fofl, size, stringrange, stringsize):
|
||||
beadsort: procedure (z); /* 8-1-2010 */
|
||||
declare (z(*)) fixed binary;
|
||||
declare b(maxval(z)-minval(z)+1) bit (maxval(z)-minval(z)+1) aligned;
|
||||
declare (i, j, k, m, n) fixed binary;
|
||||
declare a(hbound(z,1)) fixed binary unsigned;
|
||||
declare offset fixed binary initial (minval(z));
|
||||
|
||||
PUT SKIP LIST('CHECKPOINT A'); PUT SKIP;
|
||||
n = hbound(z,1);
|
||||
m = hbound(b,1);
|
||||
|
||||
if offset < 0 then
|
||||
a = z - offset;
|
||||
else
|
||||
a = z;
|
||||
|
||||
b = '0'b;
|
||||
|
||||
do i = 1 to n;
|
||||
substr(b(i), 1, a(i)) = copy('1'b, a(i));
|
||||
end;
|
||||
do j = 1 to m; put skip list (b(j)); end;
|
||||
|
||||
do j = 1 to m;
|
||||
k = 0;
|
||||
do i =1 to n;
|
||||
if substr(b(i), j, 1) then k = k + 1;
|
||||
end;
|
||||
do i = 1 to n;
|
||||
substr(b(i), j, 1) = (i <= k);
|
||||
end;
|
||||
end;
|
||||
put skip;
|
||||
do j = 1 to m; put skip list (b(j)); end;
|
||||
|
||||
do i = 1 to n;
|
||||
k = 0;
|
||||
do j = 1 to m; k = k + substr(b(i), j, 1); end;
|
||||
a(i) = k;
|
||||
end;
|
||||
if offset < 0 then z = a + offset; else z = a;
|
||||
|
||||
end beadsort;
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
*process source attributes xref;
|
||||
/* Handles both negative and positive values. */
|
||||
Beadsort: Proc Options(main);
|
||||
Dcl sysprint Print;
|
||||
Dcl (hbound,max,min) Builtin;
|
||||
|
||||
Dcl z(10) Bin Fixed(31) Init(10,-12,1,0,999,8,2,2,4,4);
|
||||
Dcl s(10) Bin Fixed(31);
|
||||
Dcl (init,lo,hi) Bin Fixed(31) Init(0);
|
||||
Dcl (i,j) Bin Fixed(31) Init(0);
|
||||
|
||||
Call minmax(z,init,lo,hi);
|
||||
|
||||
Begin;
|
||||
Dcl beads(lo:hi) Bin Fixed(31);
|
||||
beads=0;
|
||||
Do i=1 To hbound(z);
|
||||
beads(z(i))+=1;
|
||||
End;
|
||||
Do i=lo To hi;
|
||||
Do While(beads(i)>0);
|
||||
j+=1;
|
||||
s(j)=i;
|
||||
beads(i)-=1;
|
||||
End;
|
||||
End;
|
||||
Put Edit(' Input:',(z(i) Do i=1 To hbound(z)))(skip,a,99(f(4)));
|
||||
Put Edit('Sorted:',(s(i) Do i=1 To hbound(s)))(skip,a,99(f(4)));
|
||||
End;
|
||||
|
||||
minmax: Proc(z,init,lo,hi);
|
||||
Dcl z(*) Bin Fixed(31);
|
||||
Dcl (init,lo,hi) Bin Fixed(31);
|
||||
Do i=1 To hbound(z);
|
||||
If init=0 Then Do;
|
||||
init=1;
|
||||
lo,hi=z(i);
|
||||
End;
|
||||
Else Do;
|
||||
lo=min(lo,z(i));
|
||||
hi=max(hi,z(i));
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
End;
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
program BDS;
|
||||
const MAX = 1000;
|
||||
type
|
||||
type_matrix = record
|
||||
lin,col:integer;
|
||||
matrix: array [1..MAX,1..MAX] of boolean;
|
||||
end;
|
||||
|
||||
type_vector = record
|
||||
size:integer;
|
||||
vector: array[1..MAX] of integer;
|
||||
end;
|
||||
|
||||
procedure BeadSort(var v:type_vector);
|
||||
var
|
||||
i,j,k,sum:integer;
|
||||
m:type_matrix;
|
||||
begin
|
||||
m.lin:=v.size;
|
||||
|
||||
(* the number of columns is equal to the greatest element *)
|
||||
m.col:=0;
|
||||
for i:=1 to v.size do
|
||||
if v.vector[i] > m.col then
|
||||
m.col:=v.vector[i];
|
||||
|
||||
(* initializing the matrix *)
|
||||
for j:=1 to m.lin do
|
||||
begin
|
||||
k:=1;
|
||||
for i:=m.col downto 1 do
|
||||
begin
|
||||
if v.vector[j] >= k then
|
||||
m.matrix[i,j]:=TRUE
|
||||
else
|
||||
m.matrix[i,j]:=FALSE;
|
||||
k:=k+1;
|
||||
end;
|
||||
end;
|
||||
|
||||
(* Sort the matrix *)
|
||||
for i:=1 to m.col do
|
||||
begin
|
||||
(* Count the beads and set the line equal FALSE *)
|
||||
sum:=0;
|
||||
for j:=1 to m.lin do
|
||||
begin
|
||||
if m.matrix[i,j] then
|
||||
sum:=sum+1;
|
||||
m.matrix[i,j]:=FALSE;
|
||||
end;
|
||||
|
||||
(* The line receives the bead sorted *)
|
||||
for j:=m.lin downto m.lin-sum+1 do
|
||||
m.matrix[i,j]:=TRUE;
|
||||
end;
|
||||
|
||||
(* Convert the sorted bead matrix to a sorted vector *)
|
||||
for j:=1 to m.lin do
|
||||
begin
|
||||
v.vector[j]:=0;
|
||||
i:=m.col;
|
||||
while (m.matrix[i,j] = TRUE)and(i>=1) do
|
||||
begin
|
||||
v.vector[j]+=1;
|
||||
i:=i-1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure print_vector(var v:type_vector);
|
||||
var i:integer;
|
||||
begin
|
||||
for i:=1 to v.size do
|
||||
write(v.vector[i],' ');
|
||||
writeln;
|
||||
end;
|
||||
|
||||
var
|
||||
i:integer;
|
||||
v:type_vector;
|
||||
begin
|
||||
writeln('How many numbers do you want to sort?');
|
||||
readln(v.size);
|
||||
writeln('Write the numbers:');
|
||||
|
||||
for i:=1 to v.size do
|
||||
read(v.vector[i]);
|
||||
|
||||
writeln('Before sort:');
|
||||
print_vector(v);
|
||||
|
||||
BeadSort(v);
|
||||
|
||||
writeln('After sort:');
|
||||
print_vector(v);
|
||||
end.
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
sub beadsort {
|
||||
my @data = @_;
|
||||
|
||||
my @columns;
|
||||
my @rows;
|
||||
|
||||
for my $datum (@data) {
|
||||
for my $column ( 0 .. $datum-1 ) {
|
||||
++ $rows[ $columns[$column]++ ];
|
||||
}
|
||||
}
|
||||
|
||||
return reverse @rows;
|
||||
}
|
||||
|
||||
beadsort 5, 7, 1, 3, 1, 1, 20;
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">beadsort</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">poles</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">max</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">poles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">poles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]],</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">poles</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">poles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_add</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">poles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]],</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">a</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #0000FF;">?</span><span style="color: #000000;">beadsort</span><span style="color: #0000FF;">({</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">20</span><span style="color: #0000FF;">})</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(de beadSort (Lst)
|
||||
(let Abacus (cons NIL)
|
||||
(for N Lst # Thread beads on poles
|
||||
(for (L Abacus (ge0 (dec 'N)) (cdr L))
|
||||
(or (cdr L) (queue 'L (cons)))
|
||||
(push (cadr L) T) ) )
|
||||
(make
|
||||
(while (gt0 (cnt pop (cdr Abacus))) # Drop and count beads
|
||||
(link @) ) ) ) )
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
Function BeadSort ( [Int64[]] $indata )
|
||||
{
|
||||
if( $indata.length -gt 1 )
|
||||
{
|
||||
$min = $indata[ 0 ]
|
||||
$max = $indata[ 0 ]
|
||||
for( $i = 1; $i -lt $indata.length; $i++ )
|
||||
{
|
||||
if( $indata[ $i ] -lt $min )
|
||||
{
|
||||
$min = $indata[ $i ]
|
||||
}
|
||||
if( $indata[ $i ] -gt $max ) {
|
||||
$max = $indata[ $i ]
|
||||
}
|
||||
} #Find the min & max
|
||||
$poles = New-Object 'UInt64[]' ( $max - $min + 1 )
|
||||
$indata | ForEach-Object {
|
||||
$min..$_ | ForEach-Object {
|
||||
$poles[ $_ - $min ] += 1
|
||||
}
|
||||
} #Add Beads to the poles, already moved to the bottom
|
||||
$min..( $max - 1 ) | ForEach-Object {
|
||||
$i = $_ - $min
|
||||
if( $poles[ $i ] -gt $poles[ $i + 1 ] )
|
||||
{ #No special case needed for min, since there will always be at least 1 = min
|
||||
( $poles[ $i ] )..( $poles[ $i + 1 ] + 1 ) | ForEach-Object {
|
||||
Write-Output ( $i + $min )
|
||||
}
|
||||
}
|
||||
} #Output the results in pipeline fashion
|
||||
1..( $poles[ $max - $min ] ) | ForEach-Object {
|
||||
Write-Output $max #No special case needed for max, since there will always be at least 1 = max
|
||||
}
|
||||
} else {
|
||||
Write-Output $indata
|
||||
}
|
||||
}
|
||||
|
||||
$l = 100; BeadSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( -( $l - 1 ), $l - 1 ) } )
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
#MAXNUM=100
|
||||
|
||||
Dim MyData(Random(15)+5)
|
||||
Global Dim Abacus(0,0)
|
||||
|
||||
Declare BeadSort(Array InData(1))
|
||||
Declare PresentData(Array InData(1))
|
||||
|
||||
If OpenConsole()
|
||||
Define i
|
||||
;- Generate a random array
|
||||
For i=0 To ArraySize(MyData())
|
||||
MyData(i)=Random(#MAXNUM)
|
||||
Next i
|
||||
PresentData(MyData())
|
||||
;
|
||||
;- Sort the array
|
||||
BeadSort(MyData())
|
||||
PresentData(MyData())
|
||||
;
|
||||
Print("Press ENTER to exit"): Input()
|
||||
EndIf
|
||||
|
||||
Procedure LetFallDown(x)
|
||||
Protected y=ArraySize(Abacus(),2)-1
|
||||
Protected ylim=y
|
||||
While y>=0
|
||||
If Abacus(x,y) And Not Abacus(x,y+1)
|
||||
Swap Abacus(x,y), Abacus(x,y+1)
|
||||
If y<ylim: y+1: Continue: EndIf
|
||||
Else
|
||||
y-1
|
||||
EndIf
|
||||
Wend
|
||||
EndProcedure
|
||||
|
||||
Procedure BeadSort(Array n(1))
|
||||
Protected i, j, k
|
||||
NewList T()
|
||||
Dim Abacus(#MAXNUM,ArraySize(N()))
|
||||
;- Set up the abacus
|
||||
For i=0 To ArraySize(Abacus(),2)
|
||||
For j=1 To N(i)
|
||||
Abacus(j,i)=#True
|
||||
Next
|
||||
Next
|
||||
;- sort it in threads to simulate free beads falling down
|
||||
For i=0 To #MAXNUM
|
||||
AddElement(T()): T()=CreateThread(@LetFallDown(),i)
|
||||
Next
|
||||
ForEach T()
|
||||
WaitThread(T())
|
||||
Next
|
||||
;- send it back to a normal array
|
||||
For j=0 To ArraySize(Abacus(),2)
|
||||
k=0
|
||||
For i=0 To ArraySize(Abacus())
|
||||
k+Abacus(i,j)
|
||||
Next
|
||||
N(j)=k
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure PresentData(Array InData(1))
|
||||
Protected n, m, sum
|
||||
PrintN(#CRLF$+"The array is;")
|
||||
For n=0 To ArraySize(InData())
|
||||
m=InData(n): sum+m
|
||||
Print(Str(m)+" ")
|
||||
Next
|
||||
PrintN(#CRLF$+"And its sum= "+Str(sum))
|
||||
EndProcedure
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
#!/bin/python3
|
||||
from itertools import zip_longest
|
||||
|
||||
# This is wrong, it works only on specific examples
|
||||
def beadsort(l):
|
||||
return list(map(sum, zip_longest(*[[1] * e for e in l], fillvalue=0)))
|
||||
|
||||
|
||||
# Demonstration code:
|
||||
print(beadsort([5,3,1,7,4,1,1]))
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
#lang QB64
|
||||
'***************************************************
|
||||
'* BeadSort is VERY fast for small CGSortLibArray(max)-CGSortLibArray(min). Typical performance is
|
||||
'* O(NlogN) or better. However as the key values (array values and ranges) go up, the performance
|
||||
'* drops steeply excellent for small-ranged arrays. Integer only at this point. Throughput is
|
||||
'* roughly 900k/GHzS for double-precision, with binary range (0,1). Related to CountingSort()
|
||||
'***************************************************
|
||||
SUB BeadSort (CGSortLibArray() AS DOUBLE, start AS LONG, finish AS LONG, order&)
|
||||
DIM MAX AS DOUBLE: MAX = CGSortLibArray(start)
|
||||
DIM BeadSort_Sum AS DOUBLE
|
||||
DIM BeadSort_I AS LONG
|
||||
DIM BeadSort_J AS LONG
|
||||
FOR BeadSort_I = start + 1 TO (finish - start)
|
||||
IF (CGSortLibArray(BeadSort_I) > MAX) THEN MAX = CGSortLibArray(BeadSort_I)
|
||||
NEXT
|
||||
REDIM beads((finish - start), MAX)
|
||||
FOR BeadSort_I = 0 TO (finish - start) - 1
|
||||
FOR BeadSort_J = 0 TO CGSortLibArray(BeadSort_I) - 1
|
||||
beads(BeadSort_I, BeadSort_J) = 1
|
||||
NEXT
|
||||
NEXT
|
||||
IF order& = 1 THEN
|
||||
FOR BeadSort_J = 0 TO MAX
|
||||
BeadSort_Sum = 0
|
||||
FOR BeadSort_I = 0 TO (finish - start)
|
||||
BeadSort_Sum = BeadSort_Sum + beads(BeadSort_I, BeadSort_J)
|
||||
beads(BeadSort_I, BeadSort_J) = 0
|
||||
NEXT
|
||||
FOR BeadSort_I = (finish - start) - BeadSort_Sum TO (finish - start)
|
||||
beads(BeadSort_I, BeadSort_J) = 1
|
||||
NEXT
|
||||
NEXT
|
||||
FOR BeadSort_I = 0 TO (finish - start)
|
||||
BeadSort_J = 0
|
||||
WHILE BeadSort_J < MAX AND beads(BeadSort_I, BeadSort_J)
|
||||
BeadSort_J = BeadSort_J + 1
|
||||
WEND
|
||||
CGSortLibArray(BeadSort_I) = BeadSort_J
|
||||
NEXT
|
||||
ELSE
|
||||
FOR BeadSort_J = MAX TO 0 STEP -1
|
||||
BeadSort_Sum = 0
|
||||
FOR I = 0 TO (finish - start)
|
||||
BeadSort_Sum = BeadSort_Sum + beads(I, BeadSort_J)
|
||||
beads(I, BeadSort_J) = 0
|
||||
NEXT
|
||||
FOR I = (finish - start) TO (finish - start) - BeadSort_Sum STEP -1
|
||||
beads(I, BeadSort_J) = 1
|
||||
NEXT
|
||||
NEXT
|
||||
FOR BeadSort_I = 0 TO (finish - start)
|
||||
BeadSort_J = 0
|
||||
WHILE BeadSort_J < MAX AND beads(BeadSort_I, BeadSort_J)
|
||||
BeadSort_J = BeadSort_J + 1
|
||||
WEND
|
||||
CGSortLibArray(finish - BeadSort_I) = BeadSort_J
|
||||
NEXT
|
||||
END IF
|
||||
END SUB
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
/*REXX program sorts a list (4 groups) of integers using the bead sort algorithm. */
|
||||
/* original source by Gerard Schildberger */
|
||||
/* 20230605 Walter Pachl reformatted and refurbished */
|
||||
/* define two dozen grasshopper numbers. */
|
||||
/* source ?? */
|
||||
gHopper=1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254,
|
||||
270
|
||||
/* these are also called hexagonal pyramidal #s. */
|
||||
/* see https://oeis.org/A002412 */
|
||||
greenGrocer=0 4 16 40 80 140 224 336 480 660 880 1144 1456 1820 2240 2720 3264 3876,
|
||||
4560
|
||||
/* define twenty-three Bernoulli numerator numbers*/
|
||||
/* source ?? quotes needed because of negative #s.*/
|
||||
bernN='1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617 0 43867 0 -174611 0'
|
||||
/* also called the Reduced Totient function, */
|
||||
/* and is also called Carmichael lambda, */
|
||||
/* or the LAMBDA function */
|
||||
/* see https://en.wikipedia.org/wiki/Carmichael_function */
|
||||
psi=1 1 2 2 4 2 6 2 6 4 10 2 12 6 4 4 16 6 18 4 6 10 22 2 20 12 18 6 28 4 30 8 10 16
|
||||
list=gHopper greenGrocer bernN psi /*combine the four lists into one list.*/
|
||||
Call show 'before sort',list /*display the list before sorting. */
|
||||
Say copies('¦', 75) /*show long separator line before sort.*/
|
||||
Call show ' after sort',beadSort(list) /*display the list after sorting. */
|
||||
Exit /*stick a fork in it, we're all done. */
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
beadSort: Procedure
|
||||
Parse Arg list 1 low . 1 high . /* List to be sorted and first value */
|
||||
occurences.=0 /* count stem occurences */
|
||||
Do Until list=='' /* loop through the list */
|
||||
Parse Var list bead list /* take an element */
|
||||
bead= bead / 1 /* normalize the value */
|
||||
occurences.bead=occurences.bead + 1 /* bump occurences */
|
||||
low= min(low, bead) /* track lowest */
|
||||
high=max(high,bead) /* and highest number */
|
||||
End
|
||||
sorted='' /* now, collect the beads */
|
||||
Do v=low To high
|
||||
If occurences.v>0 Then
|
||||
sorted=sorted copies(v' ', occurences.v)
|
||||
End
|
||||
Return sorted
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
show:
|
||||
Parse Arg txt,slist
|
||||
n=words(slist)
|
||||
w=length(n)
|
||||
Do k=1 For n
|
||||
Say right('element',30) right(k,w) txt':' right(word(slist,k),9)
|
||||
End
|
||||
Return
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#lang racket
|
||||
(require rackunit)
|
||||
|
||||
(define (columns lst)
|
||||
(match (filter (λ (l) (not (empty? l))) lst)
|
||||
['() '()]
|
||||
[l (cons (map car l) (columns (map cdr l)))]))
|
||||
|
||||
(define (bead-sort lst)
|
||||
(map length (columns (columns (map (λ (n) (make-list n 1)) lst)))))
|
||||
|
||||
;; unit test
|
||||
(check-equal?
|
||||
(bead-sort '(5 3 1 7 4 1 1))
|
||||
'(7 5 4 3 1 1 1))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
# routine cribbed from List::Utils;
|
||||
sub transpose(@list is copy) {
|
||||
gather {
|
||||
while @list {
|
||||
my @heads;
|
||||
if @list[0] !~~ Positional { @heads = @list.shift; }
|
||||
else { @heads = @list.map({$_.shift unless $_ ~~ []}); }
|
||||
@list = @list.map({$_ unless $_ ~~ []});
|
||||
take [@heads];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub beadsort(@l) {
|
||||
(transpose(transpose(map {[1 xx $_]}, @l))).map(*.elems);
|
||||
}
|
||||
|
||||
my @list = 2,1,3,5;
|
||||
say beadsort(@list).perl;
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
sub beadsort(*@list) {
|
||||
my @rods;
|
||||
for words ^«@list -> $x { @rods[$x].push(1) }
|
||||
gather for ^@rods[0] -> $y {
|
||||
take [+] @rods.map: { .[$y] // last }
|
||||
}
|
||||
}
|
||||
|
||||
say beadsort 2,1,3,5;
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
class Array
|
||||
def beadsort
|
||||
map {|e| [1] * e}.columns.columns.map(&:length)
|
||||
end
|
||||
|
||||
def columns
|
||||
y = length
|
||||
x = map(&:length).max
|
||||
Array.new(x) do |row|
|
||||
Array.new(y) { |column| self[column][row] }.compact # Remove nils.
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
# Demonstration code:
|
||||
p [5,3,1,7,4,1,1].beadsort
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
$ include "seed7_05.s7i";
|
||||
|
||||
const proc: beadSort (inout array integer: a) is func
|
||||
local
|
||||
var integer: max is 0;
|
||||
var integer: sum is 0;
|
||||
var array bitset: beads is 0 times {};
|
||||
var integer: i is 0;
|
||||
var integer: j is 0;
|
||||
begin
|
||||
beads := length(a) times {};
|
||||
for i range 1 to length(a) do
|
||||
if a[i] > max then
|
||||
max := a[i];
|
||||
end if;
|
||||
beads[i] := {1 .. a[i]};
|
||||
end for;
|
||||
for j range 1 to max do
|
||||
sum := 0;
|
||||
for i range 1 to length(a) do
|
||||
sum +:= ord(j in beads[i]);
|
||||
end for;
|
||||
for i range length(a) downto length(a) - sum + 1 do
|
||||
a[i] := j;
|
||||
end for;
|
||||
end for;
|
||||
end func;
|
||||
|
||||
const proc: main is func
|
||||
local
|
||||
var array integer: a is [] (5, 3, 1, 7, 4, 1, 1, 20);
|
||||
var integer: n is 0;
|
||||
begin
|
||||
beadSort(a);
|
||||
for n range a do
|
||||
write(n <& " ");
|
||||
end for;
|
||||
writeln;
|
||||
end func;
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
func beadsort(arr) {
|
||||
|
||||
var rows = []
|
||||
var columns = []
|
||||
|
||||
for datum in arr {
|
||||
for column in ^datum {
|
||||
++(columns[column] := 0)
|
||||
++(rows[columns[column] - 1] := 0)
|
||||
}
|
||||
}
|
||||
|
||||
rows.reverse
|
||||
}
|
||||
|
||||
say beadsort([5,3,1,7,4,1,1])
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
fun columns l =
|
||||
case List.filter (not o null) l of
|
||||
[] => []
|
||||
| l => map hd l :: columns (map tl l)
|
||||
|
||||
fun replicate (n, x) = List.tabulate (n, fn _ => x)
|
||||
|
||||
fun bead_sort l =
|
||||
map length (columns (columns (map (fn e => replicate (e, 1)) l)))
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
package require Tcl 8.5
|
||||
|
||||
proc beadsort numList {
|
||||
# Special case: empty list is empty when sorted.
|
||||
if {![llength $numList]} return
|
||||
# Set up the abacus...
|
||||
foreach n $numList {
|
||||
for {set i 0} {$i<$n} {incr i} {
|
||||
dict incr vals $i
|
||||
}
|
||||
}
|
||||
# Make the beads fall...
|
||||
foreach n [dict values $vals] {
|
||||
for {set i 0} {$i<$n} {incr i} {
|
||||
dict incr result $i
|
||||
}
|
||||
}
|
||||
# And the result is...
|
||||
dict values $result
|
||||
}
|
||||
|
||||
# Demonstration code
|
||||
puts [beadsort {5 3 1 7 4 1 1}]
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
Option Base 1
|
||||
|
||||
Private Function sq_add(arr As Variant, x As Double) As Variant
|
||||
Dim res() As Variant
|
||||
ReDim res(UBound(arr))
|
||||
For i = 1 To UBound(arr)
|
||||
res(i) = arr(i) + x
|
||||
Next i
|
||||
sq_add = res
|
||||
End Function
|
||||
|
||||
Private Function beadsort(ByVal a As Variant) As Variant
|
||||
Dim poles() As Variant
|
||||
ReDim poles(WorksheetFunction.Max(a))
|
||||
For i = 1 To UBound(a)
|
||||
For j = 1 To a(i)
|
||||
poles(j) = poles(j) + 1
|
||||
Next j
|
||||
Next i
|
||||
For j = 1 To UBound(a)
|
||||
a(j) = 0
|
||||
Next j
|
||||
For i = 1 To UBound(poles)
|
||||
For j = 1 To poles(i)
|
||||
a(j) = a(j) + 1
|
||||
Next j
|
||||
Next i
|
||||
beadsort = a
|
||||
End Function
|
||||
|
||||
Public Sub main()
|
||||
Debug.Print Join(beadsort([{5, 3, 1, 7, 4, 1, 1, 20}]), ", ")
|
||||
End Sub
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
var beadSort = Fn.new { |a|
|
||||
var res = []
|
||||
var max = a.reduce { |acc, i| (i > acc) ? i : acc }
|
||||
var trans = [0] * max
|
||||
for (i in a) {
|
||||
for (n in 0...i) trans[n] = trans[n] + 1
|
||||
}
|
||||
for (i in a) {
|
||||
res.add(trans.count { |n| n > 0 })
|
||||
for (n in 0...trans.count) trans[n] = trans[n] - 1
|
||||
}
|
||||
return res[-1..0] // return in ascending order
|
||||
}
|
||||
|
||||
var as = [ [4, 65, 2, 31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
|
||||
for (a in as) {
|
||||
System.print("Before: %(a)")
|
||||
a = beadSort.call(a)
|
||||
System.print("After : %(a)")
|
||||
System.print()
|
||||
}
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
include c:\cxpl\codes;
|
||||
|
||||
proc BeadSort(Array, Length); \Sort Array into increasing order
|
||||
int Array, Length; \Array contents range 0..31; number of items
|
||||
int Row, I, J, T, C;
|
||||
[Row:= Reserve(Length*4); \each Row has room for 32 beads
|
||||
for I:= 0 to Length-1 do \each Row gets Array(I) number of beads
|
||||
Row(I):= ~-1<<Array(I); \(beware for 80186..Pentium <<32 doesn't shift)
|
||||
for J:= 1 to Length-1 do
|
||||
for I:= Length-1 downto J do
|
||||
[T:= Row(I-1) & ~Row(I); \up to 31 beads fall in a single pass
|
||||
Row(I-1):= Row(I-1) | T; \(|=xor, !=or)
|
||||
Row(I):= Row(I) | T;
|
||||
];
|
||||
for I:= 0 to Length-1 do \count beads in each Row
|
||||
[C:= 0; T:= Row(I);
|
||||
while T do
|
||||
[if T&1 then C:= C+1; T:= T>>1];
|
||||
Array(I):= C; \count provides sorted order
|
||||
];
|
||||
];
|
||||
|
||||
int A, I;
|
||||
[A:= [3, 1, 4, 1, 25, 9, 2, 6, 5, 0];
|
||||
BeadSort(A, 10);
|
||||
for I:= 0 to 10-1 do [IntOut(0, A(I)); ChOut(0, ^ )];
|
||||
]
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
fcn columns(m){ // m is list of lists of zeros/beads, # beads is n, eg (0,0,0)==3
|
||||
m
|
||||
.apply("len") // (0,0,0)-->3
|
||||
.reduce("max") // largest bead stack
|
||||
.walker() // [0..max]
|
||||
.apply('wrap(i){ m.filter('wrap(s){ s.len() > i }).len().pump(List,0) });
|
||||
}
|
||||
|
||||
fcn beadSort(data){
|
||||
data.apply("pump",List,0):columns(_):columns(_).apply("len");
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
T(5,3,1,7,4,1,1):beadSort(_).println();
|
||||
T(4,3,3,2,1):beadSort(_).println();
|
||||
Loading…
Add table
Add a link
Reference in a new issue