## Insertion of string into an array in alphabetical order

bcohio2001
Posts: 553
Joined: Mar 10, 2007 15:44
Location: Ohio, USA
Contact:

### Insertion of string into an array in alphabetical order

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), InsertStrDim As UByte LCount, x, y, CmpFlagDeclare 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 elementx = 0Do   x += 1   CmpFlag = StrComp(InsertStr, TheArray(x), 1) Loop Until x = LCount Or CmpFlag = 1LCount += 1If CmpFlag = 1 Then 'insert inside array   y = LCount   While y > x      TheArray(y) = TheArray(y - 1)      y -= 1   Wend   TheArray(x) = InsertStrElse 'add to end   TheArray(LCount) = InsertStrEndIfFunction 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_PtrEnd Function`
D.J.Peters
Posts: 8179
Joined: May 28, 2005 3:28
Contact:
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 flagend subTheArray(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:
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:
yetifoot
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:
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:
@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
Posts: 6225
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
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
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)