Data update

This commit is contained in:
Ingy döt Net 2024-10-16 18:07:41 -07:00
parent 81fd053722
commit 52a6ef48dd
10248 changed files with 63654 additions and 6775 deletions

View file

@ -0,0 +1,45 @@
Main:
call Create
call Show 'Not ordered'
call SortStateCity
call Show 'By state and city'
call SortPopCityN
call Show 'By pop (numeric desc) and city'
table = 'states.'
keys = 'pop. state.'; data = 'city.'
call SortPopCityS table,keys,data
call Show 'By pop (string) and city'
table = 'states.'
keys = 'city. state.'; data = 'pop.'
call SortCityState table,keys,data
call Show 'By city and state'
return
Create:
states = 'States.txt'
call Stream states,'c','open read'
states. = ''; n = 0
do while lines(states) > 0
record = linein(states)
parse var record rstate','rcity','rpop
n = n+1; states.state.n = rstate; states.city.n = rcity; states.pop.n = rpop
end
call Stream states,'c','close'
states.0 = n
return
Show:
procedure expose states.
arg header
say center(header,53)
say right('row',3) left('state',20) left('city',20) right('pop',7)
do n = 1 to states.0
say right(n,3) left(states.state.n,20) left(states.city.n,20) right(states.pop.n,7)
end
say
return
include Quicksort21 [label]=SortStateCity [table]=states. [key1]=state. [key2]=city. [data1]=pop.
include Quicksort21 [label]=SortPopCityN [table]=states. [key1]=pop. [key2]=city. [data1]=state. [lt]=> [gt]=<
include Quicksort [label]=SortCityState
include Quicksort [label]=SortPopCityS [lt]=<< [gt]=>>

View file

@ -0,0 +1,123 @@
default [label]=Quicksort21 [table]=table. [key1]=key1. [key2]=key2. [data1]=data1. [lt]=< [eq]== [gt]=>
-- Sorting procedure - Build 7 Sep 2024
-- (C) Paul van den Eertwegh 2024
[label]:
-- Sort a stem on 2 key columns, syncing 1 data column
procedure expose [table]
-- Sort
n = [table]0; s = 1; sl.1 = 1; sr.1 = n
do until s = 0
l = sl.s; r = sr.s; s = s-1
do until l >= r
-- Up to 19 rows selection sort is faster
if r-l < 20 then do
do i = l+1 to r
a = [table][key1]i
b = [table][key2]i
c = [table][data1]i
do j = i-1 by -1 to l
if [table][key1]j [lt] a then
leave
if [table][key1]j [eq] a then
if [table][key2]j [lt]= b then
leave
k = j+1
[table][key1]k = [table][key1]j
[table][key2]k = [table][key2]j
[table][data1]k = [table][data1]j
end
k = j+1
[table][key1]k = a
[table][key2]k = b
[table][data1]k = c
end
if s = 0 then
leave
l = sl.s; r = sr.s; s = s-1
end
else do
-- Find optimized pivot
m = (l+r)%2
if [table][key1]l [gt] [table][key1]m then do
t = [table][key1]l; [table][key1]l = [table][key1]m; [table][key1]m = t
t = [table][key2]l; [table][key2]l = [table][key2]m; [table][key2]m = t
t = [table][data1]l; [table][data1]l = [table][data1]m; [table][data1]m = t
end
else do
if [table][key1]l [eq] [table][key1]m then do
if [table][key2]l [gt] [table][key2]m then do
t = [table][key2]l; [table][key2]l = [table][key2]m; [table][key2]m = t
t = [table][data1]l; [table][data1]l = [table][data1]m; [table][data1]m = t
end
end
end
if [table][key1]l [gt] [table][key1]r then do
t = [table][key1]l; [table][key1]l = [table][key1]r; [table][key1]r = t
t = [table][key2]l; [table][key2]l = [table][key2]r; [table][key2]r = t
t = [table][data1]l; [table][data1]l = [table][data1]r; [table][data1]r = t
end
else do
if [table][key1]l [eq] [table][key1]r then do
if [table][key2]l [gt] [table][key2]r then do
t = [table][key2]l; [table][key2]l = [table][key2]r; [table][key2]r = t
t = [table][data1]l; [table][data1]l = [table][data1]r; [table][data1]r = t
end
end
end
if [table][key1]m [gt] [table][key1]r then do
t = [table][key1]m; [table][key1]m = [table][key1]r; [table][key1]r = t
t = [table][key2]m; [table][key2]m = [table][key2]r; [table][key2]r = t
t = [table][data1]m; [table][data1]m = [table][data1]r; [table][data1]r = t
end
else do
if [table][key1]m [eq] [table][key1]r then do
if [table][key2]m [gt] [table][key2]r then do
t = [table][key2]m; [table][key2]m = [table][key2]r; [table][key2]r = t
t = [table][data1]m; [table][data1]m = [table][data1]r; [table][data1]r = t
end
end
end
-- Rearrange rows in partition
i = l; j = r
a = [table][key1]m
b = [table][key2]m
do until i > j
do i = i
if [table][key1]i [gt] a then
leave
if [table][key1]i [eq] a then
if [table][key2]i [gt]= b then
leave
end
do j = j by -1
if [table][key1]j [lt] a then
leave
if [table][key1]j [eq] a then
if [table][key2]j [lt]= b then
leave
end
if i <= j then do
t = [table][key1]i; [table][key1]i = [table][key1]j; [table][key1]j = t
t = [table][key2]i; [table][key2]i = [table][key2]j; [table][key2]j = t
t = [table][data1]i; [table][data1]i = [table][data1]j; [table][data1]j = t
i = i+1; j = j-1
end
end
-- Next partition
if j-l < r-i then do
if i < r then do
s = s+1; sl.s = i; sr.s = r
end
r = j
end
else do
if l < j then do
s = s+1; sl.s = l; sr.s = j
end
l = i
end
end
end
end
return

View file

@ -0,0 +1,172 @@
default [label]=Quicksort [lt]=< [eq]== [gt]=>
-- Sorting procedure - Build 7 Sep 2024
-- (C) Paul van den Eertwegh 2024
[label]:
-- Sort a stem on 1 or more key columns, syncing 0 or more data columns
procedure expose (table)
arg table,keys,data
-- Collect keys
kn = words(keys)
do x = 1 to kn
key.x = word(keys,x)
end
-- Collect data
dn = words(data)
do x = 1 to dn
data.x = word(data,x)
end
-- Sort
n = value(table||0); s = 1; sl.1 = 1; sr.1 = n
do until s = 0
l = sl.s; r = sr.s; s = s-1
do until l >= r
-- Up to 19 rows insertion sort is faster
if r-l < 20 then do
do i = l+1 to r
do x = 1 to kn
k.x = value(table||key.x||i)
end
do x = 1 to dn
d.x = value(table||data.x||i)
end
do j=i-1 to l by -1
do x = 1 to kn
a = value(table||key.x||j)
if a [gt] k.x then
leave x
if a [eq] k.x then
if x < kn then
iterate x
leave j
end
k = j+1
do x = 1 to kn
t = value(table||key.x||j)
call value table||key.x||k,t
end
do x = 1 to dn
t = value(table||data.x||j)
call value table||data.x||k,t
end
end
k = j+1
do x = 1 to kn
call value table||key.x||k,k.x
end
do x = 1 to dn
call value table||data.x||k,d.x
end
end
if s = 0 then
leave
l = sl.s; r = sr.s; s = s-1
end
else do
-- Find optimized pivot
m = (l+r)%2
do x = 1 to kn
a = value(table||key.x||l); b = value(table||key.x||m)
if a [gt] b then do
do y = 1 to kn
t = value(table||key.y||l); u = value(table||key.y||m)
call value table||key.y||l,u; call value table||key.y||m,t
end
do y = 1 to dn
t = value(table||data.y||l); u = value(table||data.y||m)
call value table||data.y||l,u; call value table||data.y||m,t
end
leave
end
if a [lt] b then
leave
end
do x = 1 to kn
a = value(table||key.x||l); b = value(table||key.x||r)
if a [gt] b then do
do y = 1 to kn
t = value(table||key.y||l); u = value(table||key.y||r)
call value table||key.y||l,u; call value table||key.y||r,t
end
do y = 1 to dn
t = value(table||data.y||l); u = value(table||data.y||r)
call value table||data.y||l,u; call value table||data.y||r,t
end
leave
end
if a [lt] b then
leave
end
do x = 1 to kn
a = value(table||key.x||m); b = value(table||key.x||r)
if a [gt] b then do
do y = 1 to kn
t = value(table||key.y||m); u = value(table||key.y||r)
call value table||key.y||m,u; call value table||key.y||r,t
end
do y = 1 to dn
t = value(table||data.y||m); u = value(table||data.y||r)
call value table||data.y||m,u; call value table||data.y||r,t
end
leave
end
if a [lt] b then
leave
end
-- Rearrange rows in partition
i = l; j = r
do x = 1 to kn
p.x = value(table||key.x||m)
end
do until i > j
do i = i
do x = 1 to kn
a = value(table||key.x||i)
if a [lt] p.x then
leave x
if a [eq] p.x then
if x < kn then
iterate x
leave i
end
end
do j = j by -1
do x = 1 to kn
a = value(table||key.x||j)
if a [gt] p.x then
leave x
if a [eq] p.x then
if x < kn then
iterate x
leave j
end
end
if i <= j then do
do x = 1 to kn
t = value(table||key.x||i); u = value(table||key.x||j)
call value table||key.x||i,u; call value table||key.x||j,t
end
do x = 1 to dn
t = value(table||data.x||i); u = value(table||data.x||j)
call value table||data.x||i,u; call value table||data.x||j,t
end
i = i+1; j = j-1
end
end
-- Next partition
if j-l < r-i then do
if i < r then do
s = s+1; sl.s = i; sr.s = r
end
r = j
end
else do
if l < j then do
s = s+1; sl.s = l; sr.s = j
end
l = i
end
end
end
end
return