Squares

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

Re: Squares

Postby albert » Mar 24, 2019 16:41

I came up with some names for the Grid Compressor:

Singularity
Black hole
Nemesis
Alien Gray
God Zip
Yah Zip
Spirit Zip
Cloud 6
Star 6
Grid Zip
G77 Zip

Which one sounds best?
fxm
Posts: 9076
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Squares

Postby fxm » Mar 24, 2019 16:54

"Black hole" is perfect for a compressor without decompressor.
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 24, 2019 17:16

@fxm

Black Hole compressor:
It keeps pulling money in , and no money escapes it... ( haha )

@Richard

I ran into a problem with the grid compressor....

You convert a file into binary , then feed it into the grid 49 bits at a time..
The binary probably is not a even number of 49 , so it would put 0's in the last grid at the end of the binary.
How would you know how to take those 0's off in the decompression?

Since the data could end with a 0 if its a binary 2. if you rtrim() the 0's you would lose the end zero..

If you stick 0's at the beginning , to make the binary ,an even multiple of 49 , the first byte could start with a zero.
So if you ltrim() the leading zeros you might lose the initial zero.

Do you have a solution?
badidea
Posts: 1417
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Mar 24, 2019 17:21

dodicat wrote:
badidea wrote:Without a working decompressor, your compressor is just a fancy hash generator.

Looking into cryogenics I note that people will pay about 200000 dollars for the process, and for the less well heeled, about 80000 dollars a head (literally).
So these half way processes have value.

Cryogenics? I thought this was about data (de)compression, not helium (de)compression.
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 24, 2019 21:17

I think i got the compressor working.. There's no way to decompress yet..

Recursing the compression : For some reason , it only compresses down to 252 bytes.. instead of 6 bytes..

I got to speed it up.
For files greater than 100,000 bytes , it takes like 20+ seconds , to solve the grid. as the size gets smaller , it speeds up.
Maybe cptr( ubyte ptr ) , would speed it up. But then , you still have like 49 subtractions per grid.

Code: Select all


'Grid compresor

'convert a file into binary
'load the binary into a 7x7 grid = 49 bits
'sum all the rows "how many 1's" in each row 0 to 7 = 3 bits
'sum all the columns "how many 1's" in each column 0 to 7 = 3 bits
'
'the output is 42 bits , (0 to 7) ^ 14
'3 bits for each row and 3 bits for each column , 14 sets of 3 bits.
'
'the difference between 49 bits in and 42 bits out is 7 bits.
'so there are 7 bits worth of duplicate grids (127 dups).
'
'I haven't yet, figured out how to point to a duplicate grid.
'theres no way to decompress the data yet.
'
'I was going to solve all possible grids and put them in the cloud.
'49 bits worth of grids = 127^7
'
'the compressor , i was going to give a way , for free
'then charge a monthly band-width fee to decompress in the cloud.
'
'the computer passes the summed grids to the cloud server.
'the cloud server , would then return a grid for the sum.
'
'you would have one or more cloud servers in each country , where ever they have DNS name servers.


screen 19

dim as string ascii_in = ""
dim as string final=""
dim as longint length = 0

dim as double time1 , time2 , time_total
do
   
    if len(ascii_in) = 0 then
        for a as longint = 1 to 10000
            ascii_in+=chr( int( rnd*256 ) )
            length = len(ascii_in)
        next
    else
        ascii_in = final
    end if
   
    time1=timer
   
    'left pad the asc string with "Z's"
    'then when you turn the binary grid back to ascii , you know to ltrim the Z's
    if len(ascii_in) mod 49 > 0 then ascii_in = string( ( 49 - len(ascii_in) mod 49 ) , "Z") + ascii_in
   
    dim as string binari = ""
    for a as longint = 0 to len(ascii_in)-1 step 1
        binari+=right("00000000"+bin(ascii_in[a]),8)
    next
   
    dim as string*49 _49
    dim as string h_out = ""
    dim as string v_out = ""
    dim as string f_out = ""
    for a as longint = 0 to len(binari)-1 step 49
       
        _49 = mid(binari,a,49)
       
        dim as ubyte horz( 1 to 7 )
        dim as ubyte vert( 1 to 7 )
       
        horz(1)+= (_49[00]-48) + (_49[01]-48) +(_49[02]-48) +(_49[03]-48) +(_49[04]-48) +(_49[05]-48) +(_49[06]-48)
        horz(2)+= (_49[07]-48) + (_49[08]-48) +(_49[09]-48) +(_49[10]-48) +(_49[11]-48) +(_49[12]-48) +(_49[13]-48)
        horz(3)+= (_49[14]-48) + (_49[15]-48) +(_49[16]-48) +(_49[17]-48) +(_49[18]-48) +(_49[19]-48) +(_49[20]-48)
        horz(4)+= (_49[21]-48) + (_49[22]-48) +(_49[23]-48) +(_49[24]-48) +(_49[25]-48) +(_49[26]-48) +(_49[27]-48)
        horz(5)+= (_49[28]-48) + (_49[29]-48) +(_49[30]-48) +(_49[31]-48) +(_49[32]-48) +(_49[33]-48) +(_49[34]-48)
        horz(6)+= (_49[35]-48) + (_49[36]-48) +(_49[37]-48) +(_49[38]-48) +(_49[39]-48) +(_49[40]-48) +(_49[41]-48)
        horz(7)+= (_49[42]-48) + (_49[43]-48) +(_49[44]-48) +(_49[45]-48) +(_49[46]-48) +(_49[47]-48) +(_49[48]-48)
       
        h_out = right("000"+bin(horz(1)),3)
        h_out+= right("000"+bin(horz(2)),3)
        h_out+= right("000"+bin(horz(3)),3)
        h_out+= right("000"+bin(horz(4)),3)
        h_out+= right("000"+bin(horz(5)),3)
        h_out+= right("000"+bin(horz(6)),3)
        h_out+= right("000"+bin(horz(7)),3)
       
        vert(1)+=(_49[00]-48) + (_49[07]-48) + (_49[14]-48) + (_49[21]-48) + (_49[28]-48) + (_49[35]-48) + (_49[42]-48)
        vert(2)+=(_49[01]-48) + (_49[08]-48) + (_49[15]-48) + (_49[22]-48) + (_49[29]-48) + (_49[36]-48) + (_49[43]-48)
        vert(3)+=(_49[02]-48) + (_49[09]-48) + (_49[16]-48) + (_49[23]-48) + (_49[30]-48) + (_49[37]-48) + (_49[44]-48)
        vert(4)+=(_49[03]-48) + (_49[10]-48) + (_49[17]-48) + (_49[24]-48) + (_49[31]-48) + (_49[38]-48) + (_49[45]-48)
        vert(5)+=(_49[04]-48) + (_49[11]-48) + (_49[18]-48) + (_49[25]-48) + (_49[32]-48) + (_49[39]-48) + (_49[46]-48)
        vert(6)+=(_49[05]-48) + (_49[12]-48) + (_49[19]-48) + (_49[26]-48) + (_49[33]-48) + (_49[40]-48) + (_49[47]-48)
        vert(7)+=(_49[06]-48) + (_49[13]-48) + (_49[20]-48) + (_49[27]-48) + (_49[34]-48) + (_49[41]-48) + (_49[48]-48)
       
        v_out = right("000"+bin(vert(1)),3)
        v_out+= right("000"+bin(vert(2)),3)
        v_out+= right("000"+bin(vert(3)),3)
        v_out+= right("000"+bin(vert(4)),3)
        v_out+= right("000"+bin(vert(5)),3)
        v_out+= right("000"+bin(vert(6)),3)
        v_out+= right("000"+bin(vert(7)),3)
       
        f_out+= h_out+v_out
       
    next
   
    final=""
    for b as longint = 1 to len(f_out) step 8
        final+=chr(val("&B"+mid(f_out,b,8)))
    next
   
    time2=timer
    time_total+=time2-time1
   
    print
    print "out len = "; len(final) , "Compression = ";  ( 100 - (100 / (length / len(final))) )
    print
    print "Time = " ; time2-time1 , time_total
    print
    'print "press a key to compress again."
   
    'sleep
   
loop until len(final) = 252

sleep
end



Turning the ascii string into binary is slowing it down...
dim as string binari = ""
for a as longint = 0 to len(ascii_in)-1 step 1
binari+=right("00000000"+bin(ascii_in[a]),8)
next

Maybe stepping by 8's and using a ulongint pointer would speed it up..
But then how would you create the binary ?? right( string( 21 , "0") + str( ptr ) , 21) ?? any one got a solution?
Richard
Posts: 2949
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Mar 24, 2019 23:09

Albert wrote:I think i got the compressor working.. There's no way to decompress yet..

@Albert. There is no way your grid approach is going to be reversible.
You need to stop posting hash functions and get back to us when you have a package that will compress to 50% or more, and will decompress to the original data every time.
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 24, 2019 23:12

@Richard

It decompresses in the cloud..
There would be a cloud server , that would tak in the sums and output the corresponding grid.

Here it is again....

Got the binari figured out and sped up..
Now to convert the string indexing to ptr's

Now it only compresses down to 2,016 bytes..

Code: Select all


'Grid compresor

'convert a file into binary
'load the binary into a 7x7 grid = 49 bits
'sum all the rows "how many 1's" in each row 0 to 7 = 3 bits
'sum all the columns "how many 1's" in each column 0 to 7 = 3 bits
'
'the output is 42 bits , (0 to 7) ^ 14
'3 bits for each row and 3 bits for each column , 14 sets of 3 bits.
'
'the difference between 49 bits in and 42 bits out is 7 bits.
'so there are 7 bits worth of duplicate grids (127 dups).
'
'I haven't yet, figured out how to point to a duplicate grid.
'theres no way to decompress the data yet.
'
'I was going to solve all possible grids and put them in the cloud.
'49 bits worth of grids = 127^7
'
'the compressor , i was going to give a way , for free
'then charge a monthly band-width fee to decompress in the cloud.
'
'the computer passes the summed grids to the cloud server.
'the cloud server , would then return a grid for the sum.
'
'you would have one or more cloud servers in each country , where ever they have DNS name servers.


screen 19

dim as string ascii_in = ""
dim as string final=""
dim as longint length = 0

dim as double time1 , time2 , time_total
do
   
    if len(ascii_in) = 0 then
        for a as longint = 1 to 100000
            ascii_in+=chr( int( rnd*256 ) )
            length = len(ascii_in)
        next
    else
        ascii_in = final
    end if
   
    time1=timer
   
    'left pad the asc string with "Z's"
    'then when you turn the binary grid back to ascii , you know to ltrim the Z's
    if len(ascii_in) mod (49*8) > 0 then ascii_in = string( ( (49*8) - len(ascii_in) mod (49*8) ) , "Z") + ascii_in
   
    dim as string binari=""
    dim as ulongint ptr usp = cptr(ulongint ptr , strptr(ascii_in))
    for a as longint = 1 to len(ascii_in) step 8
        binari+=right( string(64,"0") + bin(*usp),64)
        usp+=1
    next
   
    dim as string*49 _49
    dim as string h_out = ""
    dim as string v_out = ""
    dim as string f_out = ""
    for a as longint = 0 to len(binari)-1 step 49
       
        _49 = mid(binari,a,49)
       
        dim as ubyte horz( 1 to 7 )
        dim as ubyte vert( 1 to 7 )
       
        horz(1)+= (_49[00]-48) + (_49[01]-48) +(_49[02]-48) +(_49[03]-48) +(_49[04]-48) +(_49[05]-48) +(_49[06]-48)
        horz(2)+= (_49[07]-48) + (_49[08]-48) +(_49[09]-48) +(_49[10]-48) +(_49[11]-48) +(_49[12]-48) +(_49[13]-48)
        horz(3)+= (_49[14]-48) + (_49[15]-48) +(_49[16]-48) +(_49[17]-48) +(_49[18]-48) +(_49[19]-48) +(_49[20]-48)
        horz(4)+= (_49[21]-48) + (_49[22]-48) +(_49[23]-48) +(_49[24]-48) +(_49[25]-48) +(_49[26]-48) +(_49[27]-48)
        horz(5)+= (_49[28]-48) + (_49[29]-48) +(_49[30]-48) +(_49[31]-48) +(_49[32]-48) +(_49[33]-48) +(_49[34]-48)
        horz(6)+= (_49[35]-48) + (_49[36]-48) +(_49[37]-48) +(_49[38]-48) +(_49[39]-48) +(_49[40]-48) +(_49[41]-48)
        horz(7)+= (_49[42]-48) + (_49[43]-48) +(_49[44]-48) +(_49[45]-48) +(_49[46]-48) +(_49[47]-48) +(_49[48]-48)
       
        h_out = right("000"+bin(horz(1)),3)
        h_out+= right("000"+bin(horz(2)),3)
        h_out+= right("000"+bin(horz(3)),3)
        h_out+= right("000"+bin(horz(4)),3)
        h_out+= right("000"+bin(horz(5)),3)
        h_out+= right("000"+bin(horz(6)),3)
        h_out+= right("000"+bin(horz(7)),3)
       
        vert(1)+=(_49[00]-48) + (_49[07]-48) + (_49[14]-48) + (_49[21]-48) + (_49[28]-48) + (_49[35]-48) + (_49[42]-48)
        vert(2)+=(_49[01]-48) + (_49[08]-48) + (_49[15]-48) + (_49[22]-48) + (_49[29]-48) + (_49[36]-48) + (_49[43]-48)
        vert(3)+=(_49[02]-48) + (_49[09]-48) + (_49[16]-48) + (_49[23]-48) + (_49[30]-48) + (_49[37]-48) + (_49[44]-48)
        vert(4)+=(_49[03]-48) + (_49[10]-48) + (_49[17]-48) + (_49[24]-48) + (_49[31]-48) + (_49[38]-48) + (_49[45]-48)
        vert(5)+=(_49[04]-48) + (_49[11]-48) + (_49[18]-48) + (_49[25]-48) + (_49[32]-48) + (_49[39]-48) + (_49[46]-48)
        vert(6)+=(_49[05]-48) + (_49[12]-48) + (_49[19]-48) + (_49[26]-48) + (_49[33]-48) + (_49[40]-48) + (_49[47]-48)
        vert(7)+=(_49[06]-48) + (_49[13]-48) + (_49[20]-48) + (_49[27]-48) + (_49[34]-48) + (_49[41]-48) + (_49[48]-48)
       
        v_out = right("000"+bin(vert(1)),3)
        v_out+= right("000"+bin(vert(2)),3)
        v_out+= right("000"+bin(vert(3)),3)
        v_out+= right("000"+bin(vert(4)),3)
        v_out+= right("000"+bin(vert(5)),3)
        v_out+= right("000"+bin(vert(6)),3)
        v_out+= right("000"+bin(vert(7)),3)
       
        f_out+= h_out+v_out
       
    next
   
    final=""
    for b as longint = 1 to len(f_out) step 8
        final+=chr(val("&B"+mid(f_out,b,8)))
    next
   
    time2=timer
    time_total+=time2-time1
   
    print
    print "out len = "; len(final) , "Compression = ";  ( 100 - (100 / (length / len(final))) )
    print
    print "Time = " ; time2-time1 , "Time total = "; time_total
   
loop until len(final) <= 2016

sleep
end

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

Re: Squares

Postby albert » Mar 25, 2019 0:16

@Dodicat

Send me an email..
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 25, 2019 22:22

My compression idea can't be decompressed...

It's somehow recording the single into the byte?

( see: fin = chr( v1 ) ) ; if you make it fin = chr( int( v1 ) ) it doesn't compress.

Code: Select all



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

'==============  use =========

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
   
    if len(s) = 0 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*10)+48)
        Next
        compare =  s
        length = len(s)
    else
        dim as string fin=""
        dim as single v1
        for a as longint = 0 to len(s)-1 step 1
            v1 = s[a] / 2
            if frac(v1) <> 0 then v1+=128
            fin+=chr(v1) 'bad answer
        next
        s = fin
    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 (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
loop

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' ave  as an output file...

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
dim as ubyte v1
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs=""
    for b as longint = 0 to len(s)-1 step 1
        val1 = right("00000000"+bin(s[b]),8)
        outs+=chr( (val("&B"+mid(val1,2))*2) + val(left(val1,1)) )
    next
    comp = outs
next

s = Zlibrary.unpack(comp)

'print compare
'print
'print s

print
print "input = "; length , "output = " ; len(s) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
Print "!!~~Done~~!!"

Sleep
end

dodicat
Posts: 5892
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Mar 26, 2019 13:33

Albert.
To decompress, the first few characters of a compressed file are lengh+"|"
examples
1231|
23|
109776|
If you cut off this bit the de-compressor doesn't get fed the length of the string, thus returns an error.

If you view the first few characters of a compressed file you will see what I mean, that is of course if chr(13)is not included in in these first few in which case you will not see the numbers.
example

Code: Select all




print "231|"+chr(13)+"xxxxxxxxx"
sleep

 
 

I'll email later on if you wish, I haven't used email for months, Plusnet (my provider) wants me to re-do my password (some sort of security re-vamp), or perhaps a scammer at work, I'll have to look into it later.
I don't know about America, but this country now is abound with scams and cons.
jj2007
Posts: 1210
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Squares

Postby jj2007 » Mar 26, 2019 14:03

This compression thing is really fascinating, but I really wonder whether its participants are just pulling the legs of the rest of the World ;-)
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 26, 2019 15:33

@Dodicat

Don't email me
I already posted the code.. It failed to decompress..

I've got some more ideas to try..
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 26, 2019 17:00

@Dodicat

The decompressor works , here it is doing 10 loops.

Code: Select all



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

'==============  use =========

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
   
    if len(s) = 0 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*10)+48)
        Next
        compare =  s
        length = len(s)
    else
        dim as string fin=""
        dim as single v1
        for a as longint = 0 to len(s)-1 step 1
            v1 = s[a] / 2
            if frac(v1) <> 0 then v1+=128
            fin+=chr(int(v1)) 'bad answer
        next
        s = fin
    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 (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
loop until loops = 10

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' ave  as an output file...

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=""
    for b as longint = 0 to len(s)-1 step 1
        val1 = right("00000000"+bin(s[b]),8)
        outs+=chr( (val("&B"+mid(val1,2))*2) + val(left(val1,1)) )
    next
    comp = outs
next

s = Zlibrary.unpack(comp)

'print compare
'print
'print s

print
print "input = "; length , "output = " ; len(s) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
print "decompression sucessful."
print
Print "!!~~Done~~!!"


Sleep
end

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

Re: Squares

Postby albert » Mar 26, 2019 17:32

If you subtract .5 from each byte ..
It compresses like crazy..
But errors in the decompression..

If you subtract a whole value -1 to -255 , it doesn't compress. But it decompresses okay.
albert
Posts: 4916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 27, 2019 2:12

Here it is again....

Can anyone figure out , why it can't reproduce fin+=chr( s[a] - .5 )
if you do fin+= chr( s[a] - .6 ) it doesn't compress but decompresses just fine??

It doesn't work with - .5

Code: Select all



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

'==============  use =========

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 len(s) = 0 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*10)+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
        dim as string fin=""
        dim as single v1
        for a as longint = 0 to len(s)-1 step 1
            v1 = s[a] - .5
            fin+=chr((v1))
        next
        s = fin
    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 (100 - ( 100 / ( length / len(s) ) )) < compression 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
dim as single v1
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
   
    'print s
    'sleep
   
    outs=""
    for b as longint = 0 to len(s)-1 step 1
        v1 = s[b]+.5
        'val1 = right("00000000"+bin(s[b]),8)
        'outs+=chr( (val("&B"+mid(val1,2))*2) + val(left(val1,1)) )
        outs+=chr(v1)
    next
    comp = outs
next

s = Zlibrary.unpack(comp)

'print compare
'print
'print s

print
print "input = "; length , "output = " ; len(s) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
print "decompression sucessful."
print
Print "!!~~Done~~!!"


Sleep
end


Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests