Code: Select all
/' -- visual sort dev - 2023 June 29 - by dafhi
i use this to develop a new sort
if you want to try making one copy these for reference
' vis_copy des(), i, a, col
' vis_swap a(), i, j
' vis_pred a, b, i,j, col
' vis_ifswap a(), i,j, col
' vis_pos a, i, col
'/
' --------------------
'' sort this
Type vector3d
As single x,y,z
as uinteger color
End Type
' -------------------------------------
Type sort_TYPE as vector3d
' -------------------------------------
'' comment out the .z for plain var type
#define dot .z
'' sort direction
#define direction <
'
' -------------------------------------
type dot_type as typeof(sort_type dot)
#define asdot as dot_type
' ----------------------------------
#define flo(x) (((x)*2.0-0.5)shr 1) '' replaces int (and faster) - http://www.freebasic.net/forum/viewtopic.php?p=118633
#DEFINE myINT(V) (V-.5) \ 1 ''https://freebasic.net/forum/viewtopic.php?p=297522#p297522
#undef int
#define int as integer
#define sng as single
'
' --------------------
const w = 640
const h = 480
dim shared as single FOV = .1
dim shared as string kstr
dim shared sng sleep_amount
function quit as boolean
return kstr = chr(27)
end function
sub pause
sleep sleep_amount / FOV
kstr = inkey
end sub
#macro pred(x,y)
clng( x dot direction y dot ) '' June 29
#endmacro
#macro sw(x,y)
tmp= x: x= y: y=tmp
#endmacro
sub mag_line( a asdot, x int, col as ulong )
dim int mag_x = 1 / FOV
line ( x* mag_x, h-1 ) - ( x* mag_x + mag_x-1, h-1-( a*(h-20) ) ), col, bf
end sub
sub Bar( a asdot, x as long, alpha as ubyte = 255)
mag_line a, x, rgb(alpha, a*alpha, 0)
End Sub
sub show_lines(a asdot, b asdot, i as long, j as long, alpha as ubyte = 255)
bar a, i, alpha
bar b, j, alpha
End Sub
sub vis_copy( a() as sort_type, i int, _from as sort_TYPE, col as ulong = 0 )
bar a(i)dot, i, 0
a(i) = _from
if col = 0 then
bar a(i)dot, i
else
mag_line a(i)dot, i, col
endif
pause
end sub
sub vis_swap( a() as sort_type, i int, j int )
show_lines a(i)dot, a(j)dot, i, j, 0
swap a(i), a(j)
show_lines a(i)dot, a(j)dot, i, j
locate 1,1
' ? rnd
pause
end sub
function vis_pred( a as sort_TYPE, b as sort_TYPE, i int, j int, col as ulong = -1 ) int
mag_line a dot, i, col
mag_line b dot, j, col
pause
bar a dot, i
bar b dot, j
return pred(a,b)
end function
sub vis_ifswap( a() as sort_type, i int, j int, col as ulong = -1 )
if vis_pred( a(j), a(i), j, i, col )then vis_swap a(), j,i
end sub
sub vis_pos( a as sort_TYPE, i int, col as ulong = -1 )
mag_line a dot, i, col
pause
end sub
sub show(a() as sort_TYPE)
cls
for i int = 0 to ubound(a)
bar a(i)dot, i
Next
end sub
namespace sorts '' namespacing allows local globals
const blu = rgb(0, 0,255)
const light_blu = rgb(192,192,255)
const forest_green = rgb(99,200,0)
const purple = rgb(128,0,192)
const hot_pink = rgb(255,0,255)
type sortindex as integer
dim as sortindex j, k, m
dim as sort_type piv, tmp
'' verification
Sub qdodi(a() as sort_type, r int, L int=0)
Dim As Long i=L: j=r '' global j
piv =a(((I+J)\2)) '' global piv
While I < J
While pred( a(I), piv ):I+=1:Wend
While pred( piv , a(J) ):J-=1:Wend
If I<=J Then Sw( a(I),a(J)): I+=1:J-=1
Wend
j += clng( piv dot = a(j) dot ) '' June 28
'' c++ j -=
If J > L Then qdodi(a(),j,L)
If I < r Then qdodi(a(),r, i)
end sub
'' -- visual sorts --
sub insertion( A() As sort_type, r As SortIndex,L As SortIndex=0)
'' insertion sort - June 11 - by dafhi
For J = L+1 To r
if vis_pred( a(J), a(j-1), j,j-1, hot_pink ) then
if quit then exit sub
tmp = a(J)
k = j-1
for k = k+(k>L) to L step -1
if vis_pred( a(k), tmp, k,-1, hot_pink ) then exit for
next
m = k + 2
for k = j to m step -1
vis_copy a(), k, a(k-1)
next
vis_copy( a(), k, tmp )
endif
Next
End Sub
Sub qs_osp(a() as sort_type, r int, L int=0)
'' one swap per partition quicksort - 2023 June 29 - by dafhi
'' developed from "lazy first principles"
'1. conceptualize what i can
'2. eliminate maybe-unnecessary calcs using minimal data sets
if L=r-1 then vis_ifswap a(), L,r, purple: exit sub
j = (r+1 + L) \ 2 '' int divide
'' namespace global j
if vis_pred( a(L), a(j), L, j, forest_green ) then vis_swap( a(), L, j )
piv = a(L) '' namespace global pivot
j = r
var i = L
do
while vis_pred( piv, a(j), -1, j, light_blu ): j-=1: wend
vis_copy( a(), i, a(j), purple )
i += 1
if quit then exit sub '' user request
while vis_pred( a(i), piv, i, -1, light_blu )andalso i<j: i+=1: wend
if i>=j then exit do
vis_copy( a(), j, a(i), purple )
j -= 1
if quit then exit sub '' user request
loop
i = (i+j)\2 '' integer divide
if clng( a(i)dot <> piv dot ) then vis_copy( a(), i, piv, purple )
if L<i-1 then qs_osp a(), i-1, L
if i+1<r then qs_osp a(), r, i+1
end sub
end namespace
#include "../sort_verif.bas"
sub visualize( _
su as sub( () as sort_type, int, int = 0 ), _
a() as sort_type, str_name as string="")
rand_vals w*FOV - 1
show a()
locate 2,2
? str_name
sleep 900
su( a(), ubound(a) )
for i int = 0 to ubound(a)
if cbool( a(i)dot <> b(i)dot ) then _
? "bad sort!": sleep 900: exit for
next
sleep 500
end sub
screenres w,h,32
randomize
sleep_amount = 2.5
visualize @sorts.qs_osp, a(), "1-swap per partition qsort"
locate 1,1
? "Demo finished !"
sleep