Squares

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

Re: Squares

Postby dodicat » Apr 16, 2019 9:49

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=4294967196
dim as ulong aul(1 to 50)
for n as long=1 to 50
    aul(n)=ul+n
next
for 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  if
next

print "Press a key . . ."

sleep
dim as ulongint u=18446744073709051616

print
dim as ulongint au(1 to 100000)
for n as long=1 to 100000
    au(n)=u+n
next

for 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 if
next
sleep
 

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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Apr 28, 2019 2:20

@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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 04, 2019 17:00

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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 04, 2019 17:33

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.
badidea
Posts: 1416
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » May 04, 2019 20:23

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

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

Re: Squares

Postby albert » May 09, 2019 0:21

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 string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1,time2,time3,time4
do
   
    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)

sleep
end
'===============================================================================
'===============================================================================
'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: 2948
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » May 09, 2019 0:49

@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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 09, 2019 2:12

@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 string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1,time2,time3,time4
do
   
    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)

sleep
end
'===============================================================================
'===============================================================================
'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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 09, 2019 17:22

@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 string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1,time2,time3,time4
do
   
    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)

sleep
end
'===============================================================================
'===============================================================================
'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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 09, 2019 20:22

@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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 10, 2019 19:24

@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 string
Declare Function decompress_loop( chrs as string ) as string

Namespace 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 Long
End Extern

Function 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 text
End 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 uncompressed
End 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 compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    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 = 10

print "Press a key to decompress." 
sleep

s = 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 val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'===============================================================================
'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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 12, 2019 23:07

@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: 2948
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » May 13, 2019 1:03

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

Re: Squares

Postby Richard » May 13, 2019 1:48

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

Code: Select all

Screen 19
Do
    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: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 13, 2019 23:18

@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....

Return to “General”

Who is online

Users browsing this forum: No registered users and 16 guests