Insertion of string into an array in alphabetical order

bcohio2001 · Post by **bcohio2001** » Dec 16, 2007 15:19

This was originally created to alphabetize a directory listing for display.

I looked around and couldn't find an easy way to do it so I wrote my own.
I am sure it could be done with a call to windows, but I am a very "basic" guy.
Sorry about the pun, but couldn't resist.

Function StrComp(One As String,Two As String,CaseS As UByte) As UByte

return codes:
0 if the strings are equal
1 if it should be One then Two
2 if it should be Two then One

Code: Select all

Dim As String TheArray(1 To 100), InsertStr
Dim As UByte LCount, x, y, CmpFlag
Declare Function StrComp(As String, As String, As Ubyte) As UByte

'Assuming that the array has data in it
'and LCount is pointing at last valid entry in array
'and InsertStr is never going to be equal to any element

x = 0
Do
	x += 1
	CmpFlag = StrComp(InsertStr, TheArray(x), 1) 
Loop Until x = LCount Or CmpFlag = 1
LCount += 1
If CmpFlag = 1 Then 'insert inside array
	y = LCount
	While y > x
		TheArray(y) = TheArray(y - 1)
		y -= 1
	Wend
	TheArray(x) = InsertStr
Else 'add to end
	TheArray(LCount) = InsertStr
EndIf

Function StrComp(One As String,Two As String,CaseS As UByte) As UByte
	'return codes:
	'0 if the strings are equal
	'1 if it should be One then Two
	'2 if it should be Two then One
	
	Dim As UByte Small_Ptr, Small_Len, x
	
	'which one is shorter?
	If Len(One) > Len(Two) Then
		Small_Len = Len(Two)
		Small_Ptr = 2
	Else
		Small_Len = Len(One)
		Small_Ptr = 1
	EndIf
	
	For x = 1 To Small_Len
		If CaseS Then
			If Asc(Mid(One, x, 1)) > Asc(Mid(Two, x, 1)) Then Return 2
			If Asc(Mid(One, x, 1)) < Asc(Mid(Two, x, 1)) Then Return 1
		Else
			If Asc(UCase(Mid(One ,x ,1))) > Asc(UCase(Mid(Two, x, 1))) Then Return 2
			If Asc(UCase(Mid(One, x, 1))) < Asc(UCase(Mid(Two, x, 1))) Then Return 1
		EndIf
	Next
	
	'strings are equal to this point ....
	If Len(One) = Len(Two) Then Return 0
	Return Small_Ptr
End Function

D.J.Peters · Post by **D.J.Peters** » Dec 16, 2007 19:41

Hello bcohio2001
only a hint you can use [] with strings i mean you don't need ASC() and MID()

for example:
if TheString[charpos]=TheOtherString[charpos] then ...
or with arrays too
if Strings(i)[charpos]>Strings(j)[charpos] then ...

sorry if a bug in my code i wrote it in 5 minutes

Joshy

Code: Select all

Dim As String TheArray(10)

sub StringArraySort(strings() as string)
  dim as integer l=lbound(Strings)
  dim as integer u=ubound(Strings)
  dim as integer n=u-l
  dim as integer flag,i,j,k,l1,l2
  ' nothing to sort I
  if n<2 then return
  ' optional move empty strings 
  ' to the end of array
  do
    flag=0
    for i=l to u-1
      j=i+1
      if len(Strings(i))=0 and len(Strings(j))>0 then
        swap Strings(i),Strings(j)
        flag=-1:exit for
      end if
    next
  loop while Flag
  for i=l to u
    if len(Strings(i))=0 then u=i-1:exit for
  next
  n=u-l
  ' nothing to sort II
  if n<2 then return

  ' sort by ASCI codes
  do
    flag=0
    ' loop over all items
    for i=l to u-1
      j=i+1
      l1=len(Strings(i))
      l2=len(Strings(j))
      if l1>l2 then swap l1,l2
      for k=0 to l1-1
        if k then
          if strings(i)[k-1]=strings(j)[k-1] then
            if strings(i)[k]>strings(j)[k] then
              swap Strings(i),Strings(j)
              flag=1:exit for
            end if
          end if
        else
          if strings(i)[k]>strings(j)[k] then
            swap Strings(i),Strings(j)
            flag=1:exit for
          end if
        end if
      next
      if flag=-1 then exit for
    next
  loop while flag
end sub

TheArray(0)="ABCF"
TheArray(1)=""
TheArray(2)="aBcD"
TheArray(3)="2abcD"
TheArray(4)="1abcC"
TheArray(5)="1ABC"
TheArray(6)="ABCD"
TheArray(7)="aBcd"
TheArray(8)=""
TheArray(9)=""
TheArray(10)="ABC"

for i as integer=0 to 10
  ? TheArray(i)
next
? string(20,"=")
StringArraySort TheArray(0)
for i as integer=0 to 10
  if len(TheArray(i)) then ? TheArray(i)
next
? string(20,"=")
sleep

notthecheatr · Post by **notthecheatr** » Dec 16, 2007 23:20

Yes, this lets you treat a string like a byte pointer, and it's much faster than using Asc and Mid.

One point to note: With Mid, the character position is 1-based (i.e., the first character in a string is 1) but with [] the first character is 0.

rdc · Post by **rdc** » Dec 17, 2007 11:55

How about Qsort:

http://virtualink.wikidot.com/fbex21

yetifoot · Post by **yetifoot** » Dec 17, 2007 17:17

Yes, looks like good work, you can save some time/code by using qsort from the crt.bi header normally, here's an example I did for an array for strings:

http://www.freebasic.net/forum/viewtopi ... 2704#52704

bcohio2001 · Post by **bcohio2001** » Dec 18, 2007 2:01

@DJ & notthecheatr

Yes, I knew about the [] pointer, but was unsure if it would do exactly what I wanted to do.

@yetifoot & rdc

Thanks for the tip on qsort. I didn't even know it existed. I think I will try to impliment it in other prgs.

Maybe there should be a searchable DB of useable functions and subs in the documentation. Or something that lists them and a little discription on what they do and how to use them.

Sort of like:
xxxxx.bi
--------- function aBc(as string) as string
---------------- alternates lower and upper case.
--------- function ABC(as string) as string
---------------- make all upper case
--------- function scramb(as string) as string
---------------- scrambles string

I hope you get my point.

Post by **counting_pine** » Dec 21, 2007 9:01

By the way, that if you don't want to use string indexing, it's worth noting that FB has another alternative to asc(mid(s, i, 1)): You can do asc(s, i) instead.

elsairon · Post by **elsairon** » Dec 21, 2007 16:42

bcohio2001 wrote:Maybe there should be a searchable DB of useable functions and subs in the documentation. Or something that lists them and a little discription on what they do and how to use them.

Sort of like:
xxxxx.bi
--------- function aBc(as string) as string
---------------- alternates lower and upper case.
--------- function ABC(as string) as string
---------------- make all upper case
--------- function scramb(as string) as string
---------------- scrambles string

I think this is a great idea. Right now there is a lot of code scattered aross the forums and on various peoples websites. Very small amount of what is available is linked to documentation or posted in the archive.

As more people add code, the archive becomes more useful like you mention. (It just takes a while)