Insertion of string into an array in alphabetical order

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
bcohio2001
Posts: 553
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Insertion of string into an array in alphabetical order

Postby 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
Posts: 8177
Joined: May 28, 2005 3:28
Contact:

Postby 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
Posts: 1759
Joined: May 23, 2007 21:52
Location: Cut Bank, MT
Contact:

Postby 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
Posts: 1725
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » Dec 17, 2007 11:55

yetifoot
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:

Postby 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
Posts: 553
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

Postby 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.
counting_pine
Site Admin
Posts: 6225
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Postby 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
Posts: 207
Joined: Jul 02, 2005 14:51

Postby 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)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests