Squares

General FreeBASIC programming questions.
angros47
Posts: 1626
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 21, 2020 15:58

Last XKCD comic seems appropriate for albert: Image
albert
Posts: 5671
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 31, 2020 0:37

@Richard

I tried googling "How do cell phones work?" , and all the links i clicked , didn't describe the way cell phones use a particular frequency..

If you have 1,000 cell phones all operating at the same time.. How does an antenna packet all the IP packets from each phone??
How does it time slice the frequency???

To make the FB "Autonomous Vehicle" program , i got to figure out how the vehicles communicate with each other..

Making a town , with houses and buildings , and streets is pretty easy.. just need to figure how the vehicles communicate to each other..
For the program you could use google streets or "google maps" , to select a town to auto-drive through.

And i've thought up another problem..
How do you handle street lights , and stops signs , and oneway streets , and street closures , and lane closures..
Street lights , and stops signs , could output a signal to stop...
Maintenance and construction , could output a signal to drive around or detour..

So i make a city like "Sim-City" with houses and buildings and each house has 1 car , and it goes to a randomly selected building to park for a certain time length..Then goes on to another destination ( home )
So it would look like a real city , with traffic going and coming...

Need help figuring the way the GPS frequency would work.....

For the GPS frequency , the car needs to parse all the GPS coordinates , and pick out the ones that are in the immediate vicinity of the car..
So i got to put all the GPS coords on a single frequency , and then parse that freq to find all the cars in the immediate vicinity... ( to avoid a collision )
Richard
Posts: 3011
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » May 31, 2020 2:03

@Albert.
Cell phones do not use a frequency, they use a whole band by employing spread spectrum techniques and quadrature modulation. That is so far beyond your understanding that it must seem to be magic. Cell phone DSP is not relevant to this website until you write an FB program to simulate a QAM modem.

Your Autonomous Vehicle ideas are also well outside FB. You need to stop dreaming of the past and study the subject by reading a few thousand current technical journal articles. Or get a job driving taxis and think about the problems of avoiding collisions.

Until you have written an FB program to design cities, the subject of Town Planning is not relevant to FB. If you are interested in town planning you should read the journals. You will need a degree in social and economic geography before you will get anywhere.

Your ideas about using GPS to avoid collisions are quite primitive and irrelevant to current practice. Until you can write an FB program to simulate such a system it is not relevant to FB.

It appears that the FB moderators have got tough. Write and post FB code that works, and is of interest to others. If you want to play a part on this website you will have to restrict your posts to FB programming.
albert
Posts: 5671
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 31, 2020 2:45

@Richard

Sorry....
I'll keep my posts to FB coding questions and bugs..
albert
Posts: 5671
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 31, 2020 3:04

I don't know why people are complaining , about me posting to this topic...

I'm the only one who posts code here...

Dodicat sometimes posts a doodle.. and some others infrequently post their code to the "Squares" topic..
Richard , just about always belittles my posts..

But if you look at all the people that post to "Squares" 80% is all my posts..

Maybe i should start a "me only" topic , to post my trig-doodles and code snippets.. and crazy ideas...

Sorry for all the failed "Data Compression" posts... But they all compressed data..
Some had coding errors , and the rest had obstacles that made decompression impossible..
( Mostly they created duplicates... Or you had to make a choice of values. )
angros47
Posts: 1626
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 31, 2020 12:57

albert wrote:Maybe i should start a "me only" topic , to post my trig-doodles and code snippets.. and crazy ideas...


Or maybe you should open your own blog, and use it for your ideas, instead of using this forum. So you would be allowed to pick every subject you want, even if it's unrelated with FreeBasic

albert wrote:Sorry for all the failed "Data Compression" posts... But they all compressed data..
Some had coding errors , and the rest had obstacles that made decompression impossible..


No, Albert. None of them compressed data. Not even one.
"Compression" happens if, and only if, you can restore original data. If you can't, it's not compression. Otherwise, if all you care about is to reduce data size, and you don't care to restore original data, the ultimate compression tool is the trashcan: it reduces every data set to a size of 0.
Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

Re: Squares

Postby Tourist Trap » May 31, 2020 14:07

angros47 wrote:No, Albert. None of them compressed data. Not even one.
"Compression" happens if, and only if, you can restore original data. If you can't, it's not compression. Otherwise, if all you care about is to reduce data size, and you don't care to restore original data, the ultimate compression tool is the trashcan: it reduces every data set to a size of 0.

Hi angros47,

it's a little too radical :) You can have lossy compression that consists in being able to save a given amount of the original message that is still readable even if you trashed away a part of it. This occures in image compression for instance, where an image can obviously keep readable even if you trash away a fair amount of pixels. I would state my opinion this other way: if you manage to grab and preserve the seeds of a message, you will be able to reconstruct it without any true loss.

This said, I don't know what was the initial goal here on this affair, so I can not say if at this moment we must conclude it is failure or a success. Simply if it's about reducing the data to its most meaningful part, that would sound interesting to my ears.
angros47
Posts: 1626
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 31, 2020 14:28

You are talking about lossy compression. To do that, the algorithm is supposed to be able to find "essential" parts of a dataset, and to discard non essential ones. This is surely possible, but it works only for specific datasets (for images, or for audio clips, for example).

Albert stated several times that he wanted to compress random data, and this would mean a general algorithm. If you have random data you can't tell for sure which parts are essential and which one are not (for all you know, perhaps you are dealing with steganography encryption, and so the most important informations are disguised as noise)

If you know in advance that the data set you are compressing is just a set of random values (a white noise, for example), compressing it is easy: you store only the length of the dataset, and nothing else. When it's time to reconstruct it, you just use the random number generator to create a new sequence of random data (if you give me an audio clip that is just white noise, and I create a new one of the same length, using other randomly generated numbers, I dare you to find a difference by listening them)
Tourist Trap
Posts: 2880
Joined: Jun 02, 2015 16:24

Re: Squares

Postby Tourist Trap » May 31, 2020 15:19

angros47 wrote:If you know in advance that the data set you are compressing is just a set of random values (a white noise, for example), compressing it is easy: you store only the length of the dataset, and nothing else. When it's time to reconstruct it, you just use the random number generator to create a new sequence of random data (if you give me an audio clip that is just white noise, and I create a new one of the same length, using other randomly generated numbers, I dare you to find a difference by listening them)

Yes you are right. This point is very relevant to my eyes because in term of pattern matching your example of a blank noise is good. Indeed, if you play a blank noise as a real sound - I don't know if you tried, I did - it's very interesting, it will sound like the sound of the rain, which despite of being quite random by definition, is still very homogeneous and easy to reproduce based on a very few set of parameters (far less information anyway than the number of bits involved in the perceived sound for sure).

Then it's true that about the more convenient general description of a dataset, might it be random, and that would in general cost less in term of size, I can now only think of its statistical description (length, average value, and this kind of stuff). It's sufficient, unless we can be more specific on the type of the data we have to deal with (music, speach, image, or whatever). For my part, if I don't know what is the data made for, it's probably where from I would start if I had to provide a relevant description of it in a shorter form.
dodicat
Posts: 6478
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jun 01, 2020 11:24

Hi Albert.
Sorry for not visiting squares often these days, it is my favourite thread.
I have redone my triplets, and added speak.
code 1
triplets.bas
This creates the triplets and tally files and will run the files.

Code: Select all


#include "crt.bi"
#include "file.bi"
Dim Shared As String text

text="TT.txt" '<--------- LOAD YOUR FILE HERE

if fileexists(text)=0 then print text;" not found":sleep:end
Redim Shared As String  three(29*29*29) 'comma,dot,space,A to Z  string * 3
Redim Shared As String  tally()
dim as long f=freefile
Dim strline As String
dim s as string
Open text For Input As #f
While Not Eof(f)
    Line Input #f,strLine
    strline=strline+chr(10)
    s=s+strline
Wend
Close #f
text=s
print "file loaded"
Sub TakeOut(Text As String,Char As String)
    Var index = 0,asci=Asc(char)
    For i As long = 0 To Len(Text) - 1
        If Text[i] <> ASCi Then Text[index] = Text[i] : index =index+ 1
    Next : Text = Left(Text,index)
End Sub

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function



function Qsar(s0 As String,s1 As String,s2 As String) byref as const string
    for n as long=0 to len(s0)-1
        if s0[n]=asc(s1) then s0[n]=asc(s2)
    next
    return s0
    end function

Function tallynum Overload(somestring As String,partstring As String) As Integer
  Dim As Integer i,j,ln,lnp,count,num
  ln=Len(somestring):If ln=0 Then Return 0
  lnp=Len(partstring):If lnp=0 Then Return 0
  count=0
  i=-1
  Do
    i+=1
    If somestring[i] <> partstring[0] Then Continue Do
    If somestring[i] = partstring[0] Then
      For j=0 To lnp-1
        If somestring[j+i]<>partstring[j] Then Continue Do
      Next j
    End If
    count+=1
    i=i+lnp-1
  Loop Until i>=ln-1
  Return count
End Function

Function SAR(original As String ,find As String ,replace As String) As String
  If Len(find) = 0 Then Return original
  Var t=tallynum(original,find) 'find occurencies of find
  If t=0 Then Return original
  Dim As Long found,n,staid,m
  Var Lf = Len(find),Lr = Len(replace),Lo = Len(original)
  t = Len(original) - t * Lf + t * Lr             'length of output string
  Dim As String res = String(t,0)                 'output string
  Do
    If original[n] = find[0] Then               'got a possible
      For m = 0 To Lf - 1
        If original[n + m] <> find[m] Then Goto lbl 'no
      Next m
      found = 1                               'Bingo
    End If
    If found Then
      For m = 0 To Lr - 1
        res[staid] = replace[m]             'insert the replacerment
        staid += 1
      Next m
      n += Lf
      found = 0
      Continue Do
    End If
    lbl:
    res[staid] = original[n]
    staid += 1
    n += 1
  Loop Until n >= Lo
  Return res
End Function

Function removechar(Byval txt As String,Char As String,start As Long=0,Byref dups As String="") As String
    Var id = start
    For i As Long = start To Len(txt) - 1
        If txt[i]<>Asc(char) Then txt[id]=txt[i]:id+=1 Else dups=Chr(txt[i])
    Next
    Return Left(txt,id)
End Function

Sub runscript(filename As String)
  Shell "cscript.exe /Nologo "+ filename
End Sub

Sub savefile(filename As String,p As String)
  Dim As Integer n
  n=Freefile
  If Open (filename For Binary Access Write As #n)=0 Then
    Put #n,,p
    Close
  Else
    Print "Unable to save " + filename
  End If
End Sub

Sub speak(text As String,voice As Long,rate As Long,volume As Long)
  'print text 'optional
  Dim As String g 'fixed
  g="set sapi=CreateObject(""SAPI.SpVoice"")"+Chr(13,10)
  g+="Set sapi.Voice = sapi.GetVoices.Item(0)"+Chr(13,10)
  g+="sapi.Rate = 2"+Chr(13,10)
  g+="sapi.volume = "+str(volume)+Chr(13,10)
  g+="sapi.Speak ""Hello world"""
 
  Dim As String w=g 'working string
  w=sar(w,"Item(0)","Item("+Str(voice)+")")
  w=sar(w,"Rate = 2","Rate = "+Str(rate))
  w=sar(w,"Hello world",text)
  savefile("voice.vbs",w)
  runscript ("voice.vbs")
  Kill "voice.vbs"
End Sub
speak("hello",1,1,50)

sub speak2(text as string) 'spare
      dim as string x="mshta vbscript:Execute(""CreateObject(""""SAPI.SpVoice"""").Speak("""""+text+""""")(window.close)"")"
      'print txt
      shell x
  end sub

Function SARold(s0 As String,s1 As String,s2 As String) byref As const String
    static s As String
    static As long 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
    return s
End Function


''=========
text=Ucase(text)
text=qsar(text,Chr(10)," ")
text=qsar(text,Chr(13)," ")
print "Phase 1"
'Characters sieved out and replaced with a space
Dim As String temp="0123456789{[}]:;@~#|\<>?/_-+=)(*&^%$£""!"""
For z As long=1 To Len(temp)
    If Instr(text, Mid(temp,z,1)) Then
        text=qsar(text,Mid(temp,z,1)," ")
    End If
Next z
print "Phase 2"
For z As long=1 To 2 'just to make sure of this
    text=sar(text,",",", ")
    text=sar(text," ,",", ")
    text=sar(text,".",". ")
    text=sar(text," .",". ")
Next z
print "Phase 3"
Dim As long z
'No double spaces, tak'em out, just leave a single space.
redim as string tmp()
stringsplit(text," ",tmp())
text=""
for n as long=lbound(tmp) to ubound(tmp)
    text+=tmp(n)+" "
next
erase tmp


z=0
print "phase 4"
'Final clean up
Do
    z=z+1
    If Instr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ.,",Mid(text,z,1))=0 Then
        TakeOut(text,Mid(text,z,1))
        z=z-1
    End If
Loop Until z>=Len(text)

text=Ucase(text)
text=rtrim(text," ")
text=text+"END"

Print "ORIGINAL prepared"
Print text
Print
'INIT
Sub init()
    'shrink an array of elements not wanted
   
    #macro arraydelete(a,position)
    Scope
        Dim As long index=position
        If index>=Lbound(a) And index<=Ubound(a) Then
            For x As long=index To Ubound(a)-1
                a(x)=a(x+1)
            Next x
            Redim Preserve a(Lbound(a) To Ubound(a)-1)
            End if
        End Scope
        #endmacro
       
        Dim As long count
        For x As long=62 To 90
            For y As long=62 To 90
                For z As long=62 To 90
                    count=count+1
                    three(count)=chr(x,y,z)
                Next z
            Next y
        Next x
        For x As long=1 To Ubound(three)
            three(x)= qSAR(three(x),Chr(64),Chr(32))'replace chr(64) with space
            three(x)= qSAR(three(x),Chr(63),Chr(46))'           (63)      stop
            three(x)= qSAR(three(x),Chr(62),Chr(44))'            (62)      comma
        Next x
       
        Dim x As long
        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
        '_____________________ n1 with only n2, e.g. Q with U only
        #macro onlythese(n1,n2)
       
        Do
            x=x+1
            If three(x)[0]=n1 And three(x)[1]<>n2 Then 'first pair
                arraydelete(three,x)
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        Do
            x=x+1
            If three(x)[1]=n1 And three(x)[2]<>n2 Then 'second pair
                arraydelete(three,x)
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        #endmacro
       
       
        '_________________________________________
        #macro Ques(comment)
        Do
            x=x+1
            If three(x)[0]=Asc("Q") And three(x)[1]=Asc("U") Then
                If Instr("AEIOU",Chr(three(x)[2]))=0 Then
                    'if chr(three(x)[2])="B" then
                    arraydelete(three,x)'delete from array
                    x=x-1
                End If
            End If
        Loop Until x>=Ubound(three)
        x=0
       
        #endmacro
        #macro deletecombo(n1,n2)
        Do
            x=x+1
            If three(x)[0]=n1 And three(x)[1]=n2 Then
                arraydelete(three,x)'delete from array
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        Do
            x=x+1
            If three(x)[1]=n1 And three(x)[2]=n2 Then
                arraydelete(three,x)'delete from array
                x=x-1
            End If
        Loop Until x>=Ubound(three)
        x=0
        #endmacro
        '_______________________________________________
        #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
        #endmacro
        '________________________________________
        onlythese(Asc("."),Asc(" "))
        onlythese(Asc(","),Asc(" "))
        onlythese(Asc("Q"),Asc("U"))
        deletecombo(Asc(" "),Asc("."))
        deletecombo(Asc(" "),Asc(","))
        Ques(QU_with_a_vowel_only)
       
        deletepairs(Asc(" "))
        'deletepairs(Asc("U"))
        deletepairs(Asc("Y"))
        deletepairs(Asc("X"))
        deletepairs(Asc("W"))
        deletepairs(Asc("V"))
        deletepairs(Asc("Q"))
        deletepairs(Asc("H"))
        deletepairs(Asc("I"))
        deletepairs(Asc("J"))
       
       
    End Sub   
    Sub findtally(txt As String)
       
        Dim As long z
        Do
            z=z+1
            For y As long=1 To Ubound(three)
                    if txt[z-1]=three(y)[0] then
                         if txt[z]=three(y)[1] then
                              if txt[z+1]=three(y)[2] then
               if len(tally(y))<1025 then     tally(y)=tally(y)+chr(txt[z+2])'Right(Mid(txt,z,4),1)
                end if
                end if
                end if
            Next y
           
        Loop Until z>=Len(txt)-3
       
    End Sub
    Sub newtext(txt As String,n As long)
        If Len(txt)= 0 Then Exit Sub
        If Instr(text,txt)=0 Then
            Print "STARTER MUST BE IN TEXT"
            Exit Sub
        End If
        dim as long c
        #define r(f,l) int(Rnd*((l+1)-(f))+(f))
        #macro scramble(s)
        Scope
            var L=Len(s)
            var i=0
            var j=0
            For z As long=1 To 10
                i=r(0,(L-1))
                j=r(0,(L-1))
                Swap s[i],s[j]
            Next z
        End Scope
        #endmacro
        Dim count As long
        Randomize
        Dim As String * 1 char,lastchar
        Dim As String temp,acc
        Dim As long i,flag,z,runflag,charactercount'new
       
        Do
            z=z+1
            char="":temp=""
            For y As long=1 To Ubound(three)
                If Right(txt,3)=three(y) Then
                    'scramble(tally(y))'optional
                    i=(r(0,(Len(tally(y))-1)))
                    char[0]=tally(y)[i]
                    temp=char
                    charactercount=charactercount+1 'new
                    Exit For
                End If
            Next y
            txt=txt+char & ""'re-introduce
            'out of steam exit
            If Instr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ.,",char)=0 Then
                If Instr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ.,",lastchar)=0 Then
                    print " -->(OUT of TRIPLES)"
                    goto lbl
                    'Exit Sub
                End If
            End If
       
            'sort out new paragraphs, and capitals after full stop
            If char[0]=46 Then flag=1
            lastchar=char
            If flag=0 Then  temp=Lcase(temp)
            If flag=1 And char[0]<>32 And char[0]<>46 Then
                count=count+1
                temp=Ucase(temp) 'capital
                'charactercount=0
                flag=0
            End If
            'end a line on a word-new
            if charactercount>60 and temp=chr(32) then
                temp=temp+chr(10)
                charactercount=0
                end if
           
            'random number of sentences before a new paragraph.
            If count>=r(3,5) And char[0]=32 And flag=1 Then
                temp=temp+Chr(10)+"     ":count=0
                charactercount=0
            End If
            'capital to start, waste of time really
            If runflag=0 Then temp=Ucase(temp):runflag=1
            Print temp;
        acc+=temp
       
            'end on a word finishing
            if z>=n And temp=Chr(32) then exit do
            'get out now (for should be out before this)
        Loop Until z>=n + 20
        Print " --> FULL RUN"
        lbl:color 5
        print "Would you like speech y/n"
        color 15
        var sp=input(1)
        acc=SAR(acc,chr(10)," ")
        if sp="y" then speak(acc,0,0,50)
       
    End Sub
   
    '___________________________________________________________________ 
    Dim As Double t1,t2
    Print "MAKING TRIPLETS"
    t1=Timer
    init
   
    '#include "triplets.txt"
    Redim tally(Ubound(three))
    t2=Timer
   
    Dim As long a2=Ubound(three)
   
    Print "Triplets made, size = ";a2;" shrunk from ";29*29*29
    Print "Time taken for triplets ";t2-t1
   
   
   
    Print
    Print "MAKING TALLY STRINGS -Please wait"
    t1=Timer
    findtally(text)
   
    t2=Timer
   
    Print "TALLY DONE, Time ";t2-t1
   
    #macro option_file()
    open "tally.txt" for output as #5
    for x as long=1 to ubound(tally)
      if tally(x) <> "" then  print #5,"tally(";x;") = ";"""";tally(x);""""
        next x
        close #5
        #endmacro
   
    #macro option_triplets()
    open "triplets.txt" for output as #6
    for x as long=1 to ubound(three)
        print #6,"three(";x;") = ";"""";three(x);""""
        next x
        close #6
    #endmacro
    '_______________________________________________________________
    option_file() 
    option_triplets()
    '________________________________________________________________
   
    Print
   
    #define r(f,l) int(Rnd*((l+1)-(f))+(f))
     dim as long flag =0,_length
    text="HELLO THERE FATCATS OR THINONES."
   
    print "Try a few runs to test"
    Do
       input "How many words (approx) would you like to write? ";_length
     _length=_length*5
        Do
            randomize
            'get a starting 3 characters within the text
             
            temp=Mid(text,Int(r(1,Len(text)-3)),3)
           
            for z as long=1 to ubound(three)
                if temp=three(z) then
                    if tally(z)="" then
                        flag=0
                    else
                        flag=1
                    end if
                end if
                next z
        Loop Until Instr(temp," ")=0 And Len(temp)=3 and flag=1
        Print "Start triplet = ";temp
        Dim As String s=temp
        newtext(s,_length)
        Print
        Print "Press a key or esc to quit"
        Sleep
        Print
    Loop Until Inkey=Chr(27)
    Print "done, tally.txt and triplets.txt have been written"
    Sleep
     


run.bas
This only runs the triplet and tally files.
Note extremely slow #include file load with gen gcc, I call this a gcc bug.

Code: Select all


  Redim Shared As String  three(29*29*29) 'comma,dot,space,A to Z  string * 3
  redim shared as string tally(ubound(three))
 
 Sub runscript(filename As String)
  Shell "cscript.exe /Nologo "+ filename
End Sub

Sub savefile(filename As String,p As String)
  Dim As Integer n
  n=Freefile
  If Open (filename For Binary Access Write As #n)=0 Then
    Put #n,,p
    Close
  Else
    Print "Unable to save " + filename
  End If
End Sub

Function SAR(s0 As String,s1 As String,s2 As String) As String 'SearchAndReplace
  Dim s As String=s0
  Var 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
  SAR=s
End Function

Sub speak(text As String,voice As Long,rate As Long,volume As Long)
  'print text 'optional
  Dim As String g 'fixed
  g="set sapi=CreateObject(""SAPI.SpVoice"")"+Chr(13,10)
  g+="Set sapi.Voice = sapi.GetVoices.Item(0)"+Chr(13,10)
  g+="sapi.Rate = 2"+Chr(13,10)
  g+="sapi.volume = "+str(volume)+Chr(13,10)
  g+="sapi.Speak ""Hello world"""
 
  Dim As String w=g 'working string
  w=sar(w,"Item(0)","Item("+Str(voice)+")")
  w=sar(w,"Rate = 2","Rate = "+Str(rate))
  w=sar(w,"Hello world",text)
  savefile("voice.vbs",w)
  runscript ("voice.vbs")
  Kill "voice.vbs"
End Sub
speak("hello",1,1,50)
 Sub newtext(txt As String,n As long=10)
     
        dim as long c
       
        #define r(f,l) int(Rnd*((l+1)-(f))+(f))
        #macro scramble(s)
        Scope
            var L=Len(s)
            var i=0
            var j=0
            For z As long=1 To 10
                i=r(0,(L-1))
                j=r(0,(L-1))
                Swap s[i],s[j]
            Next z
        End Scope
        #endmacro
        Dim count As long
        Randomize
        Dim As String * 1 char,lastchar
        Dim As String temp,acc
        Dim As long i,flag,z,runflag,charactercount'new
       
        Do
            z=z+1
            char="":temp=""
            For y As long=1 To Ubound(three)
                If Right(txt,3)=three(y) Then
                    'scramble(tally(y))'optional
                    i=(r(0,(Len(tally(y))-1)))
                   if len(tally(y)) then char[0]=tally(y)[i]
                    temp=char
                    charactercount=charactercount+1 'new
                    Exit For
                End If
            Next y
            txt=txt+char & ""'re-introduce
            'out of steam exit
            If Instr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ.,",char)=0 Then
                If Instr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ.,",lastchar)=0 Then
                    print " -->(OUT of TRIPLES)"
                    goto lbl
                   ' Exit Sub
                End If
            End If
       
            'sort out new paragraphs, and capitals after full stop
            If char[0]=46 Then flag=1
            lastchar=char
            If flag=0 Then  temp=Lcase(temp)
            If flag=1 And char[0]<>32 And char[0]<>46 Then
                count=count+1
                temp=Ucase(temp) 'capital
                flag=0
            End If
            'end a line on a word-new
            if charactercount>60 and temp=chr(32) then
                temp=temp+chr(10)
                charactercount=0
                end if
           
            'random number of sentences before a new paragraph.
            If count>=r(3,5) And char[0]=32 And flag=1 Then
                temp=temp+Chr(10)+"     ":count=0
                charactercount=0
            End If
            'capital to start, waste of time really
            If runflag=0 Then temp=Ucase(temp):runflag=1
            Print temp;
            acc+=temp
            'end on a word finishing
            if z>=n And temp=Chr(32) then exit do
            'get out now (for should be out before this)
        Loop Until z>=n + 20
        Print " --> FULL RUN"
        lbl:
        color 5
        print "Would you like speech y/n"
        color 15
        var sp=input(1)
        'print "TEMP  ";acc
        acc=SAR(acc,chr(10)," ")
        if sp="y" then speak(acc,0,0,50)

    End Sub
   
     #include "triplets.txt"
    #include "tally.txt"
   
   
     #define r(f,l) int(Rnd*((l+1)-(f))+(f))
 
     dim as long flag =0,_length
     dim as string   text="HELLO THERE FATCATS OR THINONES."
     dim as string temp
    print "Try a few runs to test"
    Do
       input "How many words (approx) would you like to write? ";_length
     _length=_length*5
        Do
            randomize
            'get a starting 3 characters within the text
             
           temp=Mid(text,Int(r(1,Len(text)-3)),3)
           
            for z as long=1 to ubound(three)
                if temp=three(z) then
                    if tally(z)="" then
                        flag=0
                    else
                        flag=1
                    end if
                end if
                next z
        Loop Until Instr(temp," ")=0 And Len(temp)=3 and flag=1
        Print "Start triplet = ";temp
        Dim As String s=temp
        newtext(s,_length)
        Print
        Print "Press a key or esc to quit"
        Sleep
        Print
    Loop Until Inkey=Chr(27)
    Print "done"
    Sleep
     

And a little text file, all words by tourist trap, so it should give a flavour of tourist traps thinking.
TT.text

Code: Select all

 

Yes you are right. This point is very relevant to my eyes because in term of pattern matching your example of a blank noise is good. Indeed, if you play a blank noise as a real sound - I don't know if you tried, I did - it's very interesting, it will sound like the sound of the rain, which despite of being quite random by definition, is still very homogeneous and easy to reproduce based on a very few set of parameters (far less information anyway than the number of bits involved in the perceived sound for sure).

Then it's true that about the more convenient general description of a dataset, might it be random, and that would in general cost less in term of size, I can now only think of its statistical description (length, average value, and this kind of stuff). It's sufficient, unless we can be more specific on the type of the data we have to deal with (music, speach, image, or whatever). For my part, if I don't know what is the data made for, it's probably where from I would start if I had to provide a relevant description of it in a shorter form.
Hi angros47,

it's a little too radical :) You can have lossy compression that consists in being able to save a given amount of the original message that is still readable even if you trashed away a part of it. This occures in image compression for instance, where an image can obviously keep readable even if you trash away a fair amount of pixels. I would state my opinion this other way: if you manage to grab and preserve the seeds of a message, you will be able to reconstruct it without any true loss.
I know that we can use OpenCV, the library for image analysis, in FB. And I was about to try the lib for a need for a professional matter. I want to try to get the skeleton (main axis) of a closed shape from some given pic. I've plenty of documentation in C++ so for the task I could just do some copy/paste, but I won't be able to do much customization in C++, so I still find it better in FB.

Anyway, I still need to get started. I already downloaded the lib, what to do next? Any short example to illustrate?

Thanks by advance for sharing ;)

This said, I don't know what was the initial goal here on this affair, so I can not say if at this moment we must conclude it is failure or a success. Simply if it's about reducing the data to its most meaningful part, that would sound interesting to my ears.
Hi dodi,

thanks for testing. About vb.net it's what comes shipped with Visual Studio (you can grab the 'community edition' as they call it for free and without any registration for 1 month, then would have to register in order to keep using it) . This is Microsoft stuff so the advantage is that it is well fitted for Windows.

That's not quite like VB6 (it's much more complicated), but for one aspect the windows forms are avaiable and easy to draw as usual. That's why I use it myself, since textboxes, directory browsers and so on are quickly added. So that may simply save time when you don't have much .

VB.net is compiled to the common langage runtime (clr), which is common to C# and other languages shipped with Visual Studio, that has the advantage of making the .net languages compatible each others, you can melt modules from different ones of them(which I neved did, but why not...).

Second thing is that this is an "all-is-object" language. Even the Integer type is embedded in a class, with various methods like toString() and so on.
There is not much pointer support. Nor it is usual at first to use things like the windows api, because there will be in general a embedded equivalent version of all of this (though potentially less efficient).

The thing that can be great is when you don't see too much how you would deal with something and it is avaiable in the form of an object already designed for it. For instance for the network event, I just had to add this to the code: "AddHandler NetworkChange.NetworkAddressChanged, AddressOf AddressChangedCallback" in order to deal with the event. In the callback is where I make stuff blink and all. The class is the NetworkChange that is inherited from NetworkInformation that comes in a dll shipped with VS.

Of course it is possible to get the same result in FB, and in general it will be faster I'm pretty sure for it has less overhead. But it relies on the winApi anyway. However I don't know if it would be possible to use some of the vb.net dlls in FB. I think not due to the 'CLR' fence, but I'm not quite clear about this at all.
There is 2 issues so far. Compared to what is found there: https://docs.opencv.org/ref/2.4/d3/d63/ ... _1Mat.html, there are many missing constructors. Unless they are defined elsewhere. And this datatype can not be extended by hand just by trying to write the missing stuff for at least one reason, it contains a field named "type" which makes fbc refusing any addition of a new function. Renaming this field would potentially lead endless trouble, so I'm stuck right at this point.

Has anyone a good advice to reach the feature I want? Or did I miss something?

What I need is the constructor that converts IplImage to Mat. For now I get only:
error 24: Invalid data types, at parameter 1 (rows) of CV_MAT() in 'dim as CvMat m = cv_mat(img)
Needed, I suppose, a way to define this:

Just pop these three files into a folder to test.
albert
Posts: 5671
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jun 02, 2020 1:47

@Dodicat

It won't run on my Linux Box... I have Flite for Linux speech..
dodicat
Posts: 6478
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jun 02, 2020 8:36

Albert.
The speak related subs are
runscript
savefile
speak
speak2(which is a spare in the triplets file)
You can remove them and use your Linux method in your own speak sub.
I don't think I have speech on my Linux, but I'll fiddle around with Linux later.
Maybe I can get Flite from the Yum repository.
dodicat
Posts: 6478
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jun 02, 2020 22:13

Albert.
I did yum install flite (from root terminal), and it got installed.
But it doesn't work.
Not a peep.
albert
Posts: 5671
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jun 07, 2020 0:18

@Dodicat

I'm using Ubuntu Linux 16.04 ( a British Based Linux Distro )

I previously tried SUSE , MINT , PC-Linux , RedHat , SlackWare

I think Ubuntu 16.04 is the best.... I didn't like the newer Ubuntu 18..
Now their up to Ubuntu 20.?? I don't know if i want to try it or not. I'm happy with what I've got..

=============================================================
I got a data compression idea that I'm tossing around with...

Since all binary values above 0 start with a 1 , you can exclude the leading 1.. and it compresses 90% to 99 %
But how do you tel how many zeros are in front with the 1 gone???
There could be 7 zeros , and 3 bits added to the formula doesn't compress..
=============================================================
angros47
Posts: 1626
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » Jun 07, 2020 17:06

albert wrote:Since all binary values above 0 start with a 1 , you can exclude the leading 1.. and it compresses 90% to 99 %
But how do you tel how many zeros are in front with the 1 gone???
There could be 7 zeros , and 3 bits added to the formula doesn't compress..


You don't. That's why no compression algorithm uses such a formula. Because it doesn't work.

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests