## Squares

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

### Re: Squares

@Dodicat

Check this code out...

if "size" = even value , it compresses , odd values 3 , 5 , 7 , 9 , 11, etc.. don't compress but get all 256 correct.

"size" = 10 gets 128 ( 128 to 255 ) correct...

Code: Select all

`screen 19dim as longint count1 = 0 , count2 = 0dim as ubyte n1 , n2 , outs , ans , chk , size = 5 ' adjust size to suit.. odds don't compress but get all 256 correct...for a as longint = 0 to 255 step 1            n2 = a * size                outs = n2                 for b as longint = 0 to 255*size step size            chk = b            if chk = outs then ans = (b \ size )         next                if ans   = a then count1+=1 : print a , n2  , ans , "CORRECT"        if ans <> a then count2+=1 : print a , n2  , ans , "WRONG  "                        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep                if inkey = chr(27) then exit for        nextprint "done..."sleepprint "Got " ; count1 ; " correct , out of ( 0 to 255 ) " printprint "Got " ; count2 ; " wrong , out of ( 0 to 255 ) " sleepend`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard
@Dodicat

I got it working with "size" = 10 ... Getting all 256 values correct... But it doesn't compress..

Code: Select all

`screen 19dim as longint count1 = 0 , count2 = 0dim as ubyte n1 , n2 , outs , ans , chk , size = 10 ' adjust size to suit.. 11 doesn't compress but gets all 256 correctfor a as longint = 0 to 255 step 1            n2 = a * size                if a <= 127 then n1 = 1 else n1 = 0                outs = n2                 for b as longint = 0 to 255*size step size            chk = b            if n1 = 1 then                 if chk = outs then ans = b \ size : exit for            else                if b > 127 * 10 then if chk = outs then ans = (b \ size ) : exit for            end if        next                if ans   = a then count1+=1 : print a , n2  , ans , "CORRECT"        if ans <> a then count2+=1 : print a , n2  , ans , "WRONG  "                        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep                if inkey = chr(27) then exit for        nextprint "done..."sleepprint "Got " ; count1 ; " correct , out of ( 0 to 255 ) " printprint "Got " ; count2 ; " wrong , out of ( 0 to 255 ) " sleepend`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

This one , you can play with , adjusting the "size" var , to what ever you want..

size = 64 , compresses , but only gets 4 correct out of every 64..

Code: Select all

`screen 19dim as longint count1 = 0 , count2 = 0dim as ubyte n1 , n2 , outs , ans , chk , size = 4 ' adjust size to suit.. odd numbers get all 256 correct but don't compress.for a as longint = 0 to 255 step 1            n2 = a * size                if a <=   63 then n1 = 0 : goto done        if a <= 127 then n1 = 1 : goto done        if a <= 191 then n1 = 2 : goto done        if a <= 255 then n1 = 3 : goto done                done:                outs = n2                 if n1 = 0 then            for b as longint = 0 to 63 step 1                chk = b*size                if chk = outs then ans = b : exit for            next        end if                if n1 = 1 then            for b as longint = 64 to 127 step 1                chk = b*size                if chk = outs then ans = b : exit for            next        end if                if n1 = 2 then            for b as longint = 128 to 191 step 1                chk = b*size                if chk = outs then ans = b : exit for            next        end if                if n1 = 3 then            for b as longint = 192 to 255 step 1                chk = b*size                if chk = outs then ans = b : exit for            next        end if                if ans   = a then count1+=1 : print a , n2  , ans , "CORRECT"        if ans <> a then count2+=1 : print a , n2  , ans , "WRONG  "                        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep                if inkey = chr(27) then exit for        nextprint "done..."sleepprint "Got " ; count1 ; " correct , out of ( 0 to 255 ) " printprint "Got " ; count2 ; " wrong , out of ( 0 to 255 ) " sleepend`
Knatterton
Posts: 157
Joined: Apr 19, 2019 19:03

### Re: Squares

Albert, i want to thank you for all the joy you bring us through your programming work with a song:

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

### Re: Squares

@Dodicat

I think i finally got compression.... It uses val * 64 ...

val * 64 can equal 0 , 64 , 128 , 192. only 4 values. and ( 255 \ ( 256\64 ) ) = 63 values...So it only uses 67 bytes out of 256..

Now to write the de-compressor.....

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." ; " loops = " ; loops ; " out of 40."     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 outputs=""    dim as ubyte n1 , n2    for a as longint = 0 to  len(chrs)-1 step 1                n1 = chrs[a]        n2 = chrs[a]                n1*= 64                if n1 =      0 then outputs+="0"        if n1 =    64 then outputs+="1"        if n1 = 128 then outputs+="2"        if n1 = 192 then outputs+="3"                outputs+=right("00"+str(n2\(256\64)),2)            next        dim as string final_out=""    for a as longint = 1 to len(outputs) step 3        final_out+=chr(val("&O"+mid(outputs,a,3)))    next        return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        return chrsend function`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

outputs+=right("00"+str(n2\(256\64)),2) ' 0 to 63 , the highest is 363 which is less and then (oct 377 = 255).

final_out+=chr(val("&O"+mid(outputs,a,3))) ' using oct , converts the last 2 digits to oct , how to reverse it ?

Code: Select all

`Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1 , time2 , time3 , time4do       randomize       dim as string s=""    For n As Long = 1 To 10        s+=chr(Int(Rnd*256))'+8)    Next       time1=timer    'begin compress        dim as string comp = s        'do        '    dim as longint chk = len(comp) - 1        '    comp = compress_loop(comp)        '    if len(comp) >= chk then exit do        'loop               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."    print string(99,"=")       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string        dim as string outputs=""    dim as ubyte n1 , n2    for a as longint = 0 to  len(chrs)-1 step 1                n1 = chrs[a]        n2 = chrs[a]                n1*= 64                if n1 =      0 then outputs+="0"        if n1 =    64 then outputs+="1"        if n1 = 128 then outputs+="2"        if n1 = 192 then outputs+="3"                outputs+=right("00"+str(n2\(256\64)),2) ' 0 to 63 , the highest is 363 which is less and then (oct 377 = 255).            next        print "c out = " ; len(outputs) , outputs        dim as string final_out=""    for a as longint = 1 to len(outputs) step 3        final_out+=chr(val("&O"+mid(outputs,a,3)))  ' using oct , converts the last 2 digits to oct , how to reverse it ?     next        return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        dim as string octs=""    dim as ubyte n1 , n2 , ans    for a as longint = 0 to  len(chrs)-1 step 1                octs+= right("000"+str(chrs[a]),3)            next        print "d out = " ; len(octs) , octs        return chrsend function`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard
@Dodicat

Can one of you guys figure this one out?? Need help reversing the formula..

It's a little confusing...

Code: Select all

`screen 19dim as longint count1 = 0 , count2 = 0dim as ubyte n1 , ans , size = 4for a as longint = 0 to 255 step 1            n1 = a * size                if a <= 063 then n1+= 0 : goto done        if a <= 127 then n1+= 1 : goto done        if a <= 191 then n1+= 3 : goto done        if a <= 255 then n1+= 5 : goto done                done:                ' Try to get the right answer..??        if (n1-5) mod 4 = 0 then ans = ( (n1-5) \ size ) + 192 : goto ends        if (n1-3) mod 4 = 0 then ans = ( (n1-3) \ size ) + 128 : goto ends        if (n1-1) mod 4 = 0 then ans = ( (n1-1) \ size ) + 064 : goto ends        if (n1-0) mod 4 = 0 then ans = ( (n1-0) \ size ) + 000 : goto ends                ends:                if ans   = a then count1+=1 : print a , n1 , ans ,  "CORRECT"        if ans <> a then count2+=1 : print a , n1 , ans ,  "WRONG  "                        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep                if inkey = chr(27) then exit for        nextprint "done..."sleepprint "Got " ; count1 ; " correct , out of ( 0 to 255 ) " printprint "Got " ; count2 ; " wrong , out of ( 0 to 255 ) " sleepend`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

if n2 <= 063 then n1+= 0 : goto done
if n2 <= 127 then n1+= 1 : goto done
if n2 <= 191 then n1+= 2 : goto done
if n2 <= 255 then n1+= 3 : goto done

Returns all 256 correct , but it doesn't compress..
0 , 1, 3 , 5 , compresses , but i can't figure out how to undo it...

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." ; " loops = " ; loops ; " out of 40."     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 outs=""    dim as ubyte n1 , n2    dim as ubyte ptr ubp = cptr(ubyte ptr,strptr(chrs))    for a as longint = 1 to  len(chrs) step 1                n1 = (*ubp) * 4                n2 = *ubp                if n2 <= 063 then n1+= 0 : goto done        if n2 <= 127 then n1+= 1 : goto done        if n2 <= 191 then n1+= 2: goto done        if n2 <= 255 then n1+= 3: goto done                done:            *ubp = n1                ubp+=1            next        return chrs       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        dim as ubyte n1 , ans , size = 4    dim as ubyte ptr ubp = cptr(ubyte ptr,strptr(chrs))    for a as longint = 1 to  len(chrs) step 1                n1 = *ubp                if (n1-3) mod 4 = 0 then ans = ( (n1-3) \ size ) + 192 : goto ends        if (n1-2) mod 4 = 0 then ans = ( (n1-2) \ size ) + 128 : goto ends        if (n1-1) mod 4 = 0 then ans = ( (n1-1) \ size ) + 064 : goto ends        if (n1-0) mod 4 = 0 then ans = ( (n1-0) \ size ) + 000 : goto ends               ends:                *ubp = ans                ubp+=1        next        return chrsend function`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I thought up a way to compress random data..

You turn the random data , into a "formula" , that will recreate the random data..
I don't think the formula will exceed to size of the random data...

I'll start working on formulas.

Can you post your "factor solving code" ??
I'll start ; by seeing if the factors , are larger than the input data..

maybe stepping by 8's using a ulongint ptr.. and solving the factors..
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Hi Albert.
A little play around.

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 Namespacerandomizedim as string s="abcdefghijkXXXmnopqrstuvwxAAAyz0123456789ubfurt5433qwertyuiopasdfghjklCCCzxcvbnmlkjhugt"for n as long=1 to 10    s+=snextfor n as long=0 to 5000 'add some randoms    s+=chr(rnd*255)nextvar L=len(s)for n as long=1 to 10000  'shuffle everything    swap s[rnd*L],s[rnd*L]    next        function compress(byval s as string) as string    dim as string start=chr(s[0])    for i as long=1 to len(s)-1        var t=str(s[i]-s[i-1])        if instr(t,"-")=0  then t="+"+t        start=start+t     next i      return start    end function        function decompress(byval s as string) as string        dim as string start=chr(s[0])        dim as long k         s=ltrim(s,chr(s[0]))        for i as long=1 to len(s)-1            var t=valint(s)            if t<0 then k=1 else k=2            var L=len(str(t))+k            s=mid(s,L)            start+=chr(start[i-1]+t)             if s="" then exit for            next i        return start    end function        print "original  ";len(s)    var c= compress(s)    var c2=zlibrary.pack(c)    print "Packed    ";len(c2)    var c3=zlibrary.unpack(c2)    var c4=decompress(c3)    print c4=s;" check return"    print "Done"    sleep      `
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Using less than 256 chars in a string ,almost always compresses....
It's when you use all 256 chars it doesn't compress..

I'm trying to compress a string that has all 256 chars in it..

========================================================================
I though of an idea!!

On screen 19 you can plot 100 digits..

You print out the number , and start at a distance , and draw lines to the different numbers.
Lines to all the 0's , 1's , 2's ,,,, 9's , And use ten trig formulas , to draw the lines to the numbers...Or record the angles to the numbers

The 10 trig formulas might be less than 100 bytes. You can skip one number ; maybe zero...
=======================================================================
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Check this one out.... Compresses 90+% after 40 loops.

See: compress_loop()

Here it is in your 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." ; " loops = " ; loops ; " out of 40."     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 outs1=""    dim as string zeros = string(20,"0")     dim as ulongint n1    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = *ulp : ulp+=1        outs1+=right( zeros + str(n1),20)    next        dim as string outputs=""    dim as string num    for a as longint = 1 to len(outs1) step 1                num = bin(val(mid(outs1,a,1)))                dim as longint count = 0        for b as longint = 0 to len(num)-1 step 1                        if num[b] = 48 then outputs+=str(len(num)-b) : count = 1                    next                if count = 0 then outputs+= "~"            next        return outputs       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        return chrsend 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        'do        '    dim as longint chk = len(comp) - 1        '    comp = compress_loop(comp)        '    if len(comp) >= chk then exit do        'loop               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."    print string(99,"=")       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string        dim as string outs1=""    dim as string zeros = string(20,"0")     dim as ulongint n1    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = *ulp : ulp+=1        outs1+=right( zeros + str(n1),20)    next        dim as string outputs=""    dim as string num    for a as longint = 1 to len(outs1) step 1                num = bin(val(mid(outs1,a,1)))                dim as longint count = 0        for b as longint = 0 to len(num)-1 step 1                        if num[b] = 48 then outputs+=str(len(num)-b) : count = 1                    next                if count = 0 then outputs+= "~"            next        print "c inp = " ; bin(valulng(outs1))    print "c out = " ; outputs            return outputs       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        return chrsend function`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I finally got it this time... Achieved the impossible!!!!

See: compress_loop()

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." ; " loops = " ; loops ; " out of 40."     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 outs1=""    dim as string zeros = string(22,"0")     dim as ulongint n1    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = *ulp : ulp+=1        outs1+=right( zeros + oct(n1),22)    next        dim as string outputs=""    dim as string num    for a as longint = 1 to len(outs1) step 1                'num = right(string(4,"0") + bin(val("&O"+oct(val(mid(outs1,a,1))))),4)                num = mid(outs1,a,1)        num = bin(val(num))        num = right("000" + num,3)        dim as longint count=0        for b as longint = 0 to len(num)-1 step 1                        if num[b] = 49 then outputs+=right("00"+bin(2-b),2) : count=1                    next               if count = 0 then outputs+="11"           next        dim as string final=""    for a as longint = 1 to len(outputs) step 8        final+=chr(val("&B"+mid(outputs,a,8)))    next            return final       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        return chrsend function`
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Now I got to speed it up...It takes like 5 minutes , to compress a megabyte..
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Got the speed doubled.. But it's still too slow..

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." ; " loops = " ; loops ; " out of 40."     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 outs1=""    dim as string zeros = string(64,"0")     dim as ulongint n1    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = *ulp : ulp+=1        outs1+=right( zeros + bin(n1),64)    next        dim as string outputs=""    dim as string num    for a as longint = 1 to len(outs1) step 3                num = mid(outs1,a,3)                if num = "000" then outputs+="11"  ' all 0's        if num = "001" then outputs+="00"  ' bit 1 set         if num = "010" then outputs+="01"   'bit2 set         if num = "011" then outputs+="0100" ' bits 2 and 1 set        if num = "100" then outputs+="10"      ' bit 3 set        if num = "101" then outputs+="1000"  ' bits 3 and 1 set        if num = "110" then outputs+="1001"   ' bits 3 and 2 set         if num = "111" then outputs+="100100" ' bits 3 2 1 set            next        dim as string final=""    for a as longint = 1 to len(outputs) step 8        final+=chr(val("&B"+mid(outputs,a,8)))    next            return final       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        return chrsend function`

EDITED!!!