Squares

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

Re: Squares

Postby albert » May 13, 2019 23:26

@Richard

I figured out how to compress data to the maximum....You turn each byte into a number of zeros , or a number of ones.

A megabyte string , compresses down , to just a few bytes..
But you don't know where 1 byte ends and then next begins..If you put in a separator , it doesn't compress...
jj2007
Posts: 1134
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Squares

Postby jj2007 » May 14, 2019 1:13

albert wrote:A megabyte string , compresses down , to just a few bytes..
That's a really good start! If you are stuck with the details of decompression, here is some reading for you.
albert
Posts: 4605
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 15, 2019 17:11

@Richard
@Dodicat

I came up with a "lossey Compression" it compresses down to 97%..

It turns the data into binary , and then replaces all the "00's" with "01's"

The input data needs to be several kilobytes for it to compress.. it doens't work on hundreds...


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 10000
            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 = 20

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 string zeros= string(8,"0")
    for a as longint = 1 to len(chrs) step 1
        binari+=right(zeros + bin(chrs[a-1]),8)
    next
   
    'print "inp = "; len(binari) , binari
   
    dim as string outputs = binari
    dim as string n1
    for a as longint = 1 to len(binari) step 2
        n1 = mid(binari,a,2)
        if n1 = "00" then mid(outputs,a,2) = "01"
    next
   
    'print "out = "; len(outputs) , 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 "out = " ; len(final_out) , 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 "len = " ; len(binari) , binari

    dim as string final_out = chrs
   
    return final_out
   
end function

albert
Posts: 4605
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 17, 2019 3:36

@Richard

I got lossless compression working...Compresses 10,000 bytes , down to under 100 bytes..
I can't post the code.. I need to copyright it or patent it..

After several days and hours and hours of playing with the zlib compressor , I finally figured out how to trick it , into compressing random data..
Richard
Posts: 2907
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » May 17, 2019 15:02

@albert.
I believe in the science of information theory which says that you cannot compress truly random data.
I think you have tricked yourself, not Zlib.
albert
Posts: 4605
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 18, 2019 1:07

@Richard

The compressor works. I just can't figure out how to decompress it.

I'll go ahead and post it.

you have , stepping by 2 bits
00
01
10
1

So it turns 8 bits into 7 , so it compresses , and 11 is the most prolific set... so 10,000 compresses to under 9,000 on the first run.

10-01 has 00
10-10 has 101
01-01 has 101

So i'm confused about decompression..
You can put "000" as the first set, but it doesn't compress as much , but solves the "00" issue.

I can't figure out the "101" issue...

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 10000
            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 = 20

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 string zeros= string(8,"0")
    for a as longint = 1 to len(chrs) step 1
        binari+=right(zeros + bin(chrs[a-1]),8)
    next
   
    'print "inp = "; len(binari) , binari
   
    dim as string outputs = ""
    dim as string n1
    for a as longint = 1 to len(binari) step 2
        n1 = mid(binari,a,2)
        if n1 = "00" then outputs+ = "00"
        if n1 = "01" then outputs+ = "01"
        if n1 = "10" then outputs+ = "10"
        if n1 = "11" then outputs+ = "1"
    next
   
    'print "out = "; len(outputs) , outputs
   
    dim as ubyte count=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(outputs)/8)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+= "0" : count+=1
    loop until dec1=0
   
    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
   
    final_out = chr(count) + final_out
   
    'print "out = " ; len(final_out) , final_out
   
    return final_out
   
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as ubyte count = asc(left(chrs,1))
    chrs = mid(chrs,2)
   
    dim as string binari=""
    for a as longint = 0 to len(chrs)-1 step 1
        binari+=right("00000000"+bin(chrs[a]),8)
    next
   
    binari = left(binari,len(binari)-count)
   
    'print "len = " ; len(binari) , binari

    dim as string final_out = chrs
   
    return final_out
   
end function

Richard
Posts: 2907
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » May 18, 2019 1:46

Albert wrote:I got lossless compression working...
Albert wrote:The compressor works. I just can't figure out how to decompress it.
Then it is simply another a "hash function". It is not "lossless compression".
albert
Posts: 4605
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 18, 2019 2:20

@Richard

I was trying to use the instr() function to search for the sets..

10-10 has a 10 and 01
01-01 has a 01 and 10

01-10 solves out okay..

I've been racking my brain , how to solve it by stepping through the data..

Because it only uses a single 1 for the "11" set. you can't step through the data by 2's. so it's not systematic..

I'm sure there's a way to accomplish it. I'm just stupid and fumbling...

But you know that any numbers of 1's , that's not followed by a 0 , solve out to "11's"
I think you didn't run the code and look into it , before you called it a hash function..

if you step through it by 1's when you run into a 0 you need to read ahead to see if its a 1001 or a 1010 or a 0110 or a 0101..
I just can't seem to wrap my head around the concept to solve it...

if n1 = "00" then outputs+ = "000"
if n1 = "01" then outputs+ = "010"
if n1 = "10" then outputs+ = "10"
if n1 = "11" then outputs+ = "1"

compresses but requires 40+ loops
dodicat
Posts: 5698
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » May 18, 2019 22:52

Not 100% sure of your requirements Albert.
Here is a string tally function.

Code: Select all

 
Function TALLY(SomeString As String,PartString As String,a() As Integer) As Long
    Dim As Long LenP=Len(PartString),count
    Dim As Long position=Instr(SomeString,PartString)
    If position=0 Then Return 0
    While position>0
        count+=1
        position=Instr(position+LenP,SomeString,PartString)
    Wend
    Redim a(1 To count)
    Var u=count
    position=Instr(SomeString,PartString)
    a(1)=position
    count=1
    While count < u
        count+=1
        position=Instr(position+LenP,SomeString,PartString)
        a(count)=position
    Wend
    Return u
End Function

screen 12

dim as ulongint u=-1
u=u\1000000
dim as string b=bin(u)

dim as long flag
for n as long=0 to len(b)-1
    if n<len(b) then
    if b[n]=asc("0") and b[n+1] = asc("1") then color 4 :flag=1
    end if
print chr(b[n]);
flag+=1
if flag=3 then color 15:flag=0
next
print

redim as integer a()
var t=tally(bin(u),"01",a())

print "position of 01 in string"
for n as long=lbound(a) to ubound(a)
    print a(n)
next
print
print "number of occurrencies = ";t
print "Length of string ";len(b)
sleep
 
albert
Posts: 4605
Joined: Sep 28, 2006 2:41
Location: California, USA

Data Compression

Postby albert » May 19, 2019 19:05

@Dodicat

I need to find the stray "1's" that expand to "1111"

See compress_loop() , I need to write a decompressor

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
   
    dim as string binari=""
    dim as string zeros= string(8,"0")
    for a as longint = 1 to len(chrs) step 1
        binari+=right(zeros + bin(chrs[a-1]),8)
    next
   
    print "comp in  = " ; len(binari) ; "    " ; binari
   
    dim as string outputs = ""
    dim as string n1
    for a as longint = 1 to len(binari) step 4
        n1 = mid(binari,a,4)
        if n1="1111" then outputs+= "1" else outputs+=n1
    next
   
    print "comp out = "; len(outputs) ; "    " ; outputs
   
    dim as ubyte count=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(outputs)/8)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+= "0" : count+=1
    loop until dec1=0
   
    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
   
    final_out = chr(count) + final_out
   
    'print "out = " ; len(final_out) , final_out
   
    return final_out
   
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as ubyte count = asc(left(chrs,1))
   
    chrs=mid(chrs,2)
   
    dim as string binari=""
    dim as string zeros= string(8,"0")
    for a as longint = 1 to len(chrs) step 1
        binari+=right(zeros + bin(chrs[a-1]),8)
    next
   
    binari = left(binari,len(binari)-count)
   
    print "decomp   = " ; len(binari) ; "    " ; binari
   
   
    dim as string final_out = chrs
   
    'for a as longint = 1 to len(outs) step 8
    '    final_out+= chr(val("&B"+mid(outs,a,8)))
    'next
   
    return final_out
   
end function


Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests