FreeBasic

Что это за алгоритм и о принципах его работы , можете почитать здесь. Оттуда же был взят пример , написанный на С++ .

Платформы: windows , linux
Автор:  Станислав Беляев
Адаптация под freebasic: Станислав Будинов

Для примера нужен код реализации Vector

#INCLUDE "vector.bi"

Const k = 26 

Type bohr_vrtx
    
    As Byte next_vrtx(k)
    
    As Byte auto_move(k)
    
    As Long pat_num
    
    As Long suff_link
    
    As Long par
    
    As Long suff_flink
    
    As boolean flag
    
    As Byte symb    
    
End Type

T_VECTOR_0(pBohr , bohr_vrtx , bohr_vrtx Ptr)

T_VECTOR_0(pPattern , String  , String Ptr)

Dim Byref bohr As VECTORbohr_vrtx = *pBohr

Dim Byref pattern As VECTORString = *pPattern

Function make_bohr_vrtx( p As Long , c As Byte) As bohr_vrtx Ptr
    
    Dim As bohr_vrtx Ptr v = New bohr_vrtx

    For i As Long = 0 To Ubound(v->next_vrtx)
            
        v->next_vrtx(i) = -1
        
        v->auto_move(i) = -1
            
    Next
    
    v->flag=false
    
    v->suff_link=-1
    
    v->par = p
    
    v->symb = c
    
    v->suff_flink = -1

    Return v    
    
End Function

Sub bohr_init(bohr As VECTORbohr_vrtx)

    bohr.push_back(make_bohr_vrtx(0,Asc("$")))
    
End Sub

Sub bohr_deinit(bohr As VECTORbohr_vrtx)

    For i As Long = 0 To Bohr.iSize-1
        
        Delete(Bohr.pop_back())

    Next
    
End Sub

Sub add_string_to_bohr(bohr As VECTORbohr_vrtx , pattern As VECTORString, s As String Ptr)

    Dim As Long num
    
    For i As Long = 0 To Len(*s)-1
    
        Dim As Byte ch = (*s)[i] - Asc("a")

        If (bohr[num]->next_vrtx(ch) = -1) Then

            bohr.push_back(make_bohr_vrtx(num,ch))

            bohr[num]->next_vrtx(ch) = bohr.size() - 1

        Endif

        num = bohr[num]->next_vrtx(ch)

    Next

    bohr[num]->flag = true
    
    pattern.push_back(s)
    
    bohr[num]->pat_num = pattern.size()-1

End Sub

Function is_string_in_bohr(bohr As VECTORbohr_vrtx , s As String Ptr) As boolean
    
    Dim As Long num
    
    For i As Long = 0 To Len(*s)-1
        
        Dim As Byte ch = (*s)[i] - Asc("a")
        
        If (bohr[num]->next_vrtx(ch) = -1) Then
            
            Return false
            
        Endif
        
        num = bohr[num]->next_vrtx(ch)
        
    Next
    
    Return true 
    
End Function

Declare Function get_auto_move(bohr As VECTORbohr_vrtx , v As Long , ch As Byte) As Long

Function get_suff_link(bohr  As  VECTORbohr_vrtx , v As Long) As Long
    
    If (bohr[v]->suff_link = -1) Then
        
        If (v=0 ORELSE bohr[v]->par = 0) Then
            
            bohr[v]->suff_link = 0
            
        Else
            
            bohr[v]->suff_link = get_auto_move(bohr, get_suff_link(bohr ,bohr[v]->par), bohr[v]->symb)
            
        Endif
        
    Endif  
    
    Return bohr[v]->suff_link
    
End Function

Function get_auto_move(bohr As VECTORbohr_vrtx , v As Long , ch As Byte) As Long
    
    If (bohr[v]->auto_move(ch) = -1) Then
        
        If (bohr[v]->next_vrtx(ch) <> -1) Then
            
            bohr[v]->auto_move(ch) = bohr[v]->next_vrtx(ch)
            
        Else
            
            If (v=0) Then
                
                bohr[v]->auto_move(ch) = 0
                
            Else
                
                bohr[v]->auto_move(ch) = get_auto_move(bohr ,get_suff_link(bohr ,v), ch)
                
            Endif
            
        Endif      
        
    Endif     
    
    Return bohr[v]->auto_move(ch)
    
End Function

Function get_suff_flink(bohr As VECTORbohr_vrtx ,v As Long) As Long
    
    If (bohr[v]->suff_flink = -1) Then
        
        Dim As Long u = get_suff_link(bohr , v)
        
        If u = 0 Then
            
            bohr[v]->suff_flink = 0
            
        Else
            
            bohr[v]->suff_flink = Iif((bohr[u]->flag) = TRUE , u , get_suff_flink(bohr ,u))
            
        Endif   
        
    Endif
    
    Return bohr[v]->suff_flink
    
End Function

Sub check(bohr As VECTORbohr_vrtx , pattern As VECTORString , v As Long , i As Long)
    
    Dim As Long u = v
    
    While u <> 0
        
        If (bohr[u]->flag) Then
            
            Print i - Len(*(pattern[bohr[u]->pat_num]))+1 & " " & *(pattern[bohr[u]->pat_num])
            
        Endif
        
        u = get_suff_flink(bohr , u)
        
    Wend
    
End Sub

Sub find_all_pos(bohr As VECTORbohr_vrtx , pattern As VECTORString, s As String Ptr )
    
    Dim As Long u
    
    For i As Long = 0 To Len(*s)-1
        
        u = get_auto_move(bohr , u , (*s)[i] - Asc("a"))
        
        check (bohr , pattern, u , i+1 )
        
    Next
    
End Sub


bohr_init(bohr)

Dim As String s(...) => {"abc", "bcdc" , "cccb" , "bcdd" , "bbbc" , "abcdcbcddbbbcccbbbcccbb"}

add_string_to_bohr(bohr , pattern , @s(0))
add_string_to_bohr(bohr , pattern , @s(1))
add_string_to_bohr(bohr , pattern , @s(2))
add_string_to_bohr(bohr , pattern , @s(3))
add_string_to_bohr(bohr , pattern , @s(4))

find_all_pos(bohr , pattern , @s(5))

bohr_deinit(bohr)

Sleep