2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,5 +1,10 @@
|
|||
{{Sorting Algorithm}}
|
||||
In this task, the goal is to sort an array of positive integers using the [[wp:Bead_sort|Bead Sort Algorithm]].
|
||||
|
||||
Algorithm has O(S), where S is the sum of the integers in the input set: Each bead is moved individually.
|
||||
;Task:
|
||||
Sort an array of positive integers using the [[wp:Bead_sort|Bead Sort Algorithm]].
|
||||
|
||||
|
||||
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,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,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,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))
|
||||
|
|
@ -1,4 +1,15 @@
|
|||
use List::Utils;
|
||||
# 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);
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
sub beadsort(*@list) {
|
||||
my @rods;
|
||||
for ^«@list -> $x { @rods[$x].push(1) }
|
||||
for words ^«@list -> $x { @rods[$x].push(1) }
|
||||
gather for ^@rods[0] -> $y {
|
||||
take [+] @rods.map: { .[$y] // last }
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,46 +1,44 @@
|
|||
/*REXX program sorts a list of integers using a bead sort algorithm.*/
|
||||
grasshopper=, /*get 2 dozen grasshopper numbers*/
|
||||
1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254 270
|
||||
/*REXX program sorts a list of integers using the bead sort algorithm. */
|
||||
grasshopper=, /*define two dozen grasshopper numbers.*/
|
||||
1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254 270
|
||||
|
||||
/*Green Grocer numbers are also */
|
||||
greenGrocer=, /*called hexagonal pyramidal nums*/
|
||||
0 4 16 40 80 140 224 336 480 660 880 1144 1456 1820 2240 2720 3264 3876 4560
|
||||
/*Green Grocer 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 23 Bernoulli numerator nums*/
|
||||
bernN='1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617 0 43867 0 -174611 0 854513'
|
||||
/*define 23 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*/
|
||||
psi=, /*also called Carmichale lambda, or the LAMBDA function.*/
|
||||
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
|
||||
/*Psi is also called the Reduced Totient function, and is*/
|
||||
psi=, /*also called Carmichael lambda, or the LAMBDA function.*/
|
||||
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
|
||||
|
||||
#s=grasshopper greenGrocer bernN psi /*combine the four lists into one*/
|
||||
call show 'before sort', #s /*show the list before sorting.*/
|
||||
call show ' after sort', beadSort(#s) /*show the list after sorting.*/
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────SHOW@ subroutine────────────────────*/
|
||||
beadSort: procedure; parse arg low . 1 high . 1 z,$ /*$: the list to be*/
|
||||
@.=0 /*set all beads (@.) to zero. */
|
||||
do j=1 until z==''; parse var z x z /*pick the meat off the bone.*/
|
||||
if \datatype(x,'W') then do; say '*** error! ***'
|
||||
say 'element' j "in list isn't numeric:" x
|
||||
say; exit 13
|
||||
end /* [↑] exit program with RC=13. */
|
||||
x=x/1 /*normalize X: 4. 004 +4 .4e0 ···*/
|
||||
@.x=@.x+1 /*indicate this bead has a number*/
|
||||
low=min(low,x); high=max(high,x) /*track the lowest & highest num.*/
|
||||
end /*j*/
|
||||
/* [↓] now, collect the beads and*/
|
||||
do m=low to high /*let them fall (to zero). */
|
||||
if @.m\==0 then do n=1 for @.m /*have we found a bead here? */
|
||||
$=$ m /*add it to the sorted list. */
|
||||
end /*n*/ /* [↑] let beads fall to zero. */
|
||||
end /*m*/
|
||||
#= grasshopper greenGrocer bernN psi /*combine the four lists into one list.*/
|
||||
call show 'before sort', # /*display the list before sorting. */
|
||||
call show ' after sort', beadSort(#) /* " " " after " */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
beadSort: procedure; parse arg low . 1 high . 1 z,$ /*$: the list to be sorted. */
|
||||
@.=0 /*set all beads (@.) to zero.*/
|
||||
do j=1 until z==''; parse var z x z /*pick the meat off the bone.*/
|
||||
if \datatype(x, 'W') then do; say '***error***'
|
||||
say 'element' j "in list isn't numeric:" x
|
||||
say; exit 13
|
||||
end /* [↑] exit pgm with RC=13. */
|
||||
x=x/1 /*normalize: 4. 004 +4 .4e0 */
|
||||
@.x=@.x+1 /*indicate this bead has a #.*/
|
||||
low=min(low,x); high=max(high,x) /*track lowest and highest #.*/
|
||||
end /*j*/
|
||||
/* [↓] now, collect beads and*/
|
||||
do m=low to high /*let them fall (to zero). */
|
||||
if @.m\==0 then do n=1 for @.m; $=$ m /*have we found a bead here? */
|
||||
end /*n*/ /* [↑] add it to sorted list*/
|
||||
end /*m*/
|
||||
|
||||
return $
|
||||
/*──────────────────────────────────SHOW subroutine─────────────────────*/
|
||||
return $
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
show: parse arg txt,y; _=left('', 20)
|
||||
w=length(words(y)); do k=1 for words(y) /* [↑] twenty blanks.*/
|
||||
say _ 'element' right(k,w) txt":" right(word(y,k),9)
|
||||
end /*k*/
|
||||
say copies('─',70) /*show a long separator line. */
|
||||
return
|
||||
w=length(words(y)); do k=1 for words(y) /* [↑] twenty pad blanks. */
|
||||
say _ 'element' right(k, w) txt":" right(word(y, k), 9)
|
||||
end /*k*/
|
||||
say copies('─', 70) /*show a long separator line.*/
|
||||
return
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue