Squares

[albert]

@Dodicat

I got it working,,, I used a quadranary system on the output , so now we can step by 4 digits..

Since it only uses 0 , 1 , 2 , 3 .... 3333 the highest number possible = 255 = 11 11 11 11.

Compresses 10,000 70% after 40 loops...

Now ; it's just finding the stray 1's and 3's...

Here's you Zlib code..

Code: Select all

Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

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

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    print "c inp =  "; len(bytes) ', bytes
    
    dim as longint count1=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(bytes)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then bytes = "0" + bytes : count1+=1
    loop until dec1=0
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 3
        
        bits = mid(bytes,a,3)
        
        if bits = "000" then outputs+="0"
        if bits = "001" then outputs+="1"
        if bits = "010" then outputs+="12"
        if bits = "011" then outputs+="21"
        
        if bits = "100" then outputs+="22"
        if bits = "101" then outputs+="23"
        if bits = "110" then outputs+="32"
        if bits = "111" then outputs+="3"
    
    next
    
    print "c out =  "; len(outputs) ', outputs
    
    dim as longint count2=0
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right("00" + bin(val(mid(b,1,1))),2)
        num+=right("00" + bin(val(mid(b,2,1))),2)
        num+=right("00" + bin(val(mid(b,3,1))),2)
        num+=right("00" + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count1) + chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count1 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    return chrs

end function

Here's the test bed code, where i try to write the de-compressor... Just to find the single 1's and 3's

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    dim as longint count1=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(bytes)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then bytes = "0" + bytes : count1+=1
    loop until dec1=0
        
    print "c inp =  "; len(bytes) , bytes

    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 3
        
        bits = mid(bytes,a,3)
        
        if bits = "000" then outputs+="0"
        if bits = "001" then outputs+="1"
        if bits = "010" then outputs+="12"
        if bits = "011" then outputs+="21"
        
        if bits = "100" then outputs+="22"
        if bits = "101" then outputs+="23"
        if bits = "110" then outputs+="32"
        if bits = "111" then outputs+="3"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right("00" + bin(val(mid(b,1,1))),2)
        num+=right("00" + bin(val(mid(b,2,1))),2)
        num+=right("00" + bin(val(mid(b,3,1))),2)
        num+=right("00" + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count1) + chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count1 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal
    
    'Need to find stray 1's and 3's
       
    
    'need to create output...
    return chrs

end function

[albert]

@Dodicat

I redid it to get rid of the 1-2 , combo, it still compresses...

bits = mid(bytes,a,3)

if bits = "000" then outputs+="0"
if bits = "001" then outputs+="1"
if bits = "010" then outputs+="20"
if bits = "011" then outputs+="21"

if bits = "100" then outputs+="22"
if bits = "101" then outputs+="23"
if bits = "110" then outputs+="32"
if bits = "111" then outputs+="3"

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

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    dim as longint count1=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(bytes)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then bytes = "0" + bytes : count1+=1
    loop until dec1=0
    
    print "c inp =  "; len(bytes) , bytes
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 3
        
        bits = mid(bytes,a,3)
        
        if bits = "000" then outputs+="0"
        if bits = "001" then outputs+="1"
        if bits = "010" then outputs+="20"
        if bits = "011" then outputs+="21"
        
        if bits = "100" then outputs+="22"
        if bits = "101" then outputs+="23"
        if bits = "110" then outputs+="32"
        if bits = "111" then outputs+="3"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right("00" + bin(val(mid(b,1,1))),2)
        num+=right("00" + bin(val(mid(b,2,1))),2)
        num+=right("00" + bin(val(mid(b,3,1))),2)
        num+=right("00" + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count1) + chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count1 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal
    
    dim as string s
    for a as longint = 1 to len(octal) step 1
        s = mid(octal,a,1)
        if s="0" then print " 0 " ;  : goto done
        if s="1" then print " 1 " ;  : goto done
        if s="3" then print " 3 " ;  : goto done
        
        print s ;
        
        done:
    next
    print
    
    
    'Need to find stray 1's and 3's
       
    
    'need to create output...
    return chrs

end function

[albert]

@Dodicat

I'm close... Sometimes getting a stray "2"...

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    dim as longint count1=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(bytes)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then bytes = "0" + bytes : count1+=1
    loop until dec1=0
    
    print "c inp =  "; len(bytes) , bytes
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 3
        
        bits = mid(bytes,a,3)
        
        if bits = "000" then outputs+="0"
        if bits = "001" then outputs+="1"
        if bits = "010" then outputs+="20"
        if bits = "011" then outputs+="21"
        
        if bits = "100" then outputs+="22"
        if bits = "101" then outputs+="23"
        if bits = "110" then outputs+="32"
        if bits = "111" then outputs+="3"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right("00" + bin(val(mid(b,1,1))),2)
        num+=right("00" + bin(val(mid(b,2,1))),2)
        num+=right("00" + bin(val(mid(b,3,1))),2)
        num+=right("00" + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count1) + chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count1 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal
    
    
    'try to search for numbers..
    
    dim as longint place=0
    
    dim as string _22 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"22")
        mid(_22,place,2) = "22"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 22 = " , _22
   
    dim as string _20 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"20")
        mid(_20,place,2) = "20"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 20 = " , _20
    
    dim as string _21 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"21")
        mid(_21,place,2) = "21"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 21 = " , _21

    dim as string _32 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"32")
        mid(_32,place,2) = "32"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 32 = " , _32
    
    dim as string _23 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"23")
        mid(_23,place,2) = "23"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 23 = " , _23
    
    print
    print "d out= " , octal
    
    
    'Need to find stray 1's and 3's
       
    
    'need to create output...
    return chrs

end function

[albert]

@Dodicat

I think i finally got it....

if bits = "000" then outputs+="0"
if bits = "001" then outputs+="1"
if bits = "010" then outputs+="2"
if bits = "011" then outputs+="3"

if bits = "100" then outputs+="20"
if bits = "101" then outputs+="30"
if bits = "110" then outputs+="21"
if bits = "111" then outputs+="31"

Seems to work....Compresses 80% after 100 loops.

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    dim as longint count1=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(bytes)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then bytes = "0" + bytes : count1+=1
    loop until dec1=0
    
    print "c inp =  "; len(bytes) , bytes
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 3
        
        bits = mid(bytes,a,3)
        
        if bits = "000" then outputs+="0"
        if bits = "001" then outputs+="1"
        if bits = "010" then outputs+="2"
        if bits = "011" then outputs+="3"
        
        if bits = "100" then outputs+="20"
        if bits = "101" then outputs+="30"
        if bits = "110" then outputs+="21"
        if bits = "111" then outputs+="31"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right("00" + bin(val(mid(b,1,1))),2)
        num+=right("00" + bin(val(mid(b,2,1))),2)
        num+=right("00" + bin(val(mid(b,3,1))),2)
        num+=right("00" + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count1) + chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count1 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal
    

        'if bits = "000" then outputs+="0"
        'if bits = "001" then outputs+="1"
        'if bits = "010" then outputs+="2"
        'if bits = "011" then outputs+="3"
        
        'if bits = "100" then outputs+="20"
        'if bits = "101" then outputs+="30"
        'if bits = "110" then outputs+="21"
        'if bits = "111" then outputs+="31"

    'try to search for numbers..
    
    dim as longint place=0
    
    dim as string _20 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"20")
        mid(_20,place,2) = "20"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 20 = " , _20
   
    dim as string _30 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"30")
        mid(_30,place,2) = "30"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 30 = " , _30
    
    dim as string _21 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"21")
        mid(_21,place,2) = "21"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 21 = " , _21

    dim as string _31 = string(len(octal) , "0")
    place=0
    do
        place = instr(place+1,octal,"31")
        mid(_31,place,2) = "31"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 31 = " , _31
    
    print
    print "d out= " , octal
    
    
    'need to create output...
    return chrs

end function

[albert]

@Dodicat

I redid the number search , in the de-compressor ... To make it easier to see..

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    dim as longint count1=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(bytes)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then bytes = "0" + bytes : count1+=1
    loop until dec1=0
    
    print "c inp =  "; len(bytes) , bytes
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 3
        
        bits = mid(bytes,a,3)
        
        if bits = "000" then outputs+="0"
        if bits = "001" then outputs+="1"
        if bits = "010" then outputs+="2"
        if bits = "011" then outputs+="3"
        
        if bits = "100" then outputs+="20"
        if bits = "101" then outputs+="30"
        if bits = "110" then outputs+="21"
        if bits = "111" then outputs+="31"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right("00" + bin(val(mid(b,1,1))),2)
        num+=right("00" + bin(val(mid(b,2,1))),2)
        num+=right("00" + bin(val(mid(b,3,1))),2)
        num+=right("00" + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count1) + chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count1 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal

        'if bits = "000" then outputs+="0"
        'if bits = "001" then outputs+="1"
        'if bits = "010" then outputs+="2"
        'if bits = "011" then outputs+="3"
        
        'if bits = "100" then outputs+="20"
        'if bits = "101" then outputs+="30"
        'if bits = "110" then outputs+="21"
        'if bits = "111" then outputs+="31"

    'try to search for numbers..
    
    dim as longint place=0
    
    dim as string _20 = string(len(octal) , "-")
    place=0
    do
        place = instr(place+1,octal,"20")
        mid(_20,place,2) = "20"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 20 = " , _20
   
    dim as string _30 = string(len(octal) , "-")
    place=0
    do
        place = instr(place+1,octal,"30")
        mid(_30,place,2) = "30"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 30 = " , _30
    
    dim as string _21 = string(len(octal) , "-")
    place=0
    do
        place = instr(place+1,octal,"21")
        mid(_21,place,2) = "21"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 21 = " , _21

    dim as string _31 = string(len(octal) , "-")
    place=0
    do
        place = instr(place+1,octal,"31")
        mid(_31,place,2) = "31"
        mid(octal,place,2) = "--"
    loop until place=0
    print "d 31 = " , _31
    
    print
    print "d out= " , octal
    
    
    'Need to find stray 1's and 3's
       
    
    'need to create output...
    return chrs

end function

[albert]

@Dodicat

Trying to find the stray 3's in this one.. compresses 90+% after 100 loops.

Spirits told me to step by 4's , so i did..

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    print "c inp =  "; len(bytes) , bytes
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 4
        
        bits = mid(bytes,a,4)
        
        if bits = "0000" then outputs+="00"
        if bits = "0001" then outputs+="01"
        if bits = "0010" then outputs+="02"
        if bits = "0011" then outputs+="03"
        
        if bits = "0100" then outputs+="10"
        if bits = "0101" then outputs+="11"
        if bits = "0110" then outputs+="12"
        if bits = "0111" then outputs+="13"
        
        if bits = "1000" then outputs+="20"
        if bits = "1001" then outputs+="21"
        if bits = "1010" then outputs+="22"
        if bits = "1011" then outputs+="23"
        
        if bits = "1100" then outputs+="3"
        if bits = "1101" then outputs+="30"
        if bits = "1110" then outputs+="31"
        if bits = "1111" then outputs+="32"
        
        'if bits = "000" then outputs+="0"
        'if bits = "001" then outputs+="1"
        'if bits = "010" then outputs+="2"
        'if bits = "011" then outputs+="3"
        
        'if bits = "100" then outputs+="20"
        'if bits = "101" then outputs+="30"
        'if bits = "110" then outputs+="21"
        'if bits = "111" then outputs+="31"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    zeros="00"
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right(zeros + bin(val(mid(b,1,1))),2)
        num+=right(zeros + bin(val(mid(b,2,1))),2)
        num+=right(zeros + bin(val(mid(b,3,1))),2)
        num+=right(zeros + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal
    
    print "d prt =  " ;  " " ,
    for a as longint = 1 to len(octal) step 2
            print " " ; mid(octal,a,2) + " " ;
    next
    print
        
    
    
    'Need to find stray 3's
       
    
    'need to create output...
    return chrs

end function

[albert]

@Dodicat

Any ideas about finding the stray 3's ???

Code: Select all

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 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)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    print "c inp =  "; len(bytes) , bytes
    
    dim as string outputs=""
    dim as string bits
    for a as longint = 1 to len(bytes) step 4
        
        bits = mid(bytes,a,4)
        
        if bits = "0000" then outputs+="00"
        if bits = "0001" then outputs+="01"
        if bits = "0010" then outputs+="02"
        if bits = "0011" then outputs+="03"
        
        if bits = "0100" then outputs+="10"
        if bits = "0101" then outputs+="11"
        if bits = "0110" then outputs+="12"
        if bits = "0111" then outputs+="13"
        
        if bits = "1000" then outputs+="20"
        if bits = "1001" then outputs+="21"
        if bits = "1010" then outputs+="22"
        if bits = "1011" then outputs+="23"
        
        if bits = "1100" then outputs+="3"
        if bits = "1101" then outputs+="30"
        if bits = "1110" then outputs+="31"
        if bits = "1111" then outputs+="32"
        
        'if bits = "000" then outputs+="0"
        'if bits = "001" then outputs+="1"
        'if bits = "010" then outputs+="2"
        'if bits = "011" then outputs+="3"
        
        'if bits = "100" then outputs+="20"
        'if bits = "101" then outputs+="30"
        'if bits = "110" then outputs+="21"
        'if bits = "111" then outputs+="31"
    
    next
    
    print "c out =  "; len(outputs) , outputs
    
    dim as longint count2=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(outputs)/4)
        dec1=instr(1,str1,".")
        if dec1<>0 then outputs+="0" : count2+=1
    loop until dec1=0
    
    dim as string final=""
    dim as string b , num
    zeros="00"
    for a as longint = 1 to len(outputs) step 4
        
        b = mid(outputs,a,4)
        
        num=""
        num+=right(zeros + bin(val(mid(b,1,1))),2)
        num+=right(zeros + bin(val(mid(b,2,1))),2)
        num+=right(zeros + bin(val(mid(b,3,1))),2)
        num+=right(zeros + bin(val(mid(b,4,1))),2)
        
        final+=chr(val("&B"+num))
    
    next
    
    print "c fin =  "; len(final) ' , final
    
    final = chr(count2) + final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count2 = asc(left(chrs,1))
    chrs = mid(chrs,2)
    
    dim as string bytes=""
    dim as ulongint n1
    for a as longint = 0 to len(chrs)-1 step 1
        n1 = chrs[a]
        bytes+=right("00000000"+bin(n1),8)
    next
    
    dim as string octal=""
    for a as longint = 1 to len(bytes) step 2
        octal+=str(val("&B"+mid(bytes,a,2)))
    next   
    
    octal = left(octal,len(octal)-count2)
    
    print "d inp =  "; len(octal) , octal
    
    dim as string _3 = string(len(octal) ,"-")
    dim as string oc = string (len(octal),"-")
    for a as longint = 1 to len(octal) step 1
        if mid(octal,a,1) = "3" then mid(_3,a,1) = "3" else mid(oc,a,1) = mid(octal,a,1)
    next
    
    print
    print "c out = " , oc
    print "c _3 = " , _3
        
    
    'Need to find stray 3's
       
    
    'need to create output...
    return chrs

end function

[albert]

It sounds easy, but in practice , it's nearly impossible to accomplish..
I'll have to think up a new formula..

[albert]

@Dodicat

I'm learning how the Zlib works..

Go down to compress_loop() and set num[ ? ] = 48 and it compresses...You can set any bit to 48 , "0" and it compresses...

If you invert a bit , it expands...but set a bit to 0 and it compresses....

Code: Select all

Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

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

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string bytes=""
    dim as string zeros=string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *usp : usp+=1
        bytes+=right(zeros+bin(n1),64)
    next
    
    print "c inp =  "; len(bytes) ', bytes
    print
    
    dim as string outputs=""
    dim as string num
    for a as longint = 1 to len(bytes) step 8
        
        num = mid(bytes,a,8)
        
        num[0] = 48
        
        outputs+= num
        
    next
    
    print
    print "c out =  "; len(outputs) ', outputs
    
    dim as string final=""
    for a as longint = 1 to len(outputs) step 8
        final+=chr(val("&B"+mid(outputs,a,8)))
    next
    
    print "c fin =  "; len(final) ' , final
    
    return final
    
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string

    return chrs

end function

[albert]

Why does the program quit when you divide by zero ???

If you have a cake , and divide it zero times , you got the whole cake. Dividing by zero should return the number...

If you split the cake 1 time , you got 2 pieces.
If you split the cake 2 times , you got 3 pieces.
If you split the cake 3 times , you got 4 pieces.
If you split the cake 4 times , you got 5 pieces.

1 divided by a number should return 1 plus the division.
2 divided by a number should return 2 plus the division.
3 divided by a number should return 3 plus the division.
etc...

If you have two cakes , and make 1 slice , then you got 3 pieces.. so 2 divided by 1 = 3 : 2 plus the division.

Call it "logical" division... return the number of pieces after the division..

[albert]

Works the same way with multiply..

if you have 1 bunny and it multiplies 1 time then you have two bunnies.

1 multiplied by any number is 1 plus the multiplier..

if you have two bunnies and you multiply 0 times then you have 2 bunnies.
if you have two bunnies and you multiply 1 times then you have 4 bunnies.
if you have two bunnies and you multiply 2 times then you have 6 bunnies.

2 multiplied by any number is 2 plus the multiplier * 2..

3 multiplied by any number is 3 plus the multiplier * 3..
4 multiplied by any number is 4 plus the multiplier * 4..
etc...

[dodicat]

Hi Albert.
I have been busy messing around with sorts.
Dividing by zero is not allowed in maths because the answer is infinity.
If you divide by nearly zero
1/.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
you get
100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000

The language of maths is not necessarily the same as the language of speech.
You just have to follow the rules of maths because that is all maths is - rules.

[BasicCoder2]

The language of maths is not necessarily the same as the language of speech.
You just have to follow the rules of maths because that is all maths is - rules.

Sorry I would have to disagree with that from what I have read.
Some people can go far with a good memory but they may lack understanding and the ability to create.
In one experiment they taught the rules for solving a type topology problem to one set of students but for another set of students they explained why the rules worked (understanding not just memory). Later they gave the students another kind of topology problem to solve. Guess which set of students had the most success. I remember asking a friend who had done engineering to explain calculus to me. He showed me how to solve some problems with it. I asked how it worked. He didn't know. He had been programmed like a computer to solve certain problems following a set of rules.

It may be true that we all vary with regards to having an ability to form abstract concepts from the real world which is what I understand is what is required to understand mathematical rules as opposed to just following them.

https://mathgeekmama.com/math-myths-deb ... -memorize/

[dodicat]

In mathematics Analysis is the branch dealing with concepts.
Maths is broken down into branches, calculus, co-ordinate geometry, numerical analyses . . .
Most of it is used in an applied manner.

A while back in the UK they decided to drop the times tables.
Instead they decided to teach kids concepts.
They were teaching things like long division conceptually.
BODMAS was dropped.
no more things like

Code: Select all

    
      46.0
      ________
1234 |567890
      4936xx
       7429
       7404
         250
                
                e.t.c. e.t.c.

But some conceptual crap that I forget (and every child forgot)
They had to go back to the rote learning of the tables and the rules of arihmetic.
I would prefer to just know the rules and get a job done.
But of course that is just my opinion.

[BasicCoder2]

But some conceptual crap that I forget (and every child forgot)
They had to go back to the rote learning of the tables and the rules of arithmetic.
I would prefer to just know the rules and get a job done.
But of course that is just my opinion.

And for a practical use of math that makes sense. Understanding why a rule works is harder than simply using the rule. If you don't have a rule then you can't solve the problem. Instead you have to wait until someone who does understand the concepts, or can form new concepts, to work a rule out for you. The people who work out the rules are also doing math. In fact I would say they are doing math while the rest of us are just using math much as we might use a function or library in a program without knowing how it works. That is all I meant by math is more than just learning rules.