Squares

[albert]

@RollieBollocks

If you can translate the neural net code , that would be great.. I'm sure a lot of other programmers could use it as well.
There's a lot of game programmers on the forum , that probably could add ai into their games.

Thanks!!

[rolliebollocks]

It's going to take a bit of time, I am currently working on a similar project to your chatbot, but more for generating text than conversation.

You may find this useful. Load a textfile into a string and then send it to the wordGramCtx.Eat( string ) command.

You can generate text with wordGramCtx.genLine ( integer ) as string

I am using it to make guesses on part of speech as well as the joy it brings me to read randomly generated text.

:D

Code: Select all

Type wordgram
    as zstring ptr          txt
    as integer              link(256)
    as single               link_strength(256)
    as integer              nLinks
    
    declare Constructor ()
    declare Constructor ( byref rhs as wordgram )
    declare Destructor ()
    declare Operator Let ( byref rhs as wordgram )
end type

Constructor wordgram()
end Constructor

Destructor wordgram()
    deallocate( txt )
    erase( link )
    erase( link_strength )
    nLinks = 0
end Destructor

Constructor wordgram( byref rhs as wordgram )
    this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
    *this.txt = *rhs.txt
    for i as integer = 0 to nLinks-1
        this.link(i) = rhs.link(i)
        this.link_strength(i) = rhs.link_strength(i)
    next
end Constructor

Operator wordgram.Let( byref rhs as wordgram )
    this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
    *this.txt = *rhs.txt
    for i as integer = 0 to nLinks-1
        this.link(i) = rhs.link(i)
        this.link_strength(i) = rhs.link_strength(i)
    next
end Operator

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#DEFINE MAX_NGRAMS 150000

type wordGramCtx
    as integer          nWGrams = 0
    as wordgram ptr     words
    
    declare Constructor ()
    declare Destructor ()
    declare Constructor ( byref rhs as wordgramCtx )
    declare Operator Let ( byref rhs as wordgramCtx )
    
    declare Function WordGramPtrByTxt ( byref intxt as string ) as wordgram ptr
    declare function WordGramIdxByTxt ( byref intxt as string ) as integer
    declare sub      AddWord(byref _word as string, byval check as integer=1)
    declare Sub      AddLink(byref _word as string, byref _wordgram as string, byval linkstrength as integer=0)
    declare sub      RemLink(byref _word as string, byref _wordgram as string)
    declare sub      Eat ( byref s as string )
    declare function GenLine ( byval nwords as integer = 0 ) as string
    declare sub      ClearBias ()
    
    declare sub     Save ( byref fn as string )
    declare sub     Load ( byref fn as string )
end type

Constructor wordGramCtx()
    words = new wordgram[MAX_NGRAMS]
end Constructor

Destructor wordGramCtx()
    delete [] words 
    nwgrams = 0
end Destructor

Constructor wordGramCtx( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    this.words = callocate( this.nwgrams, sizeof(wordgram) )
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Constructor

Operator wordGramCtx.Let( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    this.words = callocate( this.nwgrams, sizeof(wordgram) )
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Operator

function wordgramCtx.WordGramPtrByTxt ( byref intxt as string ) as wordgram ptr
    for i as integer = 0 to nWGrams-1
        if intxt = *words[i].txt then return @words[i]
    next
    
    return 0
end function 

function wordgramCtx.WordGramIdxByTxt ( byref intxt as string ) as integer
    for i as integer = 0 to nWGrams-1
        if intxt = *words[i].txt then return i
    next
    
    return -1
end function 

sub wordgramCtx.AddWord( byref _word as string, byval check as integer = 1 )
        
        if _word = "" then exit sub
        if this.nwgrams > MAX_NGRAMS then
            ? "MAX NGRAMS EXCEDED"
            exit sub
        endif
        
        if check = 1 then
            for i as integer = 0 to nWGrams-1
                if *words[i].txt = _word then exit sub
            next
        endif
        
        nWGrams += 1
        words[nwgrams-1].txt = callocate( len(_word)+1, sizeof(zstring) )
        *words[nWGrams-1].txt = _word
        
End sub

Sub wordgramCtx.AddLink( byref _word as string, byref _wordgram as string, byval linkstrength as integer=0 )
    
        if _word = "" then exit sub
        if _wordgram = "" then exit sub
    
        'Get the objects for the words specified
        
        dim as integer wg1, wg2
        
        wg1 = WordGramIdxByTxt( _word )
        if wg1 = -1 then 
            AddWord(_word,0)
            wg1 = nwgrams-1
        endif
        
        wg2 = WordGramIdxByTxt( _wordgram )
        
        if wg2 <> -1 then        
            for i as integer = 0 to this.words[ wg1 ].nLinks-1
                if wg2 = this.words[ wg1 ].Link(i) then
                    this.words[ wg1 ].Link_Strength(i) += 1
                    exit sub
                endif
            next
        else
            AddWord (_wordgram,0)
            wg2 = nwgrams-1
        endif
        
        if this.words[ wg1 ].nLinks < 256 then
            this.words[ wg1 ].nLinks += 1
            this.words[ wg1 ].Link( this.words[ wg1 ].nLinks-1 ) = wg2
            if linkstrength = 0 then             
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += 1
            else
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += linkstrength
            end if
        End If
        
        
End sub

sub wordgramCtx.Eat ( byref s as string )
        
        s &= " "
    
        dim as integer bgn=0, lentxt = len(s)-1
        dim as string newstring = ""
        dim as string delim = " !?.,<>[]" & !"\r\n"
        
        dim as string intxt = ""
    
        for i as integer = 0 to lentxt
            for ii as integer = 0 to len(delim)-1
                if s[i] = delim[ii] then
                    intxt = newstring
                    newstring = RIGHT ( LEFT ( s, i ), i-bgn )
                    bgn = i+1
                        if intxt <> "" then
                            AddLink(intxt, newstring)
                        endif
                endif
            next
        next
        
end sub

function wordgramCtx.GenLine ( byval nwords as integer = 0 ) as string
    
    'Picks 2 words at random then chooses the higher roll of link_strength()
    
    dim as string res = ""

    If nWGrams = 0 Then Return "Eat some words."
        
        'Pick a keyword for the reply 

        if nWords = 0 then nWords = int(rnd*12)
        
        dim as integer pick = int(Rnd(1)* nWGrams) - 1
        if pick < 0 then pick=0
        'dim as integer t = @words[pick]
        dim as string last = ""

        for i as integer = 1 to nwords
            
                if this.words[ pick ].nLinks > 1 then
                    dim as integer pick1, pick2, roll1, roll2
                    pick1 = int(rnd(1) * this.words[ pick ].nLinks)
                    pick2 = int(rnd(1) * this.words[ pick ].nLinks)
                
                    roll1 = rnd * this.words[ pick ].Link_Strength( pick1 )
                    roll2 = rnd * this.words[ pick ].Link_Strength( pick2 )
                    
                    If roll1 > roll2 Then 
                        pick = this.words[ pick ].Link( pick1 )
                    Else 
                        pick = this.words[ pick ].Link( pick2 )
                    endif
                elseif this.words[ pick ].nLinks = 1 then
                    pick = this.words[ pick ].Link( 0 )
                elseif this.words[ pick ].nLinks = 0 then
                    res &= ". "
                    pick = int(Rnd(1)* nWGrams) - 1
                    if pick < 0 then pick=0
                endif             

                res = res + *this.words[ pick ].Txt + " "
        
        next                
        
        Return res

end function

sub wordgramCtx.Save ( byref fn as string )
    
    open fn for output as #1
    dim as string outstr = ""
    
    for i as integer = 0 to nWGrams-1
        outstr = *words[i].txt & !"\t" 
        for ii as integer = 0 to words[i].nLinks-1
            outstr &= "(" + str(words[i].link(ii)) + "/" + str(words[i].link_strength(ii))+ ")"
        next
        print #1, outstr
    next

    close #1

end sub

sub wordgramCtx.Load ( byref fn as string )
    
    open fn for input as #1
    
    dim as string in="", txt=""
    dim as integer nlnks=0
    dim as integer idx=0, spot1=0, spot2=0, spot3=0, inlink=0, instrength=0, nw=0, nl=0
    
    while not eof(1)        
        line input #1, in
        idx = instr(in, !"\t")-1
        txt = left(in, idx)
        in = right(in, len(in)-idx-1)
        spot1=instr(in, "(")
        spot2=instr(in, "/")
        spot3=instr(in, ")")
        this.nwgrams += 1
        this.words[nwgrams-1].txt = callocate( len(txt)+1 )
        *this.words[nwgrams-1].txt = txt
        do
            inlink = val(mid(in,spot1+1,spot2-spot1-1))
            instrength = val(mid(in,spot2+1,spot3-spot2-1))
            spot1=instr(spot3,in, "(")
            spot2=instr(spot1,in, "/")
            spot3=instr(spot2,in, ")")
            words[nwgrams-1].link( words[nwgrams-1].nlinks ) = inlink
            words[nwgrams-1].link_strength( words[nwgrams-1].nlinks ) = instrength
            words[nwgrams-1].nlinks += 1
        loop until spot1 = 0
    wend
    
    close #1

end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

[TESLACOIL]

Sadly the info in the third video shows we haven't really moved on from the 1980's despite understanding very well what needs to be done. Some problems are non trivial and speech anything is one of those problems.


VODER (1939) - Early Speech Synthesizer, a mechanical system built almost 100 years ago.
http://www.youtube.com/watch?v=0rAyrmm7vv0

Donald Sherman orders a pizza using a talking computer ( 1974)
http://www.youtube.com/watch?v=94d_h_t2QAA

Computer Chronicles - Speech Synthesis (1984)
http://www.youtube.com/watch?v=OXB9v3z22MI

[fxm]

rolliebollocks, I rapidly watched your beginning code and I propose you some modifications, mainly to avoid memory leaks (each proposed modification is comented):

Code: Select all

Constructor wordgram()
end Constructor

Destructor wordgram()
    deallocate( this.txt )
    'erase( link )  '' useless
    'erase( link_strength )  '' useless
    'nLinks = 0  '' usless
end Destructor

Constructor wordgram( byref rhs as wordgram )
    this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
    *this.txt = *rhs.txt
    this.nLinks = rhs.nLinks  '' copy useful size of arrays
    for i as integer = 0 to this.nLinks-1
        this.link(i) = rhs.link(i)
        this.link_strength(i) = rhs.link_strength(i)
    next
end Constructor

Operator wordgram.Let( byref rhs as wordgram )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
        deallocate( this.txt )  '' deallocate previous allocated memory
        this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
        *this.txt = *rhs.txt
        this.nLinks = rhs.nLinks  '' copy useful size of arrays
        for i as integer = 0 to this.nLinks-1
            this.link(i) = rhs.link(i)
            this.link_strength(i) = rhs.link_strength(i)
        next
    end if
end Operator


Constructor wordGramCtx()
    this.words = new wordgram[MAX_NGRAMS]
end Constructor

Destructor wordGramCtx()
    delete [] this.words
    'nwgrams = 0  '' useless
end Destructor

Constructor wordGramCtx( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    'this.words = callocate( this.nwgrams, sizeof(wordgram) )  '' incompatible of destructor
    this.words = new wordgram[MAX_NGRAMS]
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Constructor

Operator wordGramCtx.Let( byref rhs as wordGramCtx )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
        delete [] this.words  '' destroy previous objects
        this.nwgrams = rhs.nwgrams
        'this.words = callocate( this.nwgrams, sizeof(wordgram) )  '' incompatible of destructor
        this.words = new wordgram[MAX_NGRAMS]
        for i as integer = 0 to this.nwgrams-1
            this.words[i] = rhs.words[i]
        next
    end if
end Operator

function wordgramCtx.WordGramPtrByTxt ( byref intxt as string ) as wordgram ptr
    for i as integer = 0 to nWGrams-1
        if intxt = *words[i].txt then return @words[i]
    next
   
    return 0
end function

function wordgramCtx.WordGramIdxByTxt ( byref intxt as string ) as integer
    for i as integer = 0 to nWGrams-1
        if intxt = *words[i].txt then return i
    next
   
    return -1
end function

sub wordgramCtx.AddWord( byref _word as string, byval check as integer = 1 )
       
        if _word = "" then exit sub
        if this.nwgrams >= MAX_NGRAMS then '' greater or equal
            ? "MAX NGRAMS EXCEDED"
            exit sub
        endif
       
        if check = 1 then
            for i as integer = 0 to nWGrams-1
                if *words[i].txt = _word then exit sub
            next
        endif
       
        nWGrams += 1
        words[nwgrams-1].txt = callocate( len(_word)+1, sizeof(zstring) )
        *words[nWGrams-1].txt = _word
       
End sub

You can also see the text and the simple example I have put in documentation at KeyPgOpLet.

[rolliebollocks]

Excellent! Thank you. I couldn't keep the reallocate code. It was too slow. I have to eat up to 500k of text, and for what ever reason, it is faster to do it like this. Thanks for the tips.

[fxm]

As you search fast processing and as each text is internally memorized with 'zstring'/'zstring ptr', it is faster to work with 'zstring'/'zstring ptr' the earliest possible stage.
For example, when the wordgramCtx.AddLink() body calls WordGramIdxByTxt() or AddWord(), it is more efficient to pass the text parameter as a 'zstring ptr', and so...

In any case, an argument of any string type may be directly passed to a procedure referring to a parameter declared as 'zstring ptr'. The compiler performs itself an automatic conversion (without warning message) between any string and 'zstring ptr' (for example to make calling the C runtime functions very easy).
So the user can directly call a such procedure with a string (or obviously a 'zstring ptr').

Perhaps you could try these some modifications:

Code: Select all

    declare Function WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    declare function WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    declare sub      AddWord(byval _word as zstring ptr, byval check as integer=1)
    declare Sub      AddLink(byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0)

function wordgramCtx.WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return @words[i]
    next
   
    return 0
end function

function wordgramCtx.WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return i
    next
   
    return -1
end function

sub wordgramCtx.AddWord( byval _word as zstring ptr, byval check as integer = 1 )
       
        if *_word = "" then exit sub
        if this.nwgrams >= MAX_NGRAMS then '' greater or equal
            ? "MAX NGRAMS EXCEDED"
            exit sub
        endif
       
        if check = 1 then
            for i as integer = 0 to nWGrams-1
                if *words[i].txt = *_word then exit sub
            next
        endif
       
        nWGrams += 1
        words[nwgrams-1].txt = callocate( len(*_word)+1, sizeof(zstring) )
        *words[nWGrams-1].txt = *_word
       
End sub

Sub wordgramCtx.AddLink( byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0 )
   
        if *_word = "" then exit sub
        if *_wordgram = "" then exit sub
   
        'Get the objects for the words specified
       
        dim as integer wg1, wg2
       
        wg1 = WordGramIdxByTxt( _word )
        if wg1 = -1 then
            AddWord(_word,0)
            wg1 = nwgrams-1
        endif
       
        wg2 = WordGramIdxByTxt( _wordgram )
       
        if wg2 <> -1 then        
            for i as integer = 0 to this.words[ wg1 ].nLinks-1
                if wg2 = this.words[ wg1 ].Link(i) then
                    this.words[ wg1 ].Link_Strength(i) += 1
                    exit sub
                endif
            next
        else
            AddWord (_wordgram,0)
            wg2 = nwgrams-1
        endif
       
        if this.words[ wg1 ].nLinks < 256 then
            this.words[ wg1 ].nLinks += 1
            this.words[ wg1 ].Link( this.words[ wg1 ].nLinks-1 ) = wg2
            if linkstrength = 0 then            
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += 1
            else
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += linkstrength
            end if
        End If
       
       
End sub

[rolliebollocks]

Cool. Works great.

Code: Select all

Type wordgram
    as zstring ptr          txt
    as integer              link(256)
    as single               link_strength(256)
    as integer              nLinks
    
    declare Constructor ()
    declare Constructor ( byref rhs as wordgram )
    declare Destructor ()
    declare Operator Let ( byref rhs as wordgram )
end type

Constructor wordgram()
end Constructor

Destructor wordgram()
    deallocate( txt )
end Destructor

Constructor wordgram( byref rhs as wordgram )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
        deallocate( this.txt )  '' deallocate previous allocated memory
        this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
        *this.txt = *rhs.txt
        for i as integer = 0 to nLinks-1
            this.link(i) = rhs.link(i)
            this.link_strength(i) = rhs.link_strength(i)
        next
    endif
end Constructor

Operator wordgram.Let( byref rhs as wordgram )
    this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
    *this.txt = *rhs.txt
    for i as integer = 0 to nLinks-1
        this.link(i) = rhs.link(i)
        this.link_strength(i) = rhs.link_strength(i)
    next
end Operator

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#DEFINE MAX_NGRAMS 50000

type wordGramCtx
    as integer          nWGrams = 0
    as wordgram ptr     words
    
    declare Constructor ()
    declare Destructor ()
    declare Constructor ( byref rhs as wordgramCtx )
    declare Operator Let ( byref rhs as wordgramCtx )
    
    declare Function WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    declare function WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    declare sub      AddWord(byval _word as zstring ptr, byval check as integer=1)
    declare Sub      AddLink(byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0)
    declare sub      RemLink(byval _word as zstring ptr, byval _wordgram as zstring ptr)
    declare sub      Eat ( byref s as string )
    declare function GenLine ( byval nwords as integer = 0 ) as string
    declare sub      ClearBias ()
    
    declare sub     Save ( byref fn as string )
    declare sub     Load ( byref fn as string )
end type

Constructor wordGramCtx()
    words = new wordgram[MAX_NGRAMS]
end Constructor

Destructor wordGramCtx()
    delete [] words 
end Destructor

Constructor wordGramCtx( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    this.words = new wordgram[MAX_NGRAMS]
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Constructor

Operator wordGramCtx.Let( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    this.words = new wordgram[MAX_NGRAMS]
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Operator

function wordgramCtx.WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return @words[i]
    next
    
    return 0
end function 

function wordgramCtx.WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return i
    next
    
    return -1
end function 

sub wordgramCtx.AddWord( byval _word as zstring ptr, byval check as integer = 1 )
        
        if *_word = "" then exit sub
        if this.nwgrams >= MAX_NGRAMS then
            ? "MAX NGRAMS EXCEDED"
            exit sub
        endif
        
        if check = 1 then
            for i as integer = 0 to nWGrams-1
                if *words[i].txt = *_word then exit sub
            next
        endif
        
        nWGrams += 1
        words[nwgrams-1].txt = callocate( len(_word)+1, sizeof(zstring) )
        *words[nWGrams-1].txt = *_word
        
End sub

Sub wordgramCtx.AddLink( byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0 )
    
        if *_word = "" then exit sub
        if *_wordgram = "" then exit sub
    
        'Get the objects for the words specified
        
        dim as integer wg1, wg2
        
        wg1 = WordGramIdxByTxt( _word )
        if wg1 = -1 then 
            AddWord(_word,0)
            wg1 = nwgrams-1
        endif
        
        wg2 = WordGramIdxByTxt( _wordgram )
        
        if wg2 <> -1 then        
            for i as integer = 0 to this.words[ wg1 ].nLinks-1
                if wg2 = this.words[ wg1 ].Link(i) then
                    this.words[ wg1 ].Link_Strength(i) += 1
                    exit sub
                endif
            next
        else
            AddWord (_wordgram,0)
            wg2 = nwgrams-1
        endif
        
        if this.words[ wg1 ].nLinks < 256 then
            this.words[ wg1 ].nLinks += 1
            this.words[ wg1 ].Link( this.words[ wg1 ].nLinks-1 ) = wg2
            if linkstrength = 0 then             
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += 1
            else
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += linkstrength
            end if
        End If
        
        
End sub

sub wordgramCtx.Eat ( byref s as string )
        
        s &= " "
    
        dim as integer bgn=0, lentxt = len(s)-1
        dim as string newstring = ""
        dim as string delim = " !?.,<>[]" & !"\r\n"
        
        dim as string intxt = ""
    
        for i as integer = 0 to lentxt
            for ii as integer = 0 to len(delim)-1
                if s[i] = delim[ii] then
                    intxt = newstring
                    newstring = RIGHT ( LEFT ( s, i ), i-bgn )
                    bgn = i+1
                        if intxt <> "" then
                            AddLink(intxt, newstring)
                        endif
                endif
            next
        next
        
end sub

function wordgramCtx.GenLine ( byval nwords as integer = 0 ) as string
    
    'Picks 2 words at random then chooses the higher roll of link_strength()
    
    dim as string res = ""

    If nWGrams = 0 Then Return "Eat some words."
        
        'Pick a keyword for the reply 

        if nWords = 0 then nWords = int(rnd*12)
        
        dim as integer pick = int(Rnd(1)* nWGrams) - 1
        if pick < 0 then pick=0
        'dim as integer t = @words[pick]
        dim as string last = ""

        for i as integer = 1 to nwords
            
                if this.words[ pick ].nLinks > 1 then
                    dim as integer pick1, pick2, roll1, roll2
                    pick1 = int(rnd(1) * this.words[ pick ].nLinks)
                    pick2 = int(rnd(1) * this.words[ pick ].nLinks)
                
                    roll1 = rnd * this.words[ pick ].Link_Strength( pick1 )
                    roll2 = rnd * this.words[ pick ].Link_Strength( pick2 )
                    
                    If roll1 > roll2 Then 
                        pick = this.words[ pick ].Link( pick1 )
                    Else 
                        pick = this.words[ pick ].Link( pick2 )
                    endif
                elseif this.words[ pick ].nLinks = 1 then
                    pick = this.words[ pick ].Link( 0 )
                elseif this.words[ pick ].nLinks = 0 then
                    res &= ". "
                    pick = int(Rnd(1)* nWGrams) - 1
                    if pick < 0 then pick=0
                endif             

                res = res + *this.words[ pick ].Txt + " "
        
        next                
        
        Return res

end function

sub wordgramCtx.Save ( byref fn as string )
    
    open fn for output as #1
    dim as string outstr = ""
    
    for i as integer = 0 to nWGrams-1
        outstr = *words[i].txt & !"\t" 
        for ii as integer = 0 to words[i].nLinks-1
            outstr &= "(" + str(words[i].link(ii)) + "/" + str(words[i].link_strength(ii))+ ")"
        next
        print #1, outstr
    next

    close #1

end sub

sub wordgramCtx.Load ( byref fn as string )
    
    open fn for input as #1
    
    dim as string in="", txt=""
    dim as integer nlnks=0
    dim as integer idx=0, spot1=0, spot2=0, spot3=0, inlink=0, instrength=0, nw=0, nl=0
    
    while not eof(1)        
        line input #1, in
        idx = instr(in, !"\t")-1
        txt = left(in, idx)
        in = right(in, len(in)-idx-1)
        spot1=instr(in, "(")
        spot2=instr(in, "/")
        spot3=instr(in, ")")
        this.nwgrams += 1
        this.words[nwgrams-1].txt = callocate( len(txt)+1 )
        *this.words[nwgrams-1].txt = txt
        do
            inlink = val(mid(in,spot1+1,spot2-spot1-1))
            instrength = val(mid(in,spot2+1,spot3-spot2-1))
            spot1=instr(spot3,in, "(")
            spot2=instr(spot1,in, "/")
            spot3=instr(spot2,in, ")")
            words[nwgrams-1].link( words[nwgrams-1].nlinks ) = inlink
            words[nwgrams-1].link_strength( words[nwgrams-1].nlinks ) = instrength
            words[nwgrams-1].nlinks += 1
        loop until spot1 = 0
    wend
    
    close #1

end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dim as wordGramCtx w
w.eat( "1 2 3 4 5 6 7 8" )
? w.genLine(150)

sleep
cls

? w.nwgrams

for i as integer = 0 to w.nwgrams-1
    ? *w.words[i].txt
next

sleep

[fxm]

I do not fully found the proposed modifications from my first post and even an incoherent mix between copy-constructor body and let-operator body.
See below my full modifications proposal (synthesis from my two posts):

Code: Select all

Type wordgram
    as zstring ptr          txt
    as integer              link(256)
    as single               link_strength(256)
    as integer              nLinks
   
    declare Constructor ()
    declare Constructor ( byref rhs as wordgram )
    declare Destructor ()
    declare Operator Let ( byref rhs as wordgram )
end type

Constructor wordgram()
end Constructor

Destructor wordgram()
    deallocate( this.txt )
    'erase( link )  '' useless
    'erase( link_strength )  '' useless
    'nLinks = 0  '' usless
end Destructor

Constructor wordgram( byref rhs as wordgram )
    this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
    *this.txt = *rhs.txt
    this.nLinks = rhs.nLinks  '' copy useful size of arrays
    for i as integer = 0 to this.nLinks-1
        this.link(i) = rhs.link(i)
        this.link_strength(i) = rhs.link_strength(i)
    next
end Constructor

Operator wordgram.Let( byref rhs as wordgram )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
        deallocate( this.txt )  '' deallocate previous allocated memory
        this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
        *this.txt = *rhs.txt
        this.nLinks = rhs.nLinks  '' copy useful size of arrays
        for i as integer = 0 to this.nLinks-1
            this.link(i) = rhs.link(i)
            this.link_strength(i) = rhs.link_strength(i)
        next
    end if
end Operator

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#DEFINE MAX_NGRAMS 150000

type wordGramCtx
    as integer          nWGrams = 0
    as wordgram ptr     words
   
    declare Constructor ()
    declare Destructor ()
    declare Constructor ( byref rhs as wordgramCtx )
    declare Operator Let ( byref rhs as wordgramCtx )
   
    declare Function WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    declare function WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    declare sub      AddWord(byval _word as zstring ptr, byval check as integer=1)
    declare Sub      AddLink(byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0)
    declare sub      RemLink(byref _word as string, byref _wordgram as string)
    declare sub      Eat ( byref s as string )
    declare function GenLine ( byval nwords as integer = 0 ) as string
    declare sub      ClearBias ()
   
    declare sub     Save ( byref fn as string )
    declare sub     Load ( byref fn as string )
end type

Constructor wordGramCtx()
    this.words = new wordgram[MAX_NGRAMS]
end Constructor

Destructor wordGramCtx()
    delete [] this.words
    'nwgrams = 0  '' useless
end Destructor

Constructor wordGramCtx( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    'this.words = callocate( this.nwgrams, sizeof(wordgram) )  '' incompatible of destructor
    this.words = new wordgram[MAX_NGRAMS]
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Constructor

Operator wordGramCtx.Let( byref rhs as wordGramCtx )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
        delete [] this.words  '' destroy previous objects
        this.nwgrams = rhs.nwgrams
        'this.words = callocate( this.nwgrams, sizeof(wordgram) )  '' incompatible of destructor
        this.words = new wordgram[MAX_NGRAMS]
        for i as integer = 0 to this.nwgrams-1
            this.words[i] = rhs.words[i]
        next
    end if
end Operator

function wordgramCtx.WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return @words[i]
    next
   
    return 0
end function

function wordgramCtx.WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return i
    next
   
    return -1
end function

sub wordgramCtx.AddWord( byval _word as zstring ptr, byval check as integer = 1 )
       
        if *_word = "" then exit sub
        if this.nwgrams >= MAX_NGRAMS then '' greater or equal
            ? "MAX NGRAMS EXCEDED"
            exit sub
        endif
       
        if check = 1 then
            for i as integer = 0 to nWGrams-1
                if *words[i].txt = *_word then exit sub
            next
        endif
       
        nWGrams += 1
        words[nwgrams-1].txt = callocate( len(*_word)+1, sizeof(zstring) )
        *words[nWGrams-1].txt = *_word
       
End sub

Sub wordgramCtx.AddLink( byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0 )
   
        if *_word = "" then exit sub
        if *_wordgram = "" then exit sub
   
        'Get the objects for the words specified
       
        dim as integer wg1, wg2
       
        wg1 = WordGramIdxByTxt( _word )
        if wg1 = -1 then
            AddWord(_word,0)
            wg1 = nwgrams-1
        endif
       
        wg2 = WordGramIdxByTxt( _wordgram )
       
        if wg2 <> -1 then        
            for i as integer = 0 to this.words[ wg1 ].nLinks-1
                if wg2 = this.words[ wg1 ].Link(i) then
                    this.words[ wg1 ].Link_Strength(i) += 1
                    exit sub
                endif
            next
        else
            AddWord (_wordgram,0)
            wg2 = nwgrams-1
        endif
       
        if this.words[ wg1 ].nLinks < 256 then
            this.words[ wg1 ].nLinks += 1
            this.words[ wg1 ].Link( this.words[ wg1 ].nLinks-1 ) = wg2
            if linkstrength = 0 then            
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += 1
            else
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += linkstrength
            end if
        End If
       
       
End sub

sub wordgramCtx.Eat ( byref s as string )
       
        s &= " "
   
        dim as integer bgn=0, lentxt = len(s)-1
        dim as string newstring = ""
        dim as string delim = " !?.,<>[]" & !"\r\n"
       
        dim as string intxt = ""
   
        for i as integer = 0 to lentxt
            for ii as integer = 0 to len(delim)-1
                if s[i] = delim[ii] then
                    intxt = newstring
                    newstring = RIGHT ( LEFT ( s, i ), i-bgn )
                    bgn = i+1
                        if intxt <> "" then
                            AddLink(intxt, newstring)
                        endif
                endif
            next
        next
       
end sub

function wordgramCtx.GenLine ( byval nwords as integer = 0 ) as string
   
    'Picks 2 words at random then chooses the higher roll of link_strength()
   
    dim as string res = ""

    If nWGrams = 0 Then Return "Eat some words."
       
        'Pick a keyword for the reply

        if nWords = 0 then nWords = int(rnd*12)
       
        dim as integer pick = int(Rnd(1)* nWGrams) - 1
        if pick < 0 then pick=0
        'dim as integer t = @words[pick]
        dim as string last = ""

        for i as integer = 1 to nwords
           
                if this.words[ pick ].nLinks > 1 then
                    dim as integer pick1, pick2, roll1, roll2
                    pick1 = int(rnd(1) * this.words[ pick ].nLinks)
                    pick2 = int(rnd(1) * this.words[ pick ].nLinks)
               
                    roll1 = rnd * this.words[ pick ].Link_Strength( pick1 )
                    roll2 = rnd * this.words[ pick ].Link_Strength( pick2 )
                   
                    If roll1 > roll2 Then
                        pick = this.words[ pick ].Link( pick1 )
                    Else
                        pick = this.words[ pick ].Link( pick2 )
                    endif
                elseif this.words[ pick ].nLinks = 1 then
                    pick = this.words[ pick ].Link( 0 )
                elseif this.words[ pick ].nLinks = 0 then
                    res &= ". "
                    pick = int(Rnd(1)* nWGrams) - 1
                    if pick < 0 then pick=0
                endif            

                res = res + *this.words[ pick ].Txt + " "
       
        next                
       
        Return res

end function

sub wordgramCtx.Save ( byref fn as string )
   
    open fn for output as #1
    dim as string outstr = ""
   
    for i as integer = 0 to nWGrams-1
        outstr = *words[i].txt & !"\t"
        for ii as integer = 0 to words[i].nLinks-1
            outstr &= "(" + str(words[i].link(ii)) + "/" + str(words[i].link_strength(ii))+ ")"
        next
        print #1, outstr
    next

    close #1

end sub

sub wordgramCtx.Load ( byref fn as string )
   
    open fn for input as #1
   
    dim as string in="", txt=""
    dim as integer nlnks=0
    dim as integer idx=0, spot1=0, spot2=0, spot3=0, inlink=0, instrength=0, nw=0, nl=0
   
    while not eof(1)        
        line input #1, in
        idx = instr(in, !"\t")-1
        txt = left(in, idx)
        in = right(in, len(in)-idx-1)
        spot1=instr(in, "(")
        spot2=instr(in, "/")
        spot3=instr(in, ")")
        this.nwgrams += 1
        this.words[nwgrams-1].txt = callocate( len(txt)+1 )
        *this.words[nwgrams-1].txt = txt
        do
            inlink = val(mid(in,spot1+1,spot2-spot1-1))
            instrength = val(mid(in,spot2+1,spot3-spot2-1))
            spot1=instr(spot3,in, "(")
            spot2=instr(spot1,in, "/")
            spot3=instr(spot2,in, ")")
            words[nwgrams-1].link( words[nwgrams-1].nlinks ) = inlink
            words[nwgrams-1].link_strength( words[nwgrams-1].nlinks ) = instrength
            words[nwgrams-1].nlinks += 1
        loop until spot1 = 0
    wend
   
    close #1

end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

[rolliebollocks]

You're right. I accidently saved over the modifications when I cut the text into the IDE. Oops!

[edit]

No, that wasn't the problem. I completely mixed that up. My fault, thanks for the catch. This should be correct.

ngram.bas

Code: Select all

Type wordgram
    as zstring ptr          txt
    as integer              link(256)
    as single               link_strength(256)
    as integer              nLinks
    
    declare Constructor ()
    declare Constructor ( byref rhs as wordgram )
    declare Destructor ()
    declare Operator Let ( byref rhs as wordgram )
end type

Constructor wordgram()
end Constructor

Destructor wordgram()
    deallocate( txt )
end Destructor

Constructor wordgram( byref rhs as wordgram )
    this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
    *this.txt = *rhs.txt
    this.nLinks = rhs.nLinks  '' copy useful size of arrays
    for i as integer = 0 to this.nLinks-1
        this.link(i) = rhs.link(i)
        this.link_strength(i) = rhs.link_strength(i)
    next
end Constructor

Operator wordgram.Let( byref rhs as wordgram )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
            deallocate( this.txt )  '' deallocate previous allocated memory
            this.txt = callocate( len(*rhs.txt)+1, sizeof(zstring) )
            *this.txt = *rhs.txt
            this.nLinks = rhs.nLinks  '' copy useful size of arrays
            for i as integer = 0 to this.nLinks-1
                this.link(i) = rhs.link(i)
                this.link_strength(i) = rhs.link_strength(i)
            next
    end if
end Operator

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#DEFINE MAX_NGRAMS 50000

type wordGramCtx
    as integer          nWGrams = 0
    as wordgram ptr     words
    
    declare Constructor ()
    declare Destructor ()
    declare Constructor ( byref rhs as wordgramCtx )
    declare Operator Let ( byref rhs as wordgramCtx )
    
    declare Function WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    declare function WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    declare sub      AddWord(byval _word as zstring ptr, byval check as integer=1)
    declare Sub      AddLink(byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0)
    declare sub      RemLink(byval _word as zstring ptr, byval _wordgram as zstring ptr)
    declare sub      Eat ( byref s as string )
    declare function GenLine ( byval nwords as integer = 0 ) as string
    declare sub      ClearBias ()
    
    declare sub     Save ( byref fn as string )
    declare sub     Load ( byref fn as string )
end type

Constructor wordGramCtx()
    words = new wordgram[MAX_NGRAMS]
end Constructor

Destructor wordGramCtx()
    delete [] words 
end Destructor

Constructor wordGramCtx( byref rhs as wordGramCtx )
    this.nwgrams = rhs.nwgrams
    this.words = new wordgram[MAX_NGRAMS]
    for i as integer = 0 to this.nwgrams-1
        this.words[i] = rhs.words[i]
    next
end Constructor

Operator wordGramCtx.Let( byref rhs as wordGramCtx )
    if @this <> @rhs then  '' check for self-assignment to avoid object destruction
            delete [] this.words  '' destroy previous objects
            this.nwgrams = rhs.nwgrams
            'this.words = callocate( this.nwgrams, sizeof(wordgram) )  '' incompatible of destructor
            this.words = new wordgram[MAX_NGRAMS]
            for i as integer = 0 to this.nwgrams-1
                this.words[i] = rhs.words[i]
            next
    end if
end Operator

function wordgramCtx.WordGramPtrByTxt ( byval intxt as zstring ptr ) as wordgram ptr
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return @words[i]
    next
    
    return 0
end function 

function wordgramCtx.WordGramIdxByTxt ( byval intxt as zstring ptr ) as integer
    for i as integer = 0 to nWGrams-1
        if *intxt = *words[i].txt then return i
    next
    
    return -1
end function 

sub wordgramCtx.AddWord( byval _word as zstring ptr, byval check as integer = 1 )
        
        if *_word = "" then exit sub
        if this.nwgrams >= MAX_NGRAMS then
            ? "MAX NGRAMS EXCEDED"
            exit sub
        endif
        
        if check = 1 then
            for i as integer = 0 to nWGrams-1
                if *words[i].txt = *_word then exit sub
            next
        endif
        
        nWGrams += 1
        words[nwgrams-1].txt = callocate( len(_word)+1, sizeof(zstring) )
        *words[nWGrams-1].txt = *_word
        
End sub

Sub wordgramCtx.AddLink( byval _word as zstring ptr, byval _wordgram as zstring ptr, byval linkstrength as integer=0 )
    
        if *_word = "" then exit sub
        if *_wordgram = "" then exit sub
    
        'Get the objects for the words specified
        
        dim as integer wg1, wg2
        
        wg1 = WordGramIdxByTxt( _word )
        if wg1 = -1 then 
            AddWord(_word,0)
            wg1 = nwgrams-1
        endif
        
        wg2 = WordGramIdxByTxt( _wordgram )
        
        if wg2 <> -1 then        
            for i as integer = 0 to this.words[ wg1 ].nLinks-1
                if wg2 = this.words[ wg1 ].Link(i) then
                    this.words[ wg1 ].Link_Strength(i) += 1
                    exit sub
                endif
            next
        else
            AddWord (_wordgram,0)
            wg2 = nwgrams-1
        endif
        
        if this.words[ wg1 ].nLinks < 256 then
            this.words[ wg1 ].nLinks += 1
            this.words[ wg1 ].Link( this.words[ wg1 ].nLinks-1 ) = wg2
            if linkstrength = 0 then             
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += 1
            else
                this.words[ wg1 ].Link_Strength ( this.words[ wg1 ].nLinks-1 ) += linkstrength
            end if
        End If
        
        
End sub

sub wordgramCtx.Eat ( byref s as string )
        
        s &= " "
    
        dim as integer bgn=0, lentxt = len(s)-1
        dim as string newstring = ""
        dim as string delim = " !?.,<>[]" & !"\r\n"
        
        dim as string intxt = ""
    
        for i as integer = 0 to lentxt
            for ii as integer = 0 to len(delim)-1
                if s[i] = delim[ii] then
                    intxt = newstring
                    newstring = RIGHT ( LEFT ( s, i ), i-bgn )
                    bgn = i+1
                        if intxt <> "" then
                            AddLink(intxt, newstring)
                        endif
                endif
            next
        next
        
end sub

function wordgramCtx.GenLine ( byval nwords as integer = 0 ) as string
    
    'Picks 2 words at random then chooses the higher roll of link_strength()
    
    dim as string res = ""

    If nWGrams = 0 Then Return "Eat some words."
        
        'Pick a keyword for the reply 

        if nWords = 0 then nWords = int(rnd*12)
        
        dim as integer pick = int(Rnd(1)* nWGrams) - 1
        if pick < 0 then pick=0
        'dim as integer t = @words[pick]
        dim as string last = ""

        for i as integer = 1 to nwords
            
                if this.words[ pick ].nLinks > 1 then
                    dim as integer pick1, pick2, roll1, roll2
                    pick1 = int(rnd(1) * this.words[ pick ].nLinks)
                    pick2 = int(rnd(1) * this.words[ pick ].nLinks)
                
                    roll1 = rnd * this.words[ pick ].Link_Strength( pick1 )
                    roll2 = rnd * this.words[ pick ].Link_Strength( pick2 )
                    
                    If roll1 > roll2 Then 
                        pick = this.words[ pick ].Link( pick1 )
                    Else 
                        pick = this.words[ pick ].Link( pick2 )
                    endif
                elseif this.words[ pick ].nLinks = 1 then
                    pick = this.words[ pick ].Link( 0 )
                elseif this.words[ pick ].nLinks = 0 then
                    res &= ". "
                    pick = int(Rnd(1)* nWGrams) - 1
                    if pick < 0 then pick=0
                endif             

                res = res + *this.words[ pick ].Txt + " "
        
        next                
        
        Return res

end function

sub wordgramCtx.Save ( byref fn as string )
    
    open fn for output as #1
    dim as string outstr = ""
    
    for i as integer = 0 to nWGrams-1
        outstr = *words[i].txt & !"\t" 
        for ii as integer = 0 to words[i].nLinks-1
            outstr &= "(" + str(words[i].link(ii)) + "/" + str(words[i].link_strength(ii))+ ")"
        next
        print #1, outstr
    next

    close #1

end sub

sub wordgramCtx.Load ( byref fn as string )
    
    open fn for input as #1
    
    dim as string in="", txt=""
    dim as integer nlnks=0
    dim as integer idx=0, spot1=0, spot2=0, spot3=0, inlink=0, instrength=0, nw=0, nl=0
    
    while not eof(1)        
        line input #1, in
        idx = instr(in, !"\t")-1
        txt = left(in, idx)
        in = right(in, len(in)-idx-1)
        spot1=instr(in, "(")
        spot2=instr(in, "/")
        spot3=instr(in, ")")
        this.nwgrams += 1
        this.words[nwgrams-1].txt = callocate( len(txt)+1 )
        *this.words[nwgrams-1].txt = txt
        do
            inlink = val(mid(in,spot1+1,spot2-spot1-1))
            instrength = val(mid(in,spot2+1,spot3-spot2-1))
            spot1=instr(spot3,in, "(")
            spot2=instr(spot1,in, "/")
            spot3=instr(spot2,in, ")")
            words[nwgrams-1].link( words[nwgrams-1].nlinks ) = inlink
            words[nwgrams-1].link_strength( words[nwgrams-1].nlinks ) = instrength
            words[nwgrams-1].nlinks += 1
        loop until spot1 = 0
    wend
    
    close #1

end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

[fxm]

A small typo but important error in wordgramCtx.AddWord():
.....
words[nwgrams-1].txt = callocate( len(_word)+1, sizeof(zstring) )
words[nwgrams-1].txt = callocate( len(*_word)+1, sizeof(zstring) )
.....

[rolliebollocks]

I'm surprised that compiled when I tested it. Thanks..

[fxm]

No compiler error because a 'zstring ptr' is also a variable (4 bytes length in 32bit x86).

[rolliebollocks]

Right, but it should have segfaulted for any string over 4 bytes, right? Sometimes, crazy things happen and it magically works though. Like my windows8 bug that worked on windows7.

[dodicat]

I tried out your chat box Albert.
It works a treat.

You sorts are very fast Dafhi, the flash sort / lerp sort is especially good.

Thank you all, Albert Dafhi, Integer and all regarding health, well, I'm 65 now, so anything can go wrong I suppose, but I'm a bit better.
Thanks for that navy link svarldez.
If I don't post in squares at least once a month then you'll all know that Dodicat is off the board, which reminds me that Richard, the instigator of squares has been away for three ???

[dafhi]

Thanks for checking that out dodi. A while back, you may have seen, I created 1 sort macro for both strings and numbers.

It uses one of your macro techniques .. ala sort (a, .part)

I've yet to incorporate the quick / lerp into the numeric part.

Thanks for posting the wormy gfx. Those guys are pretty entertaining. To us at least xD