## Squares

General FreeBASIC programming questions.
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

val (double) is good for ulong, you can use double for a 32 bit colour for example.
But for ulongint, double is not accurate.
Example:

Code: Select all

`dim as ulong ul=4294967196dim as ulong aul(1 to 50) for n as long=1 to 50    aul(n)=ul+nnextfor n as long=1 to 49   if val(str(aul(n+1)))-val(str(aul(n))) <>0 then    print n,vallng(str(aul(n+1)))-vallng(str(aul(n))), val(str(aul(n+1)))-val(str(aul(n)))end  ifnextprint "Press a key . . ."sleepdim as ulongint u=18446744073709051616printdim as ulongint au(1 to 100000)for n as long=1 to 100000    au(n)=u+nnextfor n as long=1 to 99999   if val(str(au(n+1)))-val(str(au(n))) <>0 then    print n,valulng(str(au(n+1)))-valulng(str(au(n))), val(str(au(n+1)))-val(str(au(n)))    end ifnextsleep  `

double might be OK for lossy compression (pictures, sounds . . . ), but if you use 64 character jumps in strings then you need ulongint and ulongint functions.
(That's my guess anyway)
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I've been analyzing compressible data , it seem that the odds are the problem...

Data like "101010" make the compression harder.. compressing recurring numbers of 1's and 0's works fine.
But when you have 1's and 0's mixed , it can't compress...

I've been working a methods to handle the mixed case...

Every time i get compression , it seems there's an error in my code..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I got a new laptop computer

It's an HP

it's got an Intel i3 , quad core , 2,2GHz processor
8 gigs of ram
dvd player
memopry stick port
3 USB ports
17.6" screen
builtin camera

It was \$620+tax , but i got it on sale for \$430 out the door...

I wiped the hard drive , and installed Linux 64 bit
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

If you sit on the couch all day , watching TV , they call you a couch potato

If you sit on the computer all day , your a computer potato or compu-tater.
Posts: 2149
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Squares

albert wrote:If you sit on the computer all day, ...

Trying to make your new laptop a bit thinner?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Can anyone find the errors ???

I tried to go in reverse for the de-compressor , but its erroring.. ( getting bad output )

I think MKI( 10 digits value ) is outputing 8 bytes instead of 4 ??

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do        randomize        dim as string s=""    For n As Long = 1 To 10        s+=chr(Int(Rnd*256))'+48)    Next        time1=timer    'begin compress        dim as string comp = compress_loop(s)    'end compress    time2 = timer        time3=timer    'begin decompress        dim as string final_out = decompress_loop(comp)     'end decompress    time4 = timer        print    print string(99,"=")    print s    print string(99,"=")    print final_out    print    print "compress time   = "; time2-time1    print "decompress time = "; time4-time3    print        if s = final_out then print "Decompressed OK" else print "Decompression failed."         sleep    loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string        print "input len = "; len(chrs)        dim as string binari=""    dim as uinteger ptr uip = cptr(uinteger ptr , strptr(chrs))    for a as longint = 1 to len(chrs) step 4        binari+=right(string(10,"0")+str(*uip),10)        uip+=1    next        print binari        dim as string outputs=""    dim as ubyte n1    for a as longint = 1 to len(binari) step 1        n1 = val(mid(binari,a,1))        outputs+= right(string(4,"0")+bin(n1),4)    next        print outputs        dim as string final_out =""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        print "compress len = " ; len(final_out)        return final_out    end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string        dim as string binari=""    for a as longint = 0 to len(chrs)-1 step 1        binari+=right("00000000"+bin(chrs[a]),8)    next        print binari        dim as string outputs=""    dim as ubyte n1    for a as longint = 1 to len(binari) step 4        n1 = valulng("&B"+mid(binari,a,4))        outputs+=str(n1)    next        print outputs        dim as string final_out =""    for a as longint = 1 to len(outputs) step 10        final_out+=mki(valulng(mid(outputs,a,10)))    next        print "Decompress len = " ; len(final_out)        return final_out    end function`
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@Albert
MKI will output an integer for your platform, 32 or 64 bits.
Use MKL to force 4 bytes.

MKI supports an optional <bits> parameter before the argument. If bits is 16, MKShort will be called instead; if bits is 32, MKL will be called; if bits is 64, MKLongInt will be called. The length of the return value and the required number argument type will depend on which function is called. See each function's page for more information.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

I tried MKL , and MKL( 10 digit value ) errors ???? It doesn't return the correct value..

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do        randomize        dim as string s=""    For n As Long = 1 To 10        s+=chr(Int(Rnd*256))'+48)    Next        time1=timer    'begin compress        dim as string comp = compress_loop(s)    'end compress    time2 = timer        time3=timer    'begin decompress        dim as string final_out = decompress_loop(comp)     'end decompress    time4 = timer        print    print string(99,"=")    print s    print string(99,"=")    print final_out    print    print "compress time   = "; time2-time1    print "decompress time = "; time4-time3    print        if s = final_out then print "Decompressed OK" else print "Decompression failed."         sleep    loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string        print "input len = "; len(chrs)        dim as string binari=""    dim as uinteger ptr uip = cptr(uinteger ptr , strptr(chrs))    for a as longint = 1 to len(chrs) step 4        binari+=right(string(10,"0")+str(*uip),10)        uip+=1    next        print binari        dim as string outputs=""    dim as ubyte n1    for a as longint = 1 to len(binari) step 1        n1 = val(mid(binari,a,1))        outputs+= right(string(4,"0")+bin(n1),4)    next        print outputs        dim as string final_out =""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        print "compress len = " ; len(final_out)        return final_out    end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string        dim as string binari=""    for a as longint = 0 to len(chrs)-1 step 1        binari+=right("00000000"+bin(chrs[a]),8)    next        print binari        dim as string outputs=""    dim as ubyte n1    for a as longint = 1 to len(binari) step 4        n1 = valulng("&B"+mid(binari,a,4))        outputs+=str(n1)    next        print outputs        dim as string final_out =""    dim as string v1    for a as longint = 1 to len(outputs) step 10        v1 = mkl(valulng(mid(outputs,a,10)))        final_out+=v1    next        print "Decompress len = " ; len(final_out)        return final_out    end function`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Can you help???
I'm having problems turning "outputs" back into ascii....

See: decompress_loop()

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do        randomize        dim as string s=""    For n As Long = 1 To 10        s+=chr(Int(Rnd*256))'+48)    Next        time1=timer    'begin compress        dim as string comp = compress_loop(s)    'end compress    time2 = timer        time3=timer    'begin decompress        dim as string final_out = decompress_loop(comp)     'end decompress    time4 = timer        print    print string(99,"=")    print s    print string(99,"=")    print final_out    print    print "compress time   = "; time2-time1    print "decompress time = "; time4-time3    print        if s = final_out then print "Decompressed OK" else print "Decompression failed."         sleep    loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string        print    print string(99,"=")    print "input len = "; len(chrs)    print        dim as string binari=""    dim as uinteger ptr uip = cptr(uinteger ptr , strptr(chrs))    for a as longint = 1 to len(chrs) step 4        binari+=right(string(10,"0")+str(*uip),10)        uip+=1    next        print "compress decimal = " ; binari    print        dim as string outputs=""    dim as ubyte n1    for a as longint = 1 to len(binari) step 1        n1 = val(mid(binari,a,1))        outputs+= right(string(4,"0")+bin(n1),4)    next        print "compress binari  = " ; outputs    print        dim as string final_out =""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        print "compress len = " ; len(final_out)        return final_out    end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string        dim as string binari=""    for a as longint = 0 to len(chrs)-1 step 1        binari+=right("00000000"+bin(chrs[a]),8)    next        print    print "output binari   = " ; binari        dim as string outputs=""    dim as ubyte n1    for a as longint = 1 to len(binari) step 4        n1 = valulng("&B"+mid(binari,a,4))        outputs+=str(n1)    next        print    print "output decimal  = " ; outputs        'having problems turning decimal ( outputs ) back into ascii     dim as string final_out =""    dim as string v1    for a as longint = 1 to len(outputs) step 10        v1 = mkl(valulng(mid(outputs,a,10)))        final_out+= v1    next        print    print "Decompress len = " ; len(final_out)        return final_out    end function`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Nerve mind, i found the error...
On 64 bit systems , a uinteger returns 64 bits , instead of 32 bits.

You have to use "long" or "ulong" to get 32 bits.

I was getting half the value...So it was appearing to compress...Stupid me!! Another stupid mistake...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I got super compression!!

But it gets expotensionally bigger each iteration..So it doesn't compress the original...

But check out the , per iteration compression

Code: Select all

`Declare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace Zlibrary#inclib "zlib"Extern "C"    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As LongEnd ExternFunction getpassedinfo(text As String,Byref passed_length As Integer) As String    Dim As String var1,var2    Dim As Integer pst    #macro splice(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then        var1=Mid(stri,1,pst-1)        var2=Mid(stri,pst+1)    Else        var1=stri    End If    #endmacro    splice(text,"|",var1,var2)    text=var2    passed_length=Valint(var1)    Return textEnd Function'=================   UNPACK ===============Function unpack(file As String) As String    Dim As Integer passed_length    Dim As String text=getpassedinfo(file,passed_length)    Dim As Integer stringlength,destinationlength    stringlength=Len(text)    destinationlength =passed_length    Dim As Ubyte Ptr source    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)    source=@text[0]    Var mistake=uncompress(destination,@destinationlength, source, stringlength)    If mistake<>0 Then Print "There was an error":Sleep:End    Dim As String uncompressed    uncompressed=String(destinationlength,0)    For i As Integer = 0 To destinationlength- 1        uncompressed[i]=(destination[i])    Next    Deallocate destination    Return uncompressedEnd Function'===================  PACK ============Function pack(file As String) As String    Dim As String text=file    Dim As Integer stringlength,destinationlength    stringlength=Len(text)    destinationlength = compressBound(stringlength)    Dim As Ubyte Ptr source    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)    source=@text[0]    Var mistake=compress(destination, @destinationlength, source, stringlength)    If mistake <>0 Then Print "There was an error"    Dim As String compressed    compressed=String(destinationlength,0)    For n As Integer=0 To destinationlength-1        compressed[n]=destination[n]    Next n    compressed=stringlength &"|"+compressed    Deallocate destination    Return compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper '=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0 dim as longint loops = 0do        loops+=1        'one time run , create initial string     if loops = 1 then        For n As Long = 1 To 100            s+=chr(Int(Rnd*256))'+48)        Next        compare =  s        length = len(s)    else        'modify compression to make further compression possible                 s = compress_loop(s)            end if    check = s    compression = (100 - ( 100 / ( length / len(check) ) ))        Print "original string"    Print Len(s)    Print       Dim As String compressed=Zlibrary.pack(s)    s = compressed        Print "packed string "    Print Len(compressed)    Print        Dim As String uncompressed=Zlibrary.unpack(compressed)       Print "Retrieve"    Print Len(uncompressed)    Print    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"    Print Iif(uncompressed=check,"OK","ERROR")    Print "-------------------------------"        'sleep 1000        'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do        print "press a key for next compression."    print    print "press esc to exit."    sleep        if inkey = chr(27) then exit do    loop until loops = 10print "Press a key to decompress."  sleeps = str(loops) + "_" + s ' save as an output file...'=================================================================='decompress'==================================================================dim as longint dec = instr(1,s,"_")dim as longint count = val(left(s,dec-1))dim as string comp = mid(s,dec+1)dim as string val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printPrint "!!~~Done~~!!"Sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string        dim as string binari=""    dim as ulong ptr ulp = cptr(ulong ptr,strptr(chrs))    for a as longint = 1 to len(chrs)  step 4        binari+=right(string(32,"0")+bin(*ulp),32)        ulp+=1    next        'print binari        dim as string outs1 = string(len(binari),"0")    dim as string outs2 = string(len(binari),"0")    dim as string outs3 = string(len(binari),"0")    dim as string outs4 = string(len(binari),"0")    dim as string outs5 = string(len(binari),"0")    dim as string outs6 = string(len(binari),"0")    dim as string outs7 = string(len(binari),"0")    dim as string outs8 = string(len(binari),"0")    dim as string outs9 = string(len(binari),"0")    dim as string outs10 = string(len(binari),"0")    dim as string v1    for a as longint = 1 to len(binari) step 4        v1 = mid(binari,a,4)                if v1 = "0010" then mid(outs1,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "0100" then mid(outs2,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "0101" then mid(outs3,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "0110" then mid(outs4,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "0111" then mid(outs5,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "1010" then mid(outs6,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "1011" then mid(outs7,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "1100" then mid(outs8,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "1101" then mid(outs9,a,1) = "1" : mid(binari,a,4) = "0000"        if v1 = "1110" then mid(outs10,a,1) = "1" : mid(binari,a,4) = "0000"            next        'print    'print binari    'print    'print outs1    'print outs2    'print outs3    'print outs4    'print outs5    'print outs6    'print outs7    'print outs8    'print outs9    'print outs10        binari+ = outs1+outs2+outs3+outs4+outs5+outs6+outs7+outs8+outs9+outs10        'dim as string outputs=""    'for a as longint = 1 to len(binari) step 8    '    outputs+=chr( valulng("&B"+mid(binari,a,8)) )    'next        'print "out len = " ; len(outputs) , outputs        dim as string final_out = binari        return final_out    end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string        dim as string final_out = chrs        return final_out    end function`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

how does str( cvshort( 2 chars ) ) , output 6 digits??? it swhouldn't go beyond 5 digits 65,535 = 5 digits.

Code: Select all

`screen 19    do    dim as string s=""    For n As Long = 1 To 10        s+=chr(Int(Rnd*256))'+48)    Next    print        dim as string v1    for a as longint = 1 to len(s) step 2                v1 = str(cvshort(mid(s,a,2)))                print len(v1)    next    sleep    loop until inkey = chr(27)end`
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@Albert.
You are using Short integers, so half the time you should expect a minus sign as the first digit.
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

Now you need to find out how CUshort is supposed to work.

Code: Select all

`Screen 19Do    cls    ' make a string of bytes    Dim As String v, s = "0123456789"    Dim as integer i    For i = 0 To len(s) - 1        s[ i ] = Int( Rnd * 256 )    Next i    Dim As Short ts    Dim As Ushort tus    ' extract pairs of bytes    Print "..."    For i = 1 To Len( s ) Step 2                ts = Cvshort( Mid( s, i, 2 ) )        v = Str( ts )        Print v, Len( v ), ts                tus = s[ i - 1 ] + 256 * s[ i ]      ' Cushort( Mid( s, i, 2 ) ) ? ? ?        v = Str( tus )        Print v, Len( v ), tus                Print "..."    Next i        Sleep    Loop Until Inkey = Chr( 27 )`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

I thought i finally had compression...
But the negatives were turning out to "0's". So every other number was 0..

I was getting partial rights... like 2 correct then 2 blanks and then 2 rights, i couldn't figure it out the problem..

Using ushort's it doesn't compress.

Using BYTE , you don't have that problem. It works itself out , to the right value.

When you assign a short to a string it should work like byte , and turn it into the ushort value..

Back to the drawing board....