## Squares

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

### Re: Squares

I got it fixed...

Here it is again....
Somehow ; dropping the 64th bit , makes a big difference over multiple loops...

Here's 8000 bytes over 40 loops

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 8*1000        s+=chr(Int(Rnd*256))'+8)    Next       time1=timer    'begin compress        dim as string comp=s        for a as longint = 1 to 40 step 1            comp = compress_loop(comp)        next    'end compress    time2 = timer       time3=timer    'begin decompress        dim as string final_out = comp        for a as longint = 1 to 40 step 1            final_out = decompress_loop(final_out)        next    'end decompress    time4 = timer       cls    draw string( 0,10) , left(s,100)    draw string( 0,30) , left(final_out,100)    'print string(99,"=")    'print "inp = " ; (s)    'print string(99,"=")    'print "out = " ; (final_out)    print    print    print    print    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          if len(chrs) mod 8 > 0 then chrs+= string( ( 8 - len(chrs) mod 8 ) , chr(0))        dim as string binari=""    dim as string n1    dim as string n2    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        n1 = left(n1,63)        binari+=n1    next       'print "c  in = "  ; len(chrs)    'print "c bin = "  ; len(binari), binari       dim as string str1    dim as longint dec1    do        str1=str(len(binari)/64)        dec1=instr(1,str1,".")        if dec1<>0 then binari ="0" + binari    loop until dec1=0       dim as string final_out =""    for a as longint = 1 to len(binari) step 64        final_out+=mklongint(valulng("&B"+mid(binari,a,64)))    next       print "c out = "; len(final_out)           return final_out       end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string       'print "d  in = "  ; len(chrs)       dim as string binari=""    dim as string n1    dim as string n2    dim as string zeros=string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8               n1 = bin(*ubp) : ubp+=1               n1=right(zeros+ n1,64)               'print "n1 = "; n1               binari+=n1           next        binari = mid(binari , (len(binari) mod 63) +1)        'print "d bin = "  ; len(binari) , binari        dim as string outputs=""    for a as longint = 1 to len(binari) step 63        n1=mid(binari,a,63) + "1"        outputs+=n1    next       dim as string final_out = ""    for a as longint = 1 to len(outputs) step 64        final_out+=mklongint(valulng("&B"+mid(outputs,a,64)))    next       'print "d out = "; len(final_out)      final_out = rtrim(final_out,chr(0))        return final_outend function`
Posts: 2111
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Squares

Try 400 'compression' loops, and your compressed data looks like this:

0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 103 97 111 0 0 0 0 0 201 242 10 231 153 61 48 116 0
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

You have to quit looping when the outputs is the same length as the input.

@Richard
I'm trying to reverse an "AND" formuia, any ideas??

when n2 < input output is correct when n2 = input output is 2 higher??

Code: Select all

`screen 19do           dim as ulongint n1 = int(rnd*256)          dim as ulongint n2 = n1 and not 2          print     print "n1" ,, "n1 and not 2" ,,  "1- (n2 xor not 2)"     print  n1   ,,         n2             ,,  -1 - (n2 xor not 2)          sleep     loop until inkey = chr(27)sleepend`
Richard
Posts: 3029
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@albert
Bitwise logic; z = ( x AND y ). Given input y and output z, solve for input x.

It is obvious that the AND function cannot be reversed when a bit position in both y and z are zero.
That should not stop you from trying to solve it, but I cannot help you to do the impossible.
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Here's ( val AND NOT 2 ) , it compresses down to 93.7% ( 10K to 600 bytes after 40 loops. )

I've been analyzing the formula, and it seems to be variable..
It's not consistently off by a value every so many numbers..
it sometimes skips 2 or 3 times and then equals..Sometimes it equals two times in a row and sometimes equals every 3 or 4 times ..
I've been analyzing the output and so far can't come up with a reversal formula.. ( i'll keep working on it. )

I tried comparing the output with mods and xor's and or's ,
Thinking that ; at some values it would be off and certain values it would be equal.. But it seems to be completely inconsistent.

Here's the code...

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 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 = 40print "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 string n1    dim as string n2    dim as ubyte ptr ubp = cptr(ubyte ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 1                n1 = str(*ubp) : ubp+=1                n1 = bin( val(n1) and not 2)                n1 = right(string(8,"0") +n1,8)                binari+=n1        next        print "inp = "  ; len(chrs)    print "bin = "  ; len(binari) ', binari        dim as string final_out =""     for a as longint = 1 to len(binari) step 8        final_out+=chr(valulng("&B"+mid(binari,a,8)))    next    print "fin = "; len(final_out)            return final_out        end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string        dim as string final_out = chrs        return final_outend function`
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I redid the ( val AND NOT 2 ) code... to progress from 0 to 255...

The output follows a pattern... 0 1 0 1 , 4 5 4 5 , 8 9 8 9 , 12 13 12 13 etc... iterating by 2's.. Incrementing by 4 each set. 0 , 4 , 8 , 12 , 16 , 20

Is there a way to reverse it Richard??

Code: Select all

`screen 19do          for n1 as longint = 0 to 255              dim as ulongint n2 = n1 and not 2          dim as ulongint n3 =  -1 - (n2 xor not 2)          print     print "n1" ,, "n1 and not 2" ,,  "1- (n2 xor not 2)"     print  n1   ,,         n2             ,,   n3  , ,   (n2 mod 2) +n2          sleep    if inkey = chr(27) then end    next    loop until inkey = chr(27)end`
dodicat
Posts: 6629
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

The values are paired.
Create a look up table and get both values.

Code: Select all

`Dim As Long lookup(255)For n1 As Long = 0 To 255 'create lloup    lookup(n1)=n1 And Not 2NextFor n As Long=Lbound(lookup) To Ubound(lookup) 'show lookup    If n Mod 20=0 Then Print    If n Mod 4=0 Then Color 5    If n Mod 8=0 Then Color 15    Print lookup(n);" ";Next Color 15 PrintPrintType pair    As Long n1,n2End TypeFunction find(a() As Long,n As Long) As pair    Redim As Long c(0)    For i As Long=Lbound(a) To Ubound(a)        If a(i)=n Then Redim Preserve c(1 To Ubound(c)+1):c(Ubound(c))=i    Next i    If Ubound(c)=2 Then        Return Type<pair>(c(1),c(2))    Else        Return Type<pair>(-1,-1)  'failure    End IfEnd Function'Randomize   'testPrint " n1 (random)";Tab(20);"n1 values(returned)"PrintFor n As Long=1 To 100    Var x1=Int(Rnd*255)      Var y=x1 And Not 2    Dim As pair p=find(lookup(),y)    Print x1;Tab(20);p.n1,p.n2 NextPrint ". . ."Sleep  `
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard
@Dodicat

Back to the drawing board!!
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

The goal is to create a 1:1 or slightly less formula , that will compress further..
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard
@Dodicat

I finally got a formula that works...

Except it varies , each loop.
Sometimes it compresses a loop and sometimes it expands a loop...
But mostly is compresses , but sometimes not...It's variable.

I haven't yet wrote the de-compressor...
For the de-compressor , it's just searching for the 0's and setting the bits that occur before the "0"...

it creates a string map = "12345678"
Then bubble sorts the input bits , swapping the input bits and the map locs.. then finding the first 1 input bits and taking that map position..
Then stepping through the map , by 2 digits at a time , and turning it into a chr()
If the map has 2 or more zeros in a row then you know to create 8 zeros.

Here it is ; doing 100 loops of 10K

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 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 = 100print "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 string n1    dim as string zeros = string(8,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 1        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,8)                dim as string map=""        for b as longint =  1 to 8             map+=str(b)        next                    for b as longint = 0 to 7            for c as longint = 0 to 7                if n1[b] <  n1[c] then                    swap     n1[b] ,    n1[c]                    swap map[b] , map[c]                end if            next        next                dim as longint place = instr(1,n1,"1")        map = mid(map,place)        binari+= map + "0"    next        print "c bin = "  ; len(binari) ', binari       dim as string final_out = ""    for a as longint = 1 to len(binari) step 2        final_out+=chr(valulng(mid(binari,a,2)))    next        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string       dim as string final_out = chrs        return final_outend function`
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

It doesn't work after all.......

dim as string binari=""
dim as string n1
dim as string zeros = string(8,"0")
dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))
for a as longint = 1 to len(chrs) step 1

With ubyte ptr is constantly expands the data...

Back to the drawing board!!!
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

How would you swap the map bytes???

Code: Select all

`        dim as string chrs = "12345678901234567890"        dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 1        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)                dim as string map=""        for b as longint =  1 to 64            map+=right("00"+ str(b),2)        next                    for b as longint = 0 to 63            for c as longint = 0 to 63                if n1[b] <  n1[c] then                    swap n1[b] , n1[c]                    swap map[b] , map[c]  ' map = 2 bytes how would you swap the map locations????                end if            next        next                dim as longint place = instr(1,n1,"1")        map = mid(map,place)        binari+= map + "0"    next        `
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I got compression... There's no stupid errors in the code this time...

The delema is : that after you create the "map" , the input "binari" string , is holding some stray zeros.

It searches the input "binari" string for "11" , "10" , "01" , "00" and puts a 4,3,2 or 1 in the map at that location.
The search and replace , leaves some stray zeros in the input string...

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 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 = 40print "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 string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) ', binari      dim as string map = string(len(binari),chr(0))   for a as longint = 3 to 0 step -1       n1 = right("00"+bin(a),2)       dim as longint place=0       do           place=instr(place+1,binari,n1)           mid(binari,place,2) = string(2,chr(0))           mid(map,place,1) = str(a+1)        loop until place=0    next        'After map , binari is holding some stray zeros... What to do?        dim as string outputs=""    for a as longint = 1 to len(map) step 1        n1 = mid(map,a,1)        if n1<> chr(0) then outputs+=n1    next       print "c map = "  ; len(outputs) ', outputs        dim as string final_out = ""    for a as longint = 1 to len(outputs) step 2        final_out+=chr(valulng(mid(outputs,a,2)))    next        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='===============================================================================Function decompress_loop( chrs as string ) as string       dim as string final_out = chrs        return final_outend function`
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I've been playing around and trying to write a de-compressor..

There's no way to tell where the stray zeros are located..It can't be de-compressed..
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I got a formula that compresses.

The output bits don't have to be 8 bits , sometimes 9 , 10 or 11 bits or more will compress.

n1 = mid(binari,a,2)
if n1="00" then outputs+="1"
if n1="01" then outputs+="01"
if n1="10" then outputs+="001"
if n1="11" then outputs+="010"

I play around with dodicat's Zlib code. and when i get a formula that compresses , i put it into the test bed.. and try to write a de-compressor..

Here's Dodocat's Zlib code

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 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 = 40print "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 string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) ', binari        dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="1"        if n1="01" then outputs+="01"        if n1="10" then outputs+="001"        if n1="11" then outputs+="010"    next        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 "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string       dim as string final_out = chrs        return final_outend function`

Here's the test bed , where i write the de-compressor

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 8        s+=chr(Int(Rnd*256))'+8)    Next       time1=timer    'begin compress        dim as string comp=s        for a as longint = 1 to 1 step 1            comp = compress_loop(comp)        next    'end compress    time2 = timer       time3=timer    'begin decompress        dim as string final_out = comp        for a as longint = 1 to 1 step 1            final_out = decompress_loop(final_out)        next    'end decompress    time4 = timer      'sleep       'cls    'draw string( 0,10) , left(s,100)    'draw string( 0,30) , left(final_out,100)    print string(99,"=")    print "inp = " ; (s)    print string(99,"=")    print "out = " ; (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       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari        dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="1"        if n1="01" then outputs+="01"        if n1="10" then outputs+="001"        if n1="11" then outputs+="010"    next        print "c bin = "  ; 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 = str(count) + final_out        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string            dim as ubyte count = val(left(chrs,1))        chrs=mid(chrs,2)            dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    dim as ubyte ptr ubp = cptr(ubyte ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 1        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,8)        binari+= n1    next        binari=left(binari,len(binari)-count)        print "d bin = "  ; len(binari) , binari        dim as string final_out = chrs        return final_outend function`

The problem is the a 01 01 could be mistaken for a 010 1