one-swap partion quicksort (June 29)

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

one-swap partion quicksort (June 29)

Post by dafhi »

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

Re: flashsort & quicksort

Post by neil »

Post Reply