Just another update
This commit is contained in:
Ingy döt Net
parent
a25938f123
commit
00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
|
|
@ -3,7 +3,7 @@ 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*/ {
|
||||
auto columns(R)(R m) pure /*nothrow*/ @safe /*@nogc*/ {
|
||||
return m
|
||||
.map!walkLength
|
||||
.reduce!max
|
||||
|
|
@ -11,7 +11,7 @@ auto columns(R)(R m) /*pure nothrow*/ {
|
|||
.map!(i => m.filter!(s => s.length > i).walkLength.repeat0);
|
||||
}
|
||||
|
||||
auto beadSort(in uint[] data) /*pure nothrow*/ {
|
||||
auto beadSort(in uint[] data) pure /*nothrow @nogc*/ {
|
||||
return data.map!repeat0.columns.columns.map!walkLength;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,61 @@
|
|||
class
|
||||
BEAD_SORT
|
||||
feature
|
||||
bead_sort(ar: ARRAY[INTEGER]): ARRAY[INTEGER]
|
||||
local
|
||||
max, count, i, j, k: INTEGER
|
||||
sorted: ARRAY[INTEGER]
|
||||
do
|
||||
max:= max_item(ar)
|
||||
create sorted.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
|
||||
sorted[j]:= i
|
||||
j:= j+1
|
||||
end
|
||||
i:= i+1
|
||||
end
|
||||
RESULT:= sorted
|
||||
end
|
||||
|
||||
feature{NONE}
|
||||
max_item(ar: ARRAY [INTEGER]):INTEGER
|
||||
require
|
||||
ar_not_void: ar/= Void
|
||||
local
|
||||
i, max: INTEGER
|
||||
do
|
||||
from
|
||||
i:=1
|
||||
until
|
||||
i > ar.count
|
||||
loop
|
||||
if ar.item(i) > max then
|
||||
max := ar.item(i)
|
||||
end
|
||||
i := i + 1
|
||||
end
|
||||
Result := max
|
||||
ensure
|
||||
result_is_set: Result /= Void
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
class
|
||||
APPLICATION
|
||||
inherit
|
||||
ARGUMENTS
|
||||
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,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;
|
||||
|
|
@ -1,62 +1,46 @@
|
|||
/*REXX program sorts a list of integers using a bead sort algorithm. */
|
||||
/*get some grassHopper numbers. */
|
||||
grasshopper=,
|
||||
/*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
|
||||
|
||||
/*GreeenGrocer numbers are also called hexagonal pyramidal */
|
||||
/* numbers. */
|
||||
greengrocer=,
|
||||
/*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
|
||||
|
||||
/*get some Bernoulli numerator numbers. */
|
||||
/*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'
|
||||
|
||||
/*Psi is also called the Reduced Totient function, and */
|
||||
/* is also called Carmichale lambda, or LAMBDA function.*/
|
||||
psi=,
|
||||
/*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
|
||||
|
||||
list=grasshopper greengrocer bernN psi /*combine the four lists into one*/
|
||||
|
||||
call showL 'before sort',list /*show the list before sorting. */
|
||||
$=beadSort(list) /*invoke the bead sort. */
|
||||
call showL ' after sort',$ /*show the after array elements.*/
|
||||
#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 expose @.; parse arg z
|
||||
$= /*this'll be the sorted list. */
|
||||
low=999999999; high=-low /*define the low and high numbers*/
|
||||
@.=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 number*/
|
||||
low=min(low,x) /*keep track of the lowest number*/
|
||||
high=max(high,x) /* " " " " highest " */
|
||||
end /*j*/
|
||||
/*now, collect the beads and */
|
||||
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 iterate /*No bead here? Then keep looking*/
|
||||
do n=1 for @.m /*let the beads fall to 0. */
|
||||
$=$ m /*add it to the sorted list. */
|
||||
end /*n*/
|
||||
end /*m*/
|
||||
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*/
|
||||
|
||||
return $
|
||||
/*──────────────────────────────────SHOWL 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('─',79) /*show a separator line. */
|
||||
/*──────────────────────────────────SHOW subroutine─────────────────────*/
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
class Array
|
||||
def beadsort
|
||||
map {|e| [1] * e}.columns.columns.map {|e| e.length}
|
||||
map {|e| [1] * e}.columns.columns.map(&:length)
|
||||
end
|
||||
|
||||
def columns
|
||||
y = length
|
||||
x = map {|l| l.length}.max
|
||||
x = map(&:length).max
|
||||
Array.new(x) do |row|
|
||||
Array.new(y) { |column| self[column][row] }.compact # Remove nils.
|
||||
end
|
||||
|
|
|
|||
|
|
@ -0,0 +1,46 @@
|
|||
$ 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]);
|
||||
excl(beads[i], j);
|
||||
end for;
|
||||
for i range length(a) - sum + 1 to length(a) do
|
||||
incl(beads[i], j);
|
||||
end for;
|
||||
end for;
|
||||
for i range 1 to length(a) do
|
||||
for j range 1 to max until j not in beads[i] do
|
||||
noop;
|
||||
end for;
|
||||
a[i] := pred(j);
|
||||
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: num is 0;
|
||||
begin
|
||||
beadSort(a);
|
||||
for num range a do
|
||||
write(num <& " ");
|
||||
end for;
|
||||
writeln;
|
||||
end func;
|
||||
Loading…
Add table
Add a link
Reference in a new issue