## one-swap partion quicksort (June 29)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
dafhi
Posts: 1618
Joined: Jun 04, 2005 9:51

### one-swap partion quicksort (June 29)

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
``````
Last edited by dafhi on Jun 30, 2023 1:57, edited 6 times in total.
neil
Posts: 338
Joined: Mar 17, 2022 23:26