Author Topic: Illustrated Human Sort  (Read 364 times)

B+

  • Full Member
  • ***
  • Posts: 215
    • View Profile
Illustrated Human Sort
« on: August 31, 2016 »
Code: [Select]
' Illustrated Human Sort.txt for Naalaa 2016-08-30 translated from
' Illustrated Human Sort.txt for JB v1.01 2016-08-30 translated from
' Illustrated Human Sort.bas SmallBASIC 0.12.6 [B+=MGA] 2016-08-29
' well this is a disaster (a quick translation is not possible) !!!
' #1 < <= > >= operators do not work on strings
' #2 printing over text on screen eg spaces does not erase
' need rebuild screen at each update

' Using Binary Search Algorithm to sort some alpha numeric strings

set window 200, 40, 400, 440
set redraw false
randomize time()
constant:
SP8$ = "        "
N = 15
visible:
fi$ = ""
high = 0
low = 0
check = 0
filed$[N + 1]
fileThis$[N + 1]
hidden:

'set up work pile
for y = 1 to N
  c$ = mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", rnd(26), 1)
  r = rnd(8)
  for i = 0 to r
    c$ = c$ + mid$("abcdefghijklmnopqrstuvwxyz", rnd(26), 1)
  next
  if len(c$) < 5 then c$ = mid$("0123456789", rnd(10), 1) + mid$("0123456789", rnd(10), 1) + " " + c$
  fileThis$[y] = left$(c$ + SP8$, 8)
next
proc us 0

'do some filing
for i = 1 to N
'move file to working place and remove from work array
fi$ = fileThis$[i]
fileThis$[i] = ""
proc us i
  if i = 1 then
    filed$[1] = fi$
fi$ = ""
proc us i
  else
'this is main event
    iPoint = findIndex(fi$, i - 1 )
    for j = i downto iPoint + 1
        filed$[j] = filed$[j - 1]
    next
filed$[iPoint] = ""
proc us i
    filed$[iPoint] = fi$
fi$ = ""
proc us i
endif
next
set colori 0x00ffff
proc pa 0, N + 2, "  I am done sorting things out!"
redraw
wait keydown

function findIndex(find$, ub)
'proc pa 60, ub +1, find$ +", "+filed$[ub]
'OK so far

i = ub + 1
  lb = 1
check = ub
proc us i

  if GTE(find$, filed$[ub]) then
    check = 0
    return ub + 1
  else
    high = ub
check = 0
proc us i
  endif

check = lb
  proc us i
  if LTE(find$, filed$[lb]) then
high = 0
check = 0
proc us i
    return lb
  else
    low = lb
check = 0
    proc us i
  endif

  midi = int(float(high - low) / 2.0) + low
  check = midi
  proc us i
  while midi <> low
    if find$ = filed$[midi] then
      low = 0
      high = 0
      check = 0
    proc us i
      return midi
    endif

    if LT(find$, filed$[midi]) then
high = midi
check = 0
      proc us i
    else
    low = midi
check = 0
      proc us i
  endif

  midi = int(float(high - low ) / 2.0) + low
check = midi
  proc us i
  wend

  check = 0
  high = 0
  sv = low
low = 0
  proc us i
  return sv + 1
endfunc

' redraw whole screen then pause
procedure us(i)
set colori 0x0
draw rect 0, 0, 800, 600, true
set colori 0x0000ff
proc pa 0, -1, "File These:"
proc pa 15, -1, "File:"
proc pa 30, -1, "Filed:"
set colori 0xff8800
for j = 1 to N
proc pa 0, j, fileThis$[j]
next
set colori 0x00b830
proc pa 15, i, fi$
set colori 0xffffff
if low and low = high then proc pa 28, low, "?"
if high and high <> low then proc pa 28, high, "<"
if low and low <> high then proc pa 28, low, ">"
if check then
if check <> low and check <> high then proc pa 28, check, "?"
endif
set colori 0xffff00
for j = 1 to N
proc pa 30 + 0, j + 0, filed$[j +0]
next
redraw
proc d1
endproc

procedure pa(xCol, yRow, text$)
  set caret (xCol + 2) * 8, (yRow + 2) * 20
wln text$
endproc

procedure d1()
    wait 1000
endproc

'note mid$ does not error if position is less than 0 or greater than len(string) -1
'compare s1$ <= s2$ return true if so else false unless one string = "" then error, return -1
function LTE(s1$, s2$)
if s1$ = "" or s2$ = "" then return -1
if s1$ = s2$ then
return true
elseif len(s1$) <= len(s2$) then
lm1 = len(s1$) - 1 ; shorter$ = s1$
else
lm1 = len(s2$) ; shorter$ = s2$
endif
for i = 0 to lm1
if asc(mid(s1$, i, 1)) < asc(mid(s2$, i, 1)) then
return true
elseif asc(mid(s1$, i, 1)) > asc(mid(s2$, i, 1)) then
return false
endif
next
'still here?
if shorter$ = s1$ then
return true
else
return false
endif
endfunc

'if s1$ or s2$ = "" return -1, error compare s1$ < s2$
function LT(s1$, s2$)
if s1$ = "" or s2$ = "" then return -1
if s1$ = s2$ then
return false
elseif len(s1$) <= len(s2$) then
lm1 = len(s1$) - 1 ; shorter$ = s1$
else
lm1 = len(s2$) ; shorter$ = s2$
endif
for i = 0 to lm1
if asc(mid(s1$, i, 1)) < asc(mid(s2$, i, 1)) then
return true
elseif asc(mid(s1$, i, 1)) > asc(mid(s2$, i, 1)) then
return false
endif
next
'still here?
if shorter$ = s1$ then
return true
else
return false
endif
endfunc

function GTE(s1$, s2$)
if s1$ = "" or s2$ = "" then return -1
if s1$ = s2$ then
return true
elseif len(s1$) <= len(s2$) then
lm1 = len(s1$) - 1 ; shorter$ = s1$
else
lm1 = len(s2$) ; shorter$ = s2$
endif
for i = 0 to lm1
if asc(mid(s1$, i, 1)) > asc(mid(s2$, i, 1)) then
return true
elseif asc(mid(s1$, i, 1)) < asc(mid(s2$, i, 1)) then
return false
endif
next
'still here?
if shorter$ = s1$ then
return false
else
return true
endif
endfunc
B+