Another update from ingydotnet^djgoku

This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions

View file

@ -0,0 +1,50 @@
PROC radixsort = (REF []INT array) VOID:
(
[UPB array]INT zero;
[UPB array]INT one;
BITS mask := 16r01;
INT zero_index := 0,
one_index := 0,
array_index := 1;
WHILE ABS(mask) > 0 DO
WHILE array_index <= UPB array DO
IF (BIN(array[array_index]) AND mask) = 16r0 THEN
zero_index +:= 1;
zero[zero_index] := array[array_index]
ELSE
one_index +:= 1;
one[one_index] := array[array_index]
FI;
array_index +:= 1
OD;
array_index := 1;
FOR i FROM 1 TO zero_index DO
array[array_index] := zero[i];
array_index +:= 1
OD;
FOR i FROM 1 TO one_index DO
array[array_index] := one[i];
array_index +:=1
OD;
array_index := 1;
zero_index := one_index := 0;
mask := mask SHL 1
OD
);
main:
(
[10]INT a;
FOR i FROM 1 TO UPB a DO
a[i] := ROUND(random*1000)
OD;
print(("Before:", a));
print((newline, newline));
radixsort(a);
print(("After: ", a))
)

View file

@ -0,0 +1,92 @@
class
RADIX_SORT
feature
radix_sort (ar: ARRAY [INTEGER])
-- Array 'ar' sorted in ascending order.
require
ar_not_void: ar /= Void
not_negative: across ar as a all a.item >= 0 end
local
bucket_1, bucket_0: LINKED_LIST [INTEGER]
j, k, dig: INTEGER
do
create bucket_0.make
create bucket_1.make
dig := digits (ar)
across
0 |..| dig as c
loop
across
ar as r
loop
if r.item.bit_test (c.item) then
bucket_1.extend (r.item)
else
bucket_0.extend (r.item)
end
end
from
j := 1
until
j > bucket_0.count
loop
ar [j] := bucket_0 [j]
j := j + 1
end
from
k := j
j := 1
until
j > bucket_1.count
loop
ar [k] := bucket_1 [j]
k := k + 1
j := j + 1
end
bucket_0.wipe_out
bucket_1.wipe_out
end
ensure
is_sorted: is_sorted (ar)
end
feature {NONE}
digits (ar: ARRAY [INTEGER]): INTEGER
-- Number of digits of the largest item in 'ar'.
local
max: INTEGER
math: DOUBLE_MATH
do
create math
across
ar as a
loop
if a.item > max then
max := a.item
end
end
Result := math.log_2 (max).ceiling + 1
end
is_sorted (ar: ARRAY [INTEGER]): BOOLEAN
--- Is 'ar' sorted in ascending order?
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

View file

@ -0,0 +1,33 @@
class
APPLICATION
create
make
feature
make
local
test: ARRAY [INTEGER]
do
create rs
create test.make_empty
test := <<5, 4, 999, 5, 70, 0, 1000, 55, 1, 2, 3>>
io.put_string ("Unsorted:%N")
across
test as t
loop
io.put_string (t.item.out + " ")
end
rs.radix_sort (test)
io.put_string ("%NSorted:%N")
across
test as t
loop
io.put_string (t.item.out + " ")
end
end
rs: RADIX_SORT
end

View file

@ -0,0 +1,24 @@
defmodule Sort do
def radix_sort(list), do: radix_sort(list, 10)
def radix_sort([], _), do: []
def radix_sort(list, base) do
max = abs(Enum.max_by(list, &abs(&1)))
sorted = radix_sort(list, base, max, 1)
{minus, plus} = Enum.partition(sorted, &(&1<0))
Enum.reverse(minus, plus)
end
defp radix_sort(list, _, max, m) when max<m, do: list
defp radix_sort(list, base, max, m) do
buckets = List.to_tuple(for _ <- 0..base-1, do: [])
bucket2 = Enum.reduce(list, buckets, fn x,acc ->
i = abs(x) |> div(m) |> rem(base)
put_elem(acc, i, [x | elem(acc, i)])
end)
list2 = Enum.reduce(base-1..0, [], fn i,acc -> Enum.reverse(elem(bucket2, i), acc) end)
radix_sort(list2, base, max, m*base)
end
end
IO.inspect Sort.radix_sort([-4, 5, -26, 58, -990, 331, 331, 990, -1837, 2028])

View file

@ -1,71 +1,63 @@
/*REXX program performs a radix sort on a stemmed integer array. */
aList='0 2 3 4 5 5 7 6 6 7 11 7 13 9 8 8 17 8 19 9 10 13 23 9 10 15 9 11',
'29 10 31 10 14 19 12 10 37 21 16 11 41 12 43 15 11 25 47 11 14 12',
'20 17 53 11 16 13 22 31 59 12 61 33 13 12 18 16 67 21 26 14 71 12',
'73 39 13 23 18 18 79 13 12 43 83 14 22 45 32 17 89 13 20 27 34 49',
'24 13 97 16 17 14 101 22 103 19 15 55 107 13 109 18 40 15 113 -42'
/*excluding -42, the abbreviated list is called the integer log function*/
mina=word(aList,1); maxa=mina
do n=1 for words(aList); x=word(aList,n); @.n=x /*list ──► array.*/
mina =min(x,mina); maxa=max(x,maxa)
width=max(length(abs(mina)),length(maxa))
end /*n*/
n=words(aList); w=length(n); call radSort n
do j=1 for n
say 'item' right(j,w) "after the radix sort:" right(@.j,width+1)
end /*j*/
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────RADSORT subroutine─────────────────*/
radSort: procedure expose @. width; parse arg size; mote=c2d(' '); #=1
!.#._b=1; !.#._i=1
!.#._n=size; do i=1 for size; y=@.i; @.i=right(abs(y),width,0)
if y<0 then @.i='-'@.i
end /*i*/
/*══════════════════════════════════════where the rubber meets the road.*/
do while #\==0; ctr.=0; L='ffff'x; low=!.#._b; n=!.#._n; radi=!.#._i; H=
#=#-1
do j=low for n; parse var @.j =(radi) _ +1; ctr._=ctr._+1
if ctr._==1 then if _\=='' then do
if _<<L then L=_
if _>>H then H=_
end
end /*j*/
if L>>H then iterate
_=
if L==H then if ctr._==0 then do; #=#+1; !.#._b=low
!.#._n=n
!.#._i=radi+1; iterate
end
L=c2d(L); H=c2d(H); ?=ctr._+low; top._=?; ts=mote; max=L
do k=L to H; _=d2c(k,1); cen=ctr._
if cen>ts then parse value cen k with ts max
?=?+cen; top._=?
end /*k*/
pivot=low
do while pivot<low+n; it=@.pivot
do forever
parse var it =(radi) _ +1; cen=top._-1; if pivot>=cen then leave
top._=cen; ?=@.cen; @.cen=it; it=?
end /*forever*/
top._=pivot; @.pivot=it; pivot=pivot+ctr._
end /*while pivot<low+n*/
i=max
do until i==max; _=d2c(i,1); i=i+1; if i>H then i=L; d=ctr._
if d<=mote then do; if d>1 then call .radSortP top._,d; iterate; end
#=#+1; !.#._b=top._
!.#._n=d
!.#._i=radi+1
end /*until i==max*/
end /*while #\==0 */
/*═════════════════════════════════════we're done with the heavy lifting*/
#=0; do i=size by -1 to 1; if @.i>=0 then iterate; #=#+1; @@.#=@.i; end
do j=1 for size; if @.j <0 then iterate; #=#+1; @@.#=@.j; end
do k=1 for size; @.k=@@.k+0; end /*combine neg&pos radix lists*/
return
/*───────────────────────────────────.radSortP subroutine───────────────*/
.radSortP: parse arg bbb,nnn
do k=bbb+1 for nnn-1; q=@.k
do j=k-1 by -1 to bbb while q<<@.j; jp=j+1; @.jp=@.j; end
jp=j+1; @.jp=q
/*REXX program performs a radix sort on an integer (can be neg/zero/pos) array*/
ILF='0 2 3 4 5 5 7 6 6 7 11 7 13 9 8 8 17 8 19 9 10 13 23 9 10 15 9 11 29 10 31 10 14 19',
'12 10 37 21 16 11 41 12 43 15 11 25 47 11 14 12 20 17 53 11 16 13 22 31 59 12 61 33',
'13 12 18 16 67 21 26 14 71 12 73 39 13 23 18 18 79 13 12 43 83 14 22 45 32 17 89 13',
'20 27 34 49 24 13 97 16 17 14 101 22 103 19 15 55 107 13 109 18 40 15 113 -42'
/*excluding -42, the abbreviated list (above) is called the integer log function.*/
n=words(ILF) /* I────── L── F─────── */
w=0 /*width so far.*/
do m=1 for n; _=word(ILF,m); @.m=_; w=max(w,length(_)) /*store #s──►@.*/
end /*m*/ /**/
/* └─── is the maximum width of numbers*/
call radSort n /*invoke the radix sort subroutine. */
do j=1 for n; say 'item' right(j,w) "after the radix sort:" right(@.j,w); end
exit /*stick a fork in it, we're all done. */
/*───────────────────────────────────RADSORT subroutine───────────────────────*/
radSort: procedure expose @. w; parse arg size; mote=c2d(' '); #=1; !.#._n=size
!.#._b=1;
!.#._i=1; do i=1 for size; y=@.i; @.i=right(abs(y),w,0); if y<0 then @.i='-'@.i
end /*i*/ /* [↓] where the rubber meats the road*/
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
do while #\==0; ctr.=0; L='ffff'x; low=!.#._b; n=!.#._n; $=!.#._i; H= /**/
#=#-1 /* [↑] is radix.*/ /**/
do j=low for n; parse var @.j =($) _ +1; ctr._=ctr._+1 /**/
if ctr._==1 & _\=='' then do; if _<<L then L=_; if _>>H then H=_ /**/
end /**/ /**/
end /*j*/ /* └── << is a strict comparison.*/ /**/
_= /* ┌── >> " " " " */ /**/
if L>>H then iterate /*◄─┘ */ /**/
if L==H & ctr._==0 then do; #=#+1; !.#._b=low; !.#._n=n; !.#._i=$+1; iterate /**/
end /**/
L=c2d(L); H=c2d(H); ?=ctr._+low; top._=?; ts=mote /**/
max=L /**/
do k=L to H; _=d2c(k,1); cen=ctr._ /**/
if cen>ts then parse value cen k with ts max /*swap.*/ /**/
?=?+cen; top._=? /**/
end /*k*/ /**/
piv=low /*set pivot to the low part.*/ /**/
do while piv<low+n /**/
it=@.piv /**/
do forever; parse var it =($) _ +1; cen=top._-1 /**/
if piv>=cen then leave; top._=cen; ?=@.cen; @.cen=it; it=? /**/
end /*forever*/ /**/
top._=piv /**/
@.piv=it; piv=piv+ctr._ /**/
end /*while piv<low+n */ /**/
i=max /**/
do until i==max; _=d2c(i,1); i=i+1; if i>H then i=L; d=ctr._ /**/
if d<=mote then do; if d>1 then call .radSortP top._,d; iterate; end /**/
#=#+1; !.#._b=top._; !.#._n=d; !.#._i=$+1 /**/
end /*until i==max */ /**/
end /*while #\==0 */ /**/
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/
#=0; do i=size by -1 to 1; if @.i>=0 then iterate; #=#+1; @@.#=@.i; end
do j=1 for size; if @.j>=0 then do; #=#+1; @@.#=@.j; end; @.j=@@.j+0; end
return /* [↑↑↑] combine 2 lists into 1 list. */
/*───────────────────────────────────.radSortP subroutine─────────────────────*/
.radSortP: parse arg bb,nn
do k=bb+1 for nn-1; q=@.k
do j=k-1 by -1 to bb while q<<@.j; jp=j+1; @.jp=@.j; end /*j*/
jp=j+1; @.jp=q
end /*k*/
return

View file

@ -1,7 +1,7 @@
class Array
def radix_sort(base=10)
ary = dup
rounds = (Math.log(ary.minmax.map(&:abs).max)/Math.log(base)).ceil
rounds = (Math.log(ary.minmax.map(&:abs).max)/Math.log(base)).floor + 1
rounds.times do |i|
buckets = Array.new(2*base){[]}
base_i = base**i
@ -23,3 +23,4 @@ end
p [1, 3, 8, 9, 0, 0, 8, 7, 1, 6].radix_sort
p [170, 45, 75, 90, 2, 24, 802, 66].radix_sort
p [170, 45, 75, 90, 2, 24, -802, -66].radix_sort
p [100000, -10000, 400, 23, 10000].radix_sort

View file

@ -0,0 +1,13 @@
class Array
def radix_sort(base=10)
ary = dup
m, max = 1, ary.minmax.map(&:abs).max
while m <= max
buckets = Array.new(base){[]}
ary.each {|n| buckets[(n.abs / m) % base] << n}
ary = buckets.flatten
m *= base
end
ary.partition{|n| n<0}.inject{|minus,plus| minus.reverse + plus}
end
end