Squares

albert · Post by **albert** » Jul 12, 2019 23:07

@Dodicat

screen 19
do
    dim as long n = int( rnd * 65536 )
    print
    print n , (n mod 256 )  or  (8192 * n \ 8192) 'is calculated in macro
    print n , (8192 * n \ 8192)    ' also = n
    sleep
loop until inkey=chr(27)

I didn't realize it was passing b = "n \ 8192" to the macro , rather than b = " val "

Its passing the "function" to the macro , that's why it wouldn't work with ( b * 8192 ) but works with( 8192 * b)

albert · Post by **albert** » Jul 13, 2019 2:34

@Dodicat

This outputs 6 digits for 5 digit input.. So it might not compress...

I played around with the mods , kept lowering them from 256 , until i got them just low enough , to get the right answer.

Code: Select all


screen 19

dim as longint v1 , v2 , v3
dim as string n , c

dim as longint n1 = 65536

do 
    
        n1-=1
        
        v1 = n1 mod 49
        v2 = n1 mod 50
        v3 = n1 mod 51
        
        print
        print n1 , v1 , v2 , v3
        
        for b as longint = 0 to 65535 step 1
            
            if (b  mod 49) = v1  and (b mod 50) = v2 and (b mod 51) = v3 then print b : exit for
            
        next
        
        if n1 mod 10 = 0 then print "press key for next 10   press esc to exit " : sleep
        
        if inkey = chr(27) then end
        
loop until n1 = 0

sleep
end

dodicat · Post by **dodicat** » Jul 13, 2019 9:55

Kinda reminds me of the Chinese remainder.

Code: Select all

Function HCF(a As Integer, b As Integer) As Integer
    If b=0 Then Return a Else Return HCF(b,a Mod b)
End Function

Function TestPairwiseCoprime(array() As Integer) As Integer
    For p1 As Integer  = Lbound(array) To Ubound(array) - 1
        For p2 As Integer  = p1 + 1 To Ubound(array)
            if array(p1)=1 or array(p2)=1 then print " fails at element 1":return 0
            If HCF(array(p1),array(p2))<>1 Then  print"fails at element", array(p1),array(p2): Return 0 
        Next p2
    Next p1
    Return -1
End Function

Function Cremainder(coprimes() As Integer,remainders() As Integer) As longint
    #macro minv(a1,b1,ans)
    Scope
        Dim As longint a=a1,b=b1
        Dim As longint Cb=b,t,Div
        Dim As longint Starter = 0, Result = 1
        If (b=1) Then return 1
        While (a > 1)
            If b=0 Then Print "No can do":Exit Function
            Div = a\b
            t=b:b=a Mod b:a=t
            t=Starter:Starter=Result-Div*Starter:Result=t
        Wend
        If (Result<0) Then Result+=Cb
        ans=Result
    End Scope
    #endmacro
    Dim As longint p,Product =1,sum=0,ans
    For i as integer =Lbound(coprimes) To Ubound(coprimes):Product*=coprimes(i):Next
        For j as integer=Lbound(coprimes) To Ubound(coprimes)
            p=Product\coprimes(j)
            minv(p,coprimes(j),ans)
            sum+=remainders(j)*ans*p
        Next j
        Return sum Mod Product
    End Function
    
 '=========================================================== 
 
 
 
 dim as longint n1 = 65536
 
 dim as long m1,m2,m3
 
 m1=49
 m2=50
 m3=51

do 
    n1-=1
    
    Dim As Integer mods(1 To ...)       = {m1,m2,m3}
    Dim As Integer remainders(1 To ...) = {n1 mod m1,n1 mod m2,n1 mod m3}
    
    
    if TestPairwisecoprime(mods()) then
    Var ans= Cremainder(mods(),remainders())
   
    print ans ;"  =  ";
    
    for z as integer=lbound(remainders) to ubound(remainders)
        var e=iif(z<>ubound(remainders),",","")
        print ans mod mods(z);e;
    next z
    
    print
   else
       print "ERROR"
    end if
    if n1 mod 10=0 then print "Press a key": Sleep
    loop until inkey=chr(27)

Which does the same without looping.

albert · Post by **albert** » Jul 13, 2019 17:39

@Dodicat

I plugged the code , into your Zlib code. It doesn't compress..
It turns 10,000 bytes into 15,027 and compresses to 10,870..At 1 loop

Back to the drawing board...

Maybe try 4 mods 7, 8 ,9 10. that would be 4 digits out for 5 digits in.

albert · Post by **albert** » Jul 14, 2019 2:17

@Dodicat

How does Zlib compress? What's the formula for the compression?

If i know how it works , then maybe , i can modify the data to be compressible...

if you compress an empty string it returns 17 bytes...and grows by 17 bytes each loop.

00
01
10
11 doesn't compress , it grows by 17 bytes each loop.

00
01
10
001 compresses

00
001
10
11 doesn't compress , it grows by 17 bytes each loop.

caseih · Post by **caseih** » Jul 14, 2019 4:53

Zlib uses the "deflate" compression algorithm, which is actually a combination of a couple of different common compression algorithms. It's well documented if you wish to learn more about it.

albert · Post by **albert** » Jul 14, 2019 20:03

@Dodicat

I got compression.... But it only compress 27% after 40 loops...

Can you have a look at the compress_loop() function at the bottom of the code , to see if i got an error somewhere??

Code: Select all


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


Namespace Zlibrary

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

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


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

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

End Namespace


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

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0 
dim as longint loops = 0
do
    
    loops+=1
    
    'one time run , create initial string 
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible 
        
        s = compress_loop(s)
        
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
    
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
    
    Print "packed string "
    Print Len(compressed)
    Print
    
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
    
    'sleep 1000
    
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
    
    print "press a key for next compression."
    print
    print "press esc to exit."
    sleep
    
    if inkey = chr(27) then exit do
    
loop until loops = 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 binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
    
    dim as string outs1= ""' string(len(binari)\3,"0")
    dim as string outs2= "" 'string(len(binari)\3 , "0")
    dim as longint v
    for a as longint = 1 to len(binari) step 64
        
        n1 = mid(binari,a,64)
        
        v = valulng("&B"+n1)
        
        if v <= (2^63)-1 then outs1+= right(string(63,"0")+bin(v            ),63) : outs2+="0"
        if v >= (2^63)    then outs1+= right(string(63,"0")+bin(v-(2^63)),63) : outs2+="1"
        
    next
    
    print "outs1 = " ; len(outs1)
    print "outs2 = " ; len(outs2)
    
    dim as string final_out = ""
    for a as longint = 1 to len(outs1) step 8
        final_out+=chr(valulng("&B"+mid(outs1,a,8)))
    next
    final_out+="END"
    for a as longint = 1 to len(outs2) step 8
        final_out+=chr(valulng("&B"+mid(outs2,a,8)))
    next
    
    print "c fin  = "  ; len(final_out) ', binari
    
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as string final_out = chrs
    
    return final_out

end function

EDITED -- doesn't compress

albert · Post by **albert** » Jul 15, 2019 17:39

@Dodicat

I got compression without Zlib.... by doing:

0
01
10
11
With a 2 bit map

Can you help figure out the decompression??

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
        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 binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
    
    print "c inp = " ; len(chrs)
    print "c bin = " ; len(binari) , binari
    
    dim as string outs = ""
    dim as string map = ""
    for a as longint = 1 to len(binari) step 4
        
        n1 = mid(binari,a,4)
        
        if n1="0000" then outs+="0"   : map+="00"
        if n1="0001" then outs+="01" : map+="00"
        if n1="0010" then outs+="10" : map+="00"
        if n1="0011" then outs+="11" : map+="00"
        
        if n1="0100" then outs+="0"   : map+="01"
        if n1="0101" then outs+="01" : map+="01"
        if n1="0110" then outs+="10" : map+="01"
        if n1="0111" then outs+="11" : map+="01"
        
        if n1="1000" then outs+="0"   : map+="10"
        if n1="1001" then outs+="01" : map+="10"
        if n1="1010" then outs+="10" : map+="10"
        if n1="1011" then outs+="11" : map+="10"
        
        if n1="1100" then outs+="0"   : map+="11"
        if n1="1101" then outs+="01" : map+="11"
        if n1="1110" then outs+="10" : map+="11"
        if n1="1111" then outs+="11" : map+="11"
    
    next
    
    print "c out = " ; len(outs) , outs
    print "c map = " ; len(map) , map
    
    dim as string final_out = ""
    for a as longint = 1 to len(outs) step 8
        final_out+=chr(valulng("&B"+mid(outs,a,8)))
    next
    for a as longint = 1 to len(map) step 8
        final_out+=chr(valulng("&B"+mid(map,a,8)))
    next
    
    print "c fin  = "  ; len(final_out) ', binari
    
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as string final_out = chrs
    
    return final_out

end function

albert · Post by **albert** » Jul 15, 2019 22:38

@Dodicat

I got compression without Zlib.... by doing:

0
01
10
11
With a 2 bit map

Can you help figure out the decompression?? , I got the decompression started..

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
        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 binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
    
    print "c inp = " ; len(chrs)
    print "c bin = " ; len(binari) , binari
    
    dim as string outs = ""
    dim as string map = ""
    for a as longint = 1 to len(binari) step 4
        
        n1 = mid(binari,a,4)
        
        if n1="0000" then outs+="0"   : map+="00"
        if n1="0001" then outs+="01" : map+="00"
        if n1="0010" then outs+="10" : map+="00"
        if n1="0011" then outs+="11" : map+="00"
        
        if n1="0100" then outs+="0"   : map+="01"
        if n1="0101" then outs+="01" : map+="01"
        if n1="0110" then outs+="10" : map+="01"
        if n1="0111" then outs+="11" : map+="01"
        
        if n1="1000" then outs+="0"   : map+="10"
        if n1="1001" then outs+="01" : map+="10"
        if n1="1010" then outs+="10" : map+="10"
        if n1="1011" then outs+="11" : map+="10"
        
        if n1="1100" then outs+="0"   : map+="11"
        if n1="1101" then outs+="01" : map+="11"
        if n1="1110" then outs+="10" : map+="11"
        if n1="1111" then outs+="11" : map+="11"
    
    next
    
    print "c out = " ; len(outs) , outs
    print "c map = " ; len(map) , map
    
    dim as longint count=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(outs)/8)
        dec1=instr(1,str1,".")
        if dec1<>0 then outs+="0" : count+=1
    loop until dec1=0
        
    dim as string final_out = ""
    for a as longint = 1 to len(outs) step 8
        final_out+=chr(valulng("&B"+mid(outs,a,8)))
    next
    final_out+="END"
    for a as longint = 1 to len(map) step 8
        final_out+=chr(valulng("&B"+mid(map,a,8)))
    next
    
    final_out = str(count) + final_out
    
    print "c fin = "  ; len(final_out) ', binari
    
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as longint count = val(left(chrs,1))
    
    chrs = mid(chrs,2)
    
    dim as longint place = instr(1,chrs,"END")
    
    dim as string chrs_outs  = left(chrs,place-1)
    dim as string chrs_map = mid(chrs,place+3)
    
    dim as string binari_map=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs_map) step 1
        n1 = zeros + bin( chrs_map[a-1] )
        binari_map+=right(n1,8)
    next
    
    dim as string binari_outs=""
    for a as longint = 1 to len(chrs_outs) step 1
        n1 = zeros + bin( chrs_outs[a-1] )
        binari_outs+=right(n1,8)
    next
    
    binari_outs = left(binari_outs,len(binari_outs)-count)
    
    print "d map = " ; len(binari_map) , binari_map
    print "d out = " ; len(binari_outs) , binari_outs
    
        
    
    dim as string final_out = chrs
    
    return final_out

end function

When i posted the above post. it showed 381,683 views , now it's showing 381,948
So there's been 200+views, since i posted.. And no answers as to , how to decompress..

dodicat · Post by **dodicat** » Jul 16, 2019 0:36

Albert
It is quite hard to follow.
You output chrs, but you have only done
chrs = mid(chrs,2)
Everything else in the decompress seems not to alter chrs.

albert · Post by **albert** » Jul 16, 2019 1:29

@Dodicat

chrs = mid(chrs,2) ; in the compressor it adds the count to the beginning of the final_out.

dim as longint place = instr(1,chrs,"END") , the two output strings in the compressor , are separated by "END"

dim as string chrs_outs = left( chrs , place-1 ) , chrs_out = compressor "outs"
dim as string chrs_map = mid( chrs , place+3 ) , chrs_map = compressor "map"

chrs becomes two strings chrs_out and chrs_map , which turn into binary_outs and binari_map

print "d map = " ; len( binari_map ) , binari_map = "c map"
print "d out = " ; len( binari_outs ) , binari_outs = "c out"

binari_map = map in the compressor
binari_out = outs in the compressor

albert · Post by **albert** » Jul 16, 2019 1:55

@Dodicat

I added some explainations , and modified the de-compressor vars to make it easier to follow..

if you run the code , you will see:

c out =
c map =

d map =
d out =

both sets equal each other...

c out is ( in mod 4 ) if ( in mod 4 ) = 0 then outs+="0" else outs+= 2 bits.
It compresses by leaving off a "0" if ( in mod 4 ) = 0

So for the decompression, we need to find the single "0"'s and expand them to "00"
So that "d bin" will equal "c bin"

I got
final_out = chrs
return final_out , as d bin hasn't been created yet. When we get d bin created , then we can do a for next and create the final_out...

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
        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 binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
    
    print "c inp = " ; len(chrs)
    print "c bin = " ; len(binari) , binari
    
    dim as string outs = ""
    dim as string map = ""
    for a as longint = 1 to len(binari) step 4
        
        n1 = mid(binari,a,4)
        
        if n1="0000" then outs+="0"   : map+="00"
        if n1="0001" then outs+="01" : map+="00"
        if n1="0010" then outs+="10" : map+="00"
        if n1="0011" then outs+="11" : map+="00"
        
        if n1="0100" then outs+="0"   : map+="01"
        if n1="0101" then outs+="01" : map+="01"
        if n1="0110" then outs+="10" : map+="01"
        if n1="0111" then outs+="11" : map+="01"
        
        if n1="1000" then outs+="0"   : map+="10"
        if n1="1001" then outs+="01" : map+="10"
        if n1="1010" then outs+="10" : map+="10"
        if n1="1011" then outs+="11" : map+="10"
        
        if n1="1100" then outs+="0"   : map+="11"
        if n1="1101" then outs+="01" : map+="11"
        if n1="1110" then outs+="10" : map+="11"
        if n1="1111" then outs+="11" : map+="11"
    
    next
    
    print "c out = " ; len(outs) , outs
    print "c map = " ; len(map) , map
    
    'make 'outs' an even number of 8 bits for the for naxt loop
    dim as longint count=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(outs)/8)
        dec1=instr(1,str1,".")
        if dec1<>0 then outs+="0" : count+=1
    loop until dec1=0
        
    'turn outs into chrs
    dim as string final_out = ""
    for a as longint = 1 to len(outs) step 8
        final_out+=chr(valulng("&B"+mid(outs,a,8)))
    next
    'add indetifier to isolate two strings
    final_out+="END"
    'turn map into chrs
    for a as longint = 1 to len(map) step 8
        final_out+=chr(valulng("&B"+mid(map,a,8)))
    next
    
    'add count from above to final_out
    final_out = str(count) + final_out
    
    print "c fin = "  ; len(final_out) ', binari
    
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    'pull off count , from front of chrs 
    dim as longint count = val(left(chrs,1))
    
    chrs = mid(chrs,2) ' chrs minus count char
    
    dim as longint place = instr(1,chrs,"END")
    
    dim as string chrs_outs  = left(chrs,place-1)
    dim as string chrs_map = mid(chrs,place+3)
    
    dim as string map=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs_map) step 1
        n1 = zeros + bin( chrs_map[a-1] )
        map+=right(n1,8)
    next
    
    dim as string outs=""
    for a as longint = 1 to len(chrs_outs) step 1
        n1 = zeros + bin( chrs_outs[a-1] )
        outs+=right(n1,8)
    next
    
    outs = left(outs,len(outs)-count) ' take off extra zeros
    
    print "d map = " ; len(map) , map
    print "d out = " ; len(outs) , outs
    
    'we have map , which equals compressor map
    'we have outs , which equals compresspr outs
    
    'now we have to jimmy the outs to coincide with the map
    
    
    dim as string final_out = chrs
    
    return final_out

end function

albert · Post by **albert** » Jul 16, 2019 3:27

** Edited. Please try to keep things on topic, or at least tangentially related. A little off topic is fine, but the content needs fit the tone of the forum. -Imortis **

albert · Post by **albert** » Jul 17, 2019 0:04

@Dodicat
@Richard

I got a formula that compresses.. 72% after 40 loops for 10,000 bytes in..( 2,700 bytes out )
For 1,000,000 bytes in , it compresses to 50,000 bytes, 94%.

Now to 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


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 binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
    
    print "c inp = " ; len(chrs)
    print "c bin = " ; len(binari) ', binari
    
    dim as string outs= ""
    dim as string map= ""
    for a as longint = 1 to len(binari) step 3
        
        n1 = mid(binari,a,3)
        
        if n1="000" then outs+="0" : map+="0"
        if n1="001" then outs+="1" : map+="0"
        if n1="010" then outs+="0" : map+="10"
        if n1="011" then outs+="1" : map+="10"
        
        if n1="100" then outs+="0" : map+="11"
        if n1="101" then outs+="1" : map+="11"
        if n1="110" then outs+="0" : map+="101"
        if n1="111" then outs+="1" : map+="101"
        
    next
    
    print "c out = " ; len(outs) ', outs
    print "c map = " ; len(map) ', map
    
    dim as string final_out = ""
    for a as longint = 1 to len(outs) step 8
        final_out+=chr(valulng("&B"+mid(outs,a,8)))
    next
    for a as longint = 1 to len(map) step 8
        final_out+=chr(valulng("&B"+mid(map,a,8)))
    next
    
    print "c fin  = "  ; len(final_out) ', binari
    
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as string final_out = chrs
    
    return final_out

end function

You can't have a "01" , so it should be easy to locate the single "0"'s , as each map starts with "1".

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 10
        s+=chr(Int(Rnd*256))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp=s
        for a as longint = 1 to 1 step 1
            comp = compress_loop(comp)
        next
    'end compress
    time2 = timer
   
    time3=timer
    'begin decompress
        dim as string final_out = comp
        for a as longint = 1 to 1 step 1
            final_out = decompress_loop(final_out)
        next
    'end decompress
    time4 = timer
   
   'sleep
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    print string(99,"=")
    print "inp = " ; (s)
    print string(99,"=")
    print "out = " ; (final_out)
    print
    print "compress time   = "; time2-time1
    print "decompress time = "; time4-time3
    print
   
    if s = final_out then print "Decompressed OK" else print "Decompression failed."
    print string(99,"=")
    
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
    
    dim as string binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
    
    'we need to make binari and even multiple of 3
    
    print "c inp = " ; len(chrs)
    print "c bin = " ; len(binari) , binari
    
    dim as string outs= ""
    dim as string map= ""
    for a as longint = 1 to len(binari) step 3
        
        n1 = mid(binari,a,3)
        
        if n1="000" then outs+="0" : map+="0"
        if n1="001" then outs+="1" : map+="0"
        
        if n1="010" then outs+="0" : map+="10"
        if n1="011" then outs+="1" : map+="10"
        
        if n1="100" then outs+="0" : map+="11"
        if n1="101" then outs+="1" : map+="11"
        
        if n1="110" then outs+="0" : map+="101"
        if n1="111" then outs+="1" : map+="101"
        
    next
    
    'we need to make outs and map and even multiple of 8
    
    print "c out = " ; len(outs) , outs
    print "c map = " ; len(map) , map
    
    dim as string final_out = ""
    for a as longint = 1 to len(outs) step 8
        final_out+=chr(valulng("&B"+mid(outs,a,8)))
    next
    for a as longint = 1 to len(map) step 8
        final_out+=chr(valulng("&B"+mid(map,a,8)))
    next
    
    print "c fin  = "  ; len(final_out) ', binari
    
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    dim as string final_out = chrs
    
    return final_out

end function

albert · Post by **albert** » Jul 17, 2019 2:11

I'm working on a program called "Time Rhyme"
Where you have a dirty , naughty rhyme for each minute of the day..

There's 12 * 60 rhymes = 720 elements..

How would you turn the time, into 1 of 720 elements?

I don't think i can post it here, the site is prudish and purient..

Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares