Squares

General FreeBASIC programming questions.
Locked
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Post by albert »

Hope you succeed kiyotewolf!!

Heres a "space-time wormhole"

Code: Select all

dim as integer xres,yres
screen 19
screeninfo xres,yres
screenres xres,yres

dim as double c1,c2,s1,s2
dim as double x1,x2,y1,y2
dim as double rad=atn(1)/45
dim as double xctr,yctr,radius=150
dim as double deg1,deg2,span

xctr=xres/2
yctr=yres/2
span=0
for deg1 = 0 to 360 step 2
    
    c1=cos(deg1*rad)
    s1=sin(deg1*rad)
    
    for deg2 = 0  to 360 step .5
        
        c2=cos(deg2*rad)
        s2=sin(deg2*rad)
    
        x1=radius*c2*s2*c2*4
        x2=radius*c1*sin(deg2*rad)'*tan(deg2*rad)*c2*2
        
        y1=radius*s1*sin(deg2*rad)'*tan(deg2*rad)*c2*2
        y2=radius*s2*c2*c2*4
        
        pset(xctr+x1+x2,yctr+y1+y2),9
        
    next
    
    sleep 5
        
next

sleep

Heres a cool looking square of the circle..

Code: Select all

dim as integer xres,yres
screen 19
screeninfo xres,yres
screenres xres,yres

dim as double c1,c2,s1,s2
dim as double x1,x2,y1,y2
dim as double rad=atn(1)/45
dim as double xctr,yctr,radius=150
dim as double deg1,deg2,span

xctr=xres/2
yctr=yres/2
span=0
for deg1 = 0 to 360 step 1
    
    c1=cos(deg1*rad)
    s1=sin(deg1*rad)
    
    for deg2 = 0  to 360 step 2
        
        c2=cos(deg2*rad)
        s2=sin(deg2*rad)
    
        x1=radius*c2
        x2=radius*c1*s2*s2*s2
        
        y1=radius*s1*c2*c2*c2
        y2=radius*s2
        
        pset(xctr+x1+x2,yctr+y1+y2),9
        
    next
    
    sleep 10
        
next

sleep

Heres another sort of Jesus/demon whatever..

Code: Select all

dim as integer xres,yres
screen 19
screeninfo xres,yres
screenres xres,yres

dim as double c1,c2,s1,s2
dim as double x1,x2,y1,y2
dim as double rad=atn(1)/45
dim as double xctr,yctr,radius=150
dim as double deg1,deg2,span

xctr=xres/2
yctr=yres/2

for deg1 = 0 to 360 step 1
    
    c1=cos(deg1*rad)
    s1=sin(deg1*rad)
    
    for deg2 = 0 to 360 step 1
        
        c2 = cos(deg2*rad)
        s2 = sin(deg2*rad)
        
        x1=radius*c1*c1*s1*atn(deg2*rad*s2/s1)
        x2=radius*c2*c2*c2*tan(deg2*rad*c2*c2/s2)
        
        y1=radius*s1*s2*s2*tan(deg2*rad*c2*c2/s2)
        y2=radius*s2*c1*s1*atn(deg2*rad*s2/s1)
        
        pset(xctr+y1+y2,yctr+x1+x2),9
        
    next
    
    sleep 5
    
next

sleep

rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

@Albert

Code: Select all

dim as integer xres,yres
screen 19
screeninfo xres,yres
screenres xres,yres

dim as double c1,c2,s1,s2
dim as double x1,x2,y1,y2
dim as double rad=atn(1)/45
dim as double xctr,yctr,radius=150
dim as double deg1,deg2,span

xctr=xres/2
yctr=yres/2

do
    
    for deg1 = 0 to 360 step 1
   
    c1=cos(deg1*rad)
    s1=sin(deg1*rad)
   
   screenlock
   
   cls
   
    for deg2 = 0 to 360 step 1
       
        c2 = cos(deg2*rad)
        s2 = sin(deg2*rad)
       
        x1=radius*c1*c1*s1*atn(deg2*rad*s2/s1)
        x2=radius*c2*c2*c2*tan(deg2*rad*c2*c2/s2)
       
        y1=radius*s1*s2*s2*tan(deg2*rad*c2*c2/s2)
        y2=radius*s2*c1*s1*atn(deg2*rad*s2/s1)
       
        pset(xctr+y1+y2,yctr+x1+x2),9
       
    next
   
   screenunlock
   
    sleep 5
   
next

loop until len(inkey)



 
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

@All

So I've been looking through the other generators, and they use a lot of n-grams which angros demonstrated here http://www.freebasic.net/forum/viewtopic.php?t=17697.

It's on a word by word basis, but you can do characters too, or grammatical types if you were to apply it to Infinite Monkeys (which I'm going to do).

The n-grams provide a statistical model for measuring recurrence by strengthening a bond between two things, when repeated, essentially "remembering" what has been input.

Any thoughts on that?
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

Hi Rollie~
Many years ago I attempted a similar next in sequence determiner with numbers.
The British newspapers always listed the previous form for a racehorse with the six previous results, e.g.
horse 1 - 203104
horse 2 - 110433

Where 1 was for first 2 for second e.t.c. and 0 for lower than fourth place.
I used only 0,1,2 and 3 (which gave me a number to base 4), and studied the fourth result in a sequence of 4.
for instance, in the above form for the first horse, 2,0,3 gave 1, 0,3,1 gave 0, then 3,1,0 gave 4, and I regarded the 4 as just 0.

I used qb and punched in hundreds of six number form results from the newspapers to try and determine which three results yielded the fourth as a 1 (first).

If I remember correctly 3,4,1 gave the fourth result as first more often than any other sequence, a really good horse with 1,1,1 as the previous three results didn't fare too well with the next number also being a 1.

After I got the magic 3,4,1 sequence I visited the bookmakers (turf accountant) and only betted on a horse with 3,4,1 as it's previous form.

This you could call an emperical method.

With text, maybe you could try a similar thing, say with three characters, to calculate what the fourth is most likely to be.

You would have to load a very large piece of prose, and write an algorithm to determine the most likely fourth character in a sequence of four.
e.g. GOOD HORSE

GOO-D
OOD-_
OD_-H
D_H-O
_HO-R
HOR-S
ORS-E

You'll have (26*26*26) triplets if you ignore all punctuation bar a space with the most likely fourth character for each one, so the numbers are not too huge.
Some of these triplets will not exist in prose, as in three characters the same.
(I must dig out that old horse code and have another compilation, maybe 3,4,1 won't do these days)
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

they use a lot of n-grams
N-Gram? I thought it was an NN, a Neural Network.

What exactly is an N-Gram?



~Kiyote!
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Post by Richard »

If a character or letter is a symbol.
A digraph or digram is an ordered group of two symbols.
A trigraph or trigram is an ordered group of three symbols.
An n-gram is an ordered group of n symbols.

If there are 26 symbols there can be 26*26 possible digrams, 26*26*26 possible trigrams and 26^n possible n-grams.

The statistical frequency of symbols, digrams and trigrams in a language make it possible to generate words that look like that language even if they have no meaning. The statistics of letter groupings can identify different languages and were originally used to break ciphers.
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

There is an algo which uses a letter at the beginning, then scores everything past the first character, as numbers, which compares words which sound alike.

Used, in automatic spell check error correction.

I forget what the routine was called, and due to my external hard drive crashing, I can't casually look it up, need to -re- check wiki-PEE-DIA.

Also, if you want a chatbot, to seem intelligent, give it's error a red-black tree.

If the tree is balanced, the chatbot knows what it's talking about, and should stay on topic, or alternate to a similar topic.

Enough error, and the side of the red-black tree that is unbalanced, should tip and then that's a signal to go to an unrelated topic, one that the AI is more familiar with.

Also, chatbots should have a dedicated time, say 15 mins out of every 60, to talk to itself, asking itself questions, and testing it's RB Tree's and perceptrons for things it actually comprehends, and stuff that it can realize, it will stumble on in the future, and quietly do HTML requests for new data on the stuff that fails the 'conversation self-test' RedBlack tree test.



~Kiyote!

KikiAI is going to use a perceptron NN, and use a RedBlack tree tied into each node, or a RB tree tied to each thing she has a pre-set opinion on, so she can keep track of her failed attempts to keep conversations from running dry.
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Post by Richard »

@ kyotewolf. I think the algorithm you remember might be some version of Soundex.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

@Dodicat

Yeah that's pretty much exactly what it does. Linguistically it's sort of an echolalia, parrot-speak. But with a sufficiently thick source text, it can do some interesting things. I need to rewrite the base type from scratch anyway. I'll post as I go along.

@Kiyotewolf

I'm not quite there yet with an "intelligent" chatbot.

@Richard

Yeah, I'm thinking on how to model a single type that can handle multiple scales of inclusion, say characters, words, sentences, paragraphs etc...
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

rolliebollocks wrote:@Dodicat

Yeah that's pretty much exactly what it does. Linguistically it's sort of an echolalia, parrot-speak. But with a sufficiently thick source text, it can do some interesting things. I need to rewrite the base type from scratch anyway. I'll post as I go along.

@Kiyotewolf

I'm not quite there yet with an "intelligent" chatbot.

@Richard

Yeah, I'm thinking on how to model a single type that can handle multiple scales of inclusion, say characters, words, sentences, paragraphs etc...
Hi Rollie~
Got all the triplets of space and A to Z, with trebles removed into a single sub.
also removed double spaces
that is:
e.g. space,space,space, aaa,bbb, ------ GONE
and
space space a, space space b, ---- GONE
and
a space space, b space space, ---- GONE

Code: Select all


Redim Shared As String * 3 three(27*27*27)


Sub init() 
    'shrink an array of elements not wanted
    #macro arraydelete(a,position)
    Scope
        Dim As Integer index=position 
        If index>=Lbound(a) And index<=Ubound(a) Then
            For x As Integer=index To Ubound(a)-1
                a(x)=a(x+1)
            Next x
            Redim Preserve a(Lbound(a) To Ubound(a)-1)
            Endif 
        End Scope
        #endmacro
        'search and replace
        #macro sar(s0,s1,s2) 
        Scope
            Dim s As String
            Dim As Integer position
            s=s0 & ""
            position=Instr(s,s1)
            While position>0
                s=Mid(s,1,position-1) & s2 & Mid(s,position+Len(s1))
                position=Instr(position+Len(s2),s,s1)
            Wend
            s0=s
        End Scope
        #endmacro
        Dim As Integer count
        For x As Integer=64 To 90
            For y As Integer=64 To 90
                For z As Integer=64 To 90
                    count=count+1
                    three(count)[0]=x
                    three(count)[1]=y
                    three(count)[2]=z
                Next z
            Next y
        Next x
        For x As Integer=1 To Ubound(three)
            SAR(three(x),Chr(64),Chr(32))'replace chr(64) with space
        Next x
        Dim x As Integer
        Do
            x=x+1
            If three(x)[0]=three(x)[1] And three(x)[0]=three(x)[2] Then
                arraydelete(three,x)'delete from array all trebles i.e. yyy
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
       Do
            x=x+1
            If three(x)[0]=32 And three(x)[1]=32 Then
                arraydelete(three,x)'delete from array all first space space
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        Do
            x=x+1
            If three(x)[1]=32 And three(x)[2]=32 Then
                arraydelete(three,x)'delete from array all last space space
                x=x-1
            End If
        Loop Until x>=Ubound(three)
    End Sub
  '___________________________________________________________________  
    dim as double t1,t2
    t1=timer
    init
    t2=timer
    
    Dim As Integer a2=Ubound(three)
    For x As Integer=1 To a2
        Print three(x)& "/";
    Next
    Print
    Print "done, array size = ";a2;" shrunk from ";27*27*27
    print "Time taken for triplets ";t2-t1
    
    
    Sleep
    
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Post by albert »

Hi Guys,

I've been farting around with the concept of a chatterbot since 1997-1998 about 10/11 years...

I'm working on a proprietary language that simple to parse, as english and other languages are difficult to parse because of their letter changes on some words but not others..

you can make your own language by picking words from the dictionary that you would need to describe a plethora of topics and replace the word with a character and sound..

The language books state that the Latin alphabet is not ideo-grams but in fact they are the simplest ideograms...

The language i'm working on...Having trouble designing the characters..
Theres over 600 characters to draw out and i'm tossing it around wether i want ideograms that depict the word or just geometric chars..

http://huh-yuh.freeservers.com/
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

might be some version of Soundex.
I'm going to use the Soundex codes for a bunch of words, and score them on various aspects, scoring words on such things as.

A turn on.
A turn off.
Interesting.
Boring.
Gross.
Fascinating.
Turns me on like a lightbulb.
It's part of my job/work so I know it but don't wanna.

I'm going to stack up a bunch of data, in nested XML tags, and when the conversation needs switching, jump to the next highest peak of XML data, all on the same subject, and only dig deeper in the stack when the user interacts and doesn't say 'ERROR' things like

"Umm"

and

"What"

and

"That's wrong"

it's like a stick with 4 bells on it. A red black tree, and the AI (or CI - computer intelligence), it will keep track of success and failure, but if there is an unbalanced amount of success or failure, then something is wrong.

The program has to be able to give answers and conversation that is relevant, and seems to be worded like the user expects it to be said, and if there are signs that the user is bugged or distracted by what the chatbot says, then that's a sign to add an 'ERROR' and choose the black side of the RB tree.

If the program continues good conversation, put up a red branch on the tree.

Once the RB tree fills up with 4 branches, two red and two black, then it's an evenly matched conversation, the chatbot has been corrected by the user twice, but the chatbot has successfully defended itself verbally twice, also.

If the Chatbot is too smart, or too inept at the conversation, there will be a spike in Red or in Black, and the tree will tip, setting it off balance.

The chatbot should drop all conversation in this pyramid of XML tags of what the conversation is centered around, and do it's own research, formulating HTML requests to Google, or some other database, or simply go into tutoring mode, and request a 'Nanny Mode' input, so the user can teach the program a better way of reacting, and speaking.



~Kiyote!

I'm derailing the convo from stars & energy & matter.
Dunno how I managed to do that.

[edit]

To resolve and sort XML quickly, I was going to use a visual sort, and play "Towers Of Hanoi" with the XML tags, and any nested tags which fail the simple rules of T.O.H. will very clearly be visually obvious.

Should be, somehow easy to implement, I guess.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

@Dodicat

That's way more than I need for what I'm trying to accomplish. The n-grams actually take in input from a pre-existing source text and then create a bond between words which come in sequence. The more times the words are present in the sequence, the more times that bond is strengthened. Thus you can create a probabilistic table, which upon taking a randomly generated input, will select from a list in which it is weighted toward the strongest bonds.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

rolliebollocks wrote:@Dodicat

That's way more than I need for what I'm trying to accomplish. The n-grams actually take in input from a pre-existing source text and then create a bond between words which come in sequence. The more times the words are present in the sequence, the more times that bond is strengthened. Thus you can create a probabilistic table, which upon taking a randomly generated input, will select from a list in which it is weighted toward the strongest bonds.
Fair enough Rollie~, but Ive followed on regardless for now.
I've reduced the number of triplets by getting rid of un-needed doubles, zz, xx e.t.c.
Also, since my data base (text) is small, I havn't used the most frequent fourth character after the triplet, but a random one from the group.

The main triplet array is the string THREE
The fourth following character is held in the array TALLY.
Here's a trial run from a small text data:

Code: Select all


Redim Shared As String * 3 three(27*27*27)
Redim Shared As String  tally()
Dim Shared As String text
text="A SHORT PIECE OF TEXT FOR THIS EXAMPLE "
text="BUT SEVERAL BLUE CATS SAT ON THE MANY YELLOW MATS "
text=text+"THE QUICK BROWN FOX JUMPED OVER THE LAZY FAT DOG "
text=text+"A FAIR BREEZE BLEW SOME WHITE FOAM FLEW AND FURROW FOLLOWED FREE "
text=text+"IDLE HANDS DO THE DEVILS WORK "
text=text+"GREAT MINDS THINK ALIKE "
text=text+"THEN FOOLS SELDOM DIFFER "
text=text+"THAT IS ALL FOR NOW "
Sub init() 
    'shrink an array of elements not wanted
    #macro arraydelete(a,position)
    Scope
        Dim As Integer index=position 
        If index>=Lbound(a) And index<=Ubound(a) Then
            For x As Integer=index To Ubound(a)-1
                a(x)=a(x+1)
            Next x
            Redim Preserve a(Lbound(a) To Ubound(a)-1)
            Endif 
        End Scope
        #endmacro
        'search and replace
        #macro sar(s0,s1,s2) 
        Scope
            Dim s As String
            Dim As Integer position
            s=s0 & ""
            position=Instr(s,s1)
            While position>0
                s=Mid(s,1,position-1) & s2 & Mid(s,position+Len(s1))
                position=Instr(position+Len(s2),s,s1)
            Wend
            s0=s
        End Scope
        #endmacro
        Dim As Integer count
        For x As Integer=64 To 90
            For y As Integer=64 To 90
                For z As Integer=64 To 90
                    count=count+1
                    three(count)[0]=x
                    three(count)[1]=y
                    three(count)[2]=z
                Next z
            Next y
        Next x
        For x As Integer=1 To Ubound(three)
            SAR(three(x),Chr(64),Chr(32))'replace chr(64) with space
        Next x
        Dim x As Integer
        Do
            x=x+1
            If three(x)[0]=three(x)[1] And three(x)[0]=three(x)[2] Then
                arraydelete(three,x)'delete from array all trebles i.e. yyy
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        #macro deletepairs(n)
        Do
            x=x+1
            If three(x)[0]=n And three(x)[1]=n Then
                arraydelete(three,x)'delete from array all first pair
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        Do
            x=x+1
            If three(x)[1]=n And three(x)[2]=n Then
                arraydelete(three,x)'delete from array all last pair
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        '____________________________________________
        Do
            x=x+1
            If three(x)[0]=Asc("Q") And three(x)[1]<>Asc("U") Then
                arraydelete(three,x)'delete from array all first pair
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        Do
            x=x+1
            If three(x)[1]=Asc("Q") And three(x)[2]<>Asc("U") Then
                arraydelete(three,x)'delete from array all last pair
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        '_______________________________________________
        
        #endmacro
        deletepairs(Asc(" "))
        deletepairs(Asc("Z"))
        deletepairs(Asc("Y"))
        deletepairs(Asc("X"))
        deletepairs(Asc("W"))
        deletepairs(Asc("V"))
        deletepairs(Asc("Q"))
        deletepairs(Asc("H"))
        deletepairs(Asc("I"))
        deletepairs(Asc("J"))
        Redim tally(Ubound(three))
        
    End Sub
    
    Sub findtally(txt As String)
        
        Dim As Integer z
        Do
            z=z+1
            For y As Integer=1 To Ubound(three)
                If Mid(txt,z,3)=three(y) Then
                    If Instr(tally(y),Right(Mid(txt,z,4),1))=0 Then
                        tally(y)=tally(y)+Right(Mid(txt,z,4),1)
                    End If
                End If
            Next y
        Loop Until z>=Len(txt)'-1
        'for z as integer=1 to ubound(tally)
        'if tally(z)="" then tally(z)="AEIOU"
        'next z
    End Sub
    Sub newtext(txt As String,n As Integer)
        If Instr(text,txt)=0 Then
            Print "STARTER MUST BE IN TEXT"
            Exit Sub
        End If
        #define r(f,l) Rnd * (l - f) + f       
        Randomize
        Dim As String * 1 char
        Dim As Integer i
        For z As Integer=1 To n
            
            For y As Integer=1 To Ubound(three)
                If Right(txt,3)=three(y) Then
                    
                    i=(r(0,(Len(tally(y))-1)))
                    char[0]=tally(y)[i]
                    Exit For
                End If
            Next y
            txt=txt+char
        Next z
    End Sub
    
    '___________________________________________________________________  
    Dim As Double t1,t2
    t1=Timer
    init
    t2=Timer
    
    Dim As Integer a2=Ubound(three)
    Print
    Print "Triplets made, size = ";a2;" shrunk from ";27*27*27
    Print "Time taken for triplets ";t2-t1
    Print "Press a key"
    Sleep
    
    
    t1=Timer
    findtally(text)
    t2=Timer
    Print "TALLY DONE, Time ";t2-t1
    Print "Press a key"
    Sleep
    
    Print
    #define r(f,l) Rnd * (l - f) + f 
    Dim As String temp
    For z As Integer=1 To 10
        'get a starting 3 characters within the text
        Do
            temp=Mid(text,Int(r(1,Len(text)-3)),3)
        Loop Until Instr(temp," ")=0 And Len(temp)=3
        Print "Start triplet = ";temp
        Dim As String s=temp
        newtext(s,Len(text))
        s=Ltrim(s,temp)
        Print s
        Print
    Next z
    Print "done"
    Sleep
    
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

might be some version of Soundex.
Also, I failed to mention before, I'm going to use scores of words that sound like others in k1k1's lexicon, to try to guess as to their meaning, and how they influence her.

There is a finite amount of time I can spend teaching k1k1 words, meanings, associations and the like, so she is going to have to incorporate unknown words, based on 'this sounds like that, but i don't like this new word for some reason, or maybe i do.'

You know, those 100-in-1 kits from Radio Shack, I'm thinking of making a robotic milky white shell, a female one, just like that robot movie with Sonny, and Viki, and make her into a wearable marionette.

Besides that, I'm going to have to augment her with servos and other things like muscle wire, solenoids and stuff, magnetics and things, but I want there to be a built in set of stereo microphones, and dual webcams in her cranium from the get go, as well as touch sensors in her hands, on her shoulders, and capacitive sensors along her entire head neck and face.

I'm going to make a whole star cluster of mercury switches, and use gyroscopes to show the starting position in XYZ orientation, and just take the trigger data as a timing diagram stream, and try to map out muscle contractions, instead of the angles of joints like other systems of mapping human movement.

Might seem archaic, but I love mercury switches.

::::



~Kiyote!

What does taking the triplets out of the text stream do in that program above my post?
Locked