String Function count() - Count all instances of a character in a string

[dmontaine]

Slight modification of previously posted replace() function results in a new function count().

Useful if you need to find out how many delimited sub-strings are in a string. The number of sub-strings will be count()+1.

Code: Select all

'Program: CountFunctionExample
' This program demonstrates a count() function
' counts all instances of a character in a string

'==================================================
' count() function
'==================================================

function count(byval SearchString as string,byval SearchChar as string) as integer
	if len(SearchString) = 0 or len(SearchChar) = 0  then return 0
	
	dim CharCounter as integer
	dim sc as integer = asc(SearchChar)
	
	for Ctr as integer = 0 to len(SearchString) - 1
	    if SearchString[Ctr] = sc then CharCounter += 1      
	next
	
	Return CharCounter
end function

'==================================================
' Main Program
'==================================================
' Count the occurrences of "|"

width 80,24
dim InputString  as string = "a|b|c|d|e|f|g"

locate 1,1
print "count() function example program"
locate 3,5
print "The original string = " + InputString
locate 4,5
print "Intances of " + "|" + """ = " + str(count(InputString,"|"))
locate 6,1
print "Press any key to exit " ;
sleep

[fxm]

We can also use 'INSTR' to do the job:

Code: Select all

function count(byval SearchString as string,byval SearchChar as string) as integer
    if len(SearchString) = 0 or len(SearchChar) = 0  then return 0
    dim CharCounter as integer = 0
    dim location as integer = 0
    do
        location = instr(location + 1,SearchString,SearchChar)
        if location = 0 then return CharCounter else CharCounter += 1
    loop
end function

[thrive4]

A small riff on the code of fxm
gets the most occurring character in a string optionally
checks only alphabetic characters

Code: Select all

' search number of occurances of character in string
' courtesy fxm https://www.freebasic.net/forum/viewtopic.php?t=31778
function charcount(byval haystack as string,byval needle as string) as integer

    if len(haystack) = 0 or len(needle) = 0 then return 0
    dim cnt      as integer = 0
    dim location as integer = 0
    do
        location = instr(location + 1, haystack, needle)
        if location = 0 then return cnt else cnt += 1
    loop

end function

' return the most occurring character
Function getmaxchar(ByVal dummy As String, isalphabetic as boolean = true) As String
    Dim char       As String  = ""
    Dim charxcount As Integer = 0
    Dim maxchar    As String  = ""
    Dim maxcount   As Integer = 0

    For i As Integer = 0 To Len(dummy) - 1
        char       = Mid(dummy, i + 1, 1)
        charxcount = charcount(dummy, char)
        if isalphabetic then
            If char >= "a" And char <= "z" Or char >= "A" And char <= "Z" Then
                ' update maxchar and maxcount if the current character has a higher count
                If charxcount > maxcount Then
                    maxchar  = char
                    maxcount = charxcount
                End If
            End If
        else
            If charxcount > maxcount Then
                maxchar  = char
                maxcount = charxcount
            End If
        end if
    Next

    Return maxchar

End Function

print charcount("this is the way", "i")
print getmaxchar("this is the way;;;;;;", true)
sleep

[dodicat]

Another route:

Code: Select all

#cmdline "-gen gcc -Wc -O3"
Function removestring(somestring As String,partstring As String) As String
    Var ln=Len(somestring),lnp=Len(partstring)
    Var i=-1, inc=-1
    Dim As String g=String(ln,0)
    Do
        i+=1
        If somestring[i] <> partstring[0] Then 
            inc+=1
            g[inc]=somestring[i]
            Continue Do
        End If
        If somestring[i] = partstring[0] Then
            For j As Long=0 To lnp-1 
                If somestring[j+i]<>partstring[j] Then 
                    inc+=1
                    g[inc]=somestring[i]
                    Continue Do
                End If
            Next j
        End If
        i+=lnp-1
    Loop Until i>=ln-1 
    Return Rtrim(g,Chr(0))
End Function

Type ID
    As Long n 'frequency
    As String s'character
End Type


Sub QuickID(array() As ID,begin As Long,Finish As Long)'sort up
    Dim As Long i=begin,j=finish
    Dim As ID x =array(((I+J)\2))
    While I <= J
        While array(I).n < X .n:I+=1:Wend
            While array(J).n > X .n:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J > begin Then QuickID(array(),begin,J)
    If I < Finish Then QuickID(array(),I,Finish)
End Sub

sub getinfo(tt() as ID,s as string,lower as ubyte=32,upper as ubyte=128)
    redim tt(lower to upper)
   For n As Long=lower To upper
    tt(n).n=Len(s)- Len(removestring(s,Chr(n)))
    tt(n).s=Chr(n)
   Next 
   'sort up
  quickID(tt(),Lbound(tt),Ubound(tt))
end sub
        
  '=========================================      
        
        #define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
        
        Redim As ID tt()
        
        Randomize Timer
        Dim As String s=String(2000000,0)
        For n As Long=0 To Len(s)-1
            s[n]=Irange(32,128)'chosen range
        Next
        'fiddle about a bit
        s=removestring(s,"a")
        s=removestring(s,"z")
        s=s+"zz"
        s="aa"+s
        
        Print "Random string length ";Len(s)
        Dim As Double t
        t=Timer
        getinfo(tt(),s,32,128)
       
        Print "Frequncy","character"
        For n As Long=32 To 128
            Print tt(n).n,"'";tt(n).s;"'"
        Next
        Print Timer-t;" seconds"
        Print 
        Sleep