Sorting Algorithms

[neil]

Does someone have a better method of sorting 8 bytes? This would include the unsorted byte position markers.
Also, does someone have an example in FreeBasic of a Merge Sort and a way to get the original unsorted bytes back using it?

Code: Select all

Dim As UByte a,b,c,d,e,f,g,h,i
Dim As Ubyte j,k,l,m,n,o,p,q

a = 27:b = 155:c = 63:d = 8
e = 127:f = 81:g = 85:h = 159
print "Unsorted Bytes ";a;" ";b;" ";c;" ";d;" ";e;" ";f;" ";g;" ";h

j = 1:k = 2:l = 3:m = 4
n = 5:o = 6:p = 7:q = 8

for i = 1 to 7
if a > b THEN swap a,b:swap j,k
if b > c THEN swap b,c:swap k,l
if c > d THEN swap c,d:swap l,m
if d > e THEN swap d,e:swap m,n
if e > f THEN swap e,f:swap n,o
if f > g THEN swap f,g:swap o,p
if g > h THEN swap g,h:swap p,q
next

print
print "Sorted Bytes ";a;" ";b;" ";c;" ";d;" ";e;" ";f;" ";g;" ";h
print

'this is so i can put the file back to it's original unsorted order
print "Unsorted Byte Position Markers ";j;" ";k;" ";l;" ";m;" ";n;" ";o;" ";p;" ";q

sleep

[neil]

I forgot your not suppose to post questions here.
Maybe this should be moved to General?

[D.J.Peters]

viewtopic.php?p=254650

[dodicat]

I don't think it matters which sort method.
Capture the swaps in an array, and apply the array to unsort.
Both the sorted text and the array can be saved to file and retrieved from file.
Example, combsort:

Code: Select all

type pair
    as long n1,n2
end type

sub sortstring(_string as string,begin as long,finish as long,array() as pair)
    Var size=(finish),switch=0,j=0,c=0
    Dim As Single void=size
    redim array(1 to 10*len(_string))
    Do
        void=void/1.3: If void<1 Then void=1
        switch=0
        For i As Integer =(begin) To size-void
            j=i+void
            If _string[i]>_string[j] Then 
                 c+=1
                Swap _string[i],_string[j]: switch=1
                array(c)=type(i,j)
            End If
        Next
    Loop Until  switch =0 And void=1
    redim preserve array(1 to c)
end sub

sub unsortstring(_string as string,array() as pair)
for n as long=ubound(array) to 1 step -1
    swap _string[array(n).n1],_string[array(n).n2]
    next n
end sub



redim as pair p()
dim as string s= _
!"Let not Ambition mock their useful toil,\n" +_
!"   Their homely joys, and destiny obscure;\n"+ _
!"Nor Grandeur hear with a disdainful smile\n"+ _
!"   The short and simple annals of the poor."


print "'";s;"'"
print
print
sortstring(s,0,len(s)-1,p())
print "'";s;"'"
print
print
unsortstring(s,p())
print "'";s;"'"
print


sleep
 

[neil]

The Merge Sort it quite interesting. I think it's interesting the different methods they have come up with to sort data.
The Shellsort is another one to look at. https://en.wikipedia.org/wiki/Shellsort

[shadow008]

Can you explain what you're trying to achieve needing the unsorted array post-sort? It sounds like exactly what I described briefly here: viewtopic.php?t=32444

Specifically this:

Note that there are a few other ways this could be accomplished:
1) Only zip up an index array alongside the master array. Then, use that index array by:
a) Creating a new array and using the index array to copy the elements directly into the correct location

[neil]

@shadow008
I need to store the original unsorted byte positions to a file with as few bytes as possible. This was for a data compression experiment. I discovered sorting an uncompressible file. I could compress the file. To get the file back, I need to store something that, when added to the compressed size, doesn't exceed the original file size.

Is there another way to do this?
Such as maybe as a reverse merge sort that could store less bytes to get the file back.

[neil]

I thought this was interesting.

The Burrows Wheeler Transform is a sorting algorithm to make text more compressible. It requires storing extra bytes in the file to get the unsorted string of characters back.

David Scott's bijective variant does not require storing any extra bytes in the file and still recovers the original unsorted string of characters. How is this even possible?

Info about the Burrows Wheeler Transform
https://en.wikipedia.org/wiki/Burrows%E ... _transform
 
Are there any FreeBasic demo's of the BWT?

[neil]

There is a lot to learn about sorting methods. Also the BWT block sorting method.
Especially the BWT bijective version.

[neil]

I found a demo of the Burrows Wheeler Transform. It was written for qbasic. It seems to run OK in FreeBasic. It's not the bijective version I was hoping for. Press any key to cycle through the rotations.

Code: Select all

#lang "qb"
EndSymbol$ = CHR$(ASC("$")): 'This is the end of sequence symbol we use to end data with, and to recognize the correct pattern of data upon reconstruction from a BWT string.

CLS
OUTDATA$ = "^BANANA" + EndSymbol$

'Create Burrows-Wheeler Transformation from OUTDATA$ and store result to FIRSTROW$.
DIM POSSIBILITIES$(LEN(OUTDATA$)), PSORTED$(LEN(OUTDATA$)): Cycles = 0
FOR Cycles = 0 TO LEN(OUTDATA$) - 1
POSSIBILITIES$(Cycles) = OUTDATA$: SCROLL$ = LEFT$(OUTDATA$, 1): OUTDATA$ = RIGHT$(OUTDATA$, LEN(OUTDATA$) - 1): OUTDATA$ = OUTDATA$ + SCROLL$
NEXT Cycles
FOR P = 0 TO Cycles - 1: PSORTED$(P) = POSSIBILITIES$(P)
PRINT PSORTED$(P), P + 1: SLEEP
NEXT P: SLEEP

'Now we arrange these.
DO
FOUND = 0
FOR P = 0 TO Cycles - 2
IF PSORTED$(P) > PSORTED$(P + 1) THEN TEMP$ = PSORTED$(P + 1): PSORTED$(P + 1) = PSORTED$(P): PSORTED$(P) = TEMP$: FOUND = 1
NEXT P
LOOP UNTIL FOUND = 0
FOR P = 0 TO Cycles - 1: WRITE PSORTED$(P), P + 1: NEXT P
FOR P = 0 TO Cycles - 1: FIRSTROW$ = FIRSTROW$ + RIGHT$(PSORTED$(P), 1): NEXT P
CLS : WRITE FIRSTROW$: SLEEP: SLEEP
WRITE FIRSTROW$: SLEEP

'Restore a BWT string from FIRSTROW$ to original form. Store the result to OUTPUT$.
'Assumes that FIRSTROW$ holds the BWT data that you want to convert already.

COUNTER = 0
FOR P = 0 TO LEN(FIRSTROW$) - 1: PSORTED$(P) = "": NEXT P: 'Clear out Possibilities Array.
CLS
DO

'Add the characters to the start of the matrix vertically; add each new byte to the start of every array element to make that possible.
FOR P = 0 TO LEN(FIRSTROW$) - 1: PSORTED$(P) = MID$(FIRSTROW$, P + 1, 1) + PSORTED$(P): NEXT P: COUNTER = COUNTER + 1

DO
FOUND = 0
FOR P = 0 TO Cycles - 2
IF PSORTED$(P) > PSORTED$(P + 1) THEN TEMP$ = PSORTED$(P + 1): PSORTED$(P + 1) = PSORTED$(P): PSORTED$(P) = TEMP$: FOUND = 1
NEXT P
LOOP UNTIL FOUND = 0

LOCATE 1, 1
FOR P = 0 TO Cycles - 1: PRINT PSORTED$(P), P + 1: NEXT P: SLEEP

IF COUNTER = LEN(FIRSTROW$) THEN EXIT DO
LOOP

FOR P = 0 TO COUNTER: IF RIGHT$(PSORTED$(P), 1) = EndSymbol$ THEN OUTPUT$ = PSORTED$(P)
NEXT P

'CLS
OUTPUT$=LEFT$(OUTPUT$,LEN(OUTPUT$)-1):'get rid of endsymbol character.
PRINT OUTPUT$
sleep

[dafhi]

hi neil

i only read the thing about 8 bytes, so i'm posting with that in mind

Code: Select all

'' array sizes 35-ish or less, use insertion_sort

type sort_type    as ubyte

#define direction <

#define dot       '.z '' uncomment for udt member

  '' insertion_sort by dafhi
sub Insertion_Sort( a() as sort_type, l as long=0, u as long=0)
  
  if u <= l then l=lbound(a): u=ubound(a)
  
  static as sort_type   temp
  static as long        j, k
  
  j = l
  
  for i as long=l+1 to u: if a(i)dot direction a(j)dot then j=i
  next
  
  temp = a(l): a(l)=a(j): a(j) = temp '' swap
  j = l+1
  
  while j < u
    k = j+1
    temp = a(k)
    j = k
    while temp dot direction a(j-1)dot
      a(j) = a(j-1)
      j -= 1
    Wend:  a(j) = temp: j=k
  wend
End Sub


dim as sort_type  q(9)

for i as long = 0 to ubound(q)
  q(i) = rnd*255.499
next

Insertion_sort q()

for i as long = 0 to ubound(q)
  print q(i); " ";
next

[neil]

@dafhi
Your insertion sort seems to work OK for a small number of bytes. I found out the Shellsort it is an optimization of the insertion sort.
Yours Insertion sort works great for what I need it for. Thanks for sharing it.

Using it I still need a way to store some type of data to be able to unsort the file.

[neil]

After seeing that the Burrows Wheeler Transform was not a full sorting algorithm and it worked great for text.
I wanted to try to come up with a minimal sort for binary data. The reason so I would not have to store a lot of data for the unsort.

Here's the sort I came up with: This is not a full sort; it only sorts the numbers by the most significant bit. to see what's going on. I printed it out in binary mode. It groups the numbers by whether the most significant bit has a one or zero in it. This won't work if all the numbers are above 127 or all are below 128. Using it on a random data file, there was enough change in the file to compress it.

paq8px -8 randomsorted.bin

Total input size : 415248
Total archive size : 380561

The file compressed to about 34k smaller.

Code: Select all

'minimal file sort for data compression experiment by neil

DIM AS UBYTE a,b,c,d,e,f,g,h
a = 128:b = 155:c = 63:d = 8:e = 165:f = 81:g = 85:h = 159

Print "Before sorting":
print a;"  ";bin(a,8)
print b;"  ";bin(b,8)
print c;"  ";bin(c,8)
print d;"  ";bin(d,8)
print e;"  ";bin(e,8)
print f;"  ";bin(f,8)
print g;"  ";bin(g,8)
print h;"  ";bin(h,8)
print
print

Print "After sorting":
if (a and 128) = 0 Then print a;"  ";bin(a,8)
if (b and 128) = 0 Then print b;"  ";bin(b,8)
if (c and 128) = 0 Then print c;"  ";bin(c,8)
if (d and 128) = 0 Then print d;"  ";bin(d,8)
if (e and 128) = 0 Then print e;"  ";bin(e,8)
if (f and 128) = 0 Then print f;"  ";bin(f,8)
if (g and 128) = 0 Then print g;"  ";bin(g,8)
if (h and 128) = 0 Then print h;bin(g,8)

if (a and 128) Then print a;"  ";bin(a,8)
if (b and 128) Then print b;"  ";bin(b,8)
if (c and 128) Then print c;"  ";bin(c,8)
if (d and 128) Then print d;"  ";bin(d,8)
if (e and 128) Then print e;"  ";bin(e,8)
if (f and 128) Then print f;"  ";bin(f,8)
if (g and 128) Then print g;"  ";bin(g,8)
if (h and 128) Then print h;"  ";bin(h,8)
print

sleep