Squares

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

Yah-Zip

Postby albert » May 03, 2020 23:48

@Dodicat
@angros47

I think I've got it this time....

Compresses 100,000 by 16% after 100 loops...
Compresses 1,000,000 by 68% after 100 loops...
Compresses 10,000,000 by 73% after 100 loops... Takes like 1300 seconds..

===============================================
n1 = bin( *ubp ) : ubp+= 1

s1 = len( n1 ) / 2

if frac( s1 ) > 0 then s1+= .5

if s1 mod 2 = 1 then outs3+= "1" else outs3+= "0"

outs1+= hex( val( "&B" + left( n1 , s1 ) ) )
outs2+= mid( n1 , s1 + 1 )
===============================================

To decompress:
You convert outs1 hex , back into binary.
Then if outs3 = "0" then you know that outs2 bin , is the same length
Then if outs3 = "1" then you know that outs2 bin , is one bit less..

If hex outs1 = 0 or 1 and outs3 = "1" then you know not to bring in a outs2 bin...

Here's Dodicat's Zlib code , doing the compression.

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A


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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        randomize
        s = space( 100000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        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 esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100

time2 = timer

print
print  "Compress time = " ; time2 - time1
print
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
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as string outs3 = ""
    dim as string n1 , n2 , n3
    dim as longint v1 , v2
    dim as single s1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = bin( *ubp ) : ubp+= 1
       
        s1 = len( n1 ) / 2
       
        if frac( s1 ) > 0 then s1+= .5
       
        if s1 mod 2 = 1 then outs3+= "1" else outs3+= "0"
       
        outs1+= hex( val( "&B" + left( n1 , s1 ) ) )
        outs2+= mid( n1 , s1 + 1 )
       
        'print
        'print n1
        'print outs2
        'print outs1
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = " ; len( outs1 ) ' , outs1
   
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 2
        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( outs3 ) step 8
        final+= chr( val( "&B" + mid( outs3 , a , 8 ) ) )
    next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )
   
    return chrs
   
end function

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

Yah-Zip ( Test Bed )

Postby albert » May 04, 2020 17:48

@Dodicat

I got the decompression started... Need some help with it...

I got the decompression strings , equaling the compression strings..

===============================================
n1 = bin( *ubp ) : ubp+= 1

s1 = len( n1 ) / 2

if frac( s1 ) > 0 then s1+= .5

if s1 mod 2 = 1 then outs3+= "1" else outs3+= "0"

outs1+= hex( val( "&B" + left( n1 , s1 ) ) )
outs2+= mid( n1 , s1 + 1 )
===============================================

To decompress:
You convert outs1 hex , back into binary.
Then if outs3 = "0" then you know that outs2 bin , is the same length
Then if outs3 = "1" then you know that outs2 bin , is one bit less..

If hex outs1 = 0 or 1 and outs3 = "1" then you know not to bring in a outs2 bin...
=============================================================


Here's the "Test Bed" , where i write 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
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
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))
    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
            '    if inkey = chr( 27 ) then end
            '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
   
    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
'===============================================================================
'===============================================================================
'compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits = ""
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as string outs3 = ""
    dim as string n1 , n2 , n3
    dim as longint v1 , v2
    dim as single s1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = bin( *ubp ) : ubp+= 1
       
        s1 = len( n1 ) / 2
       
        if frac( s1 ) > 0 then s1+= .5
       
        if s1 mod 2 = 1 then outs3+= "1" else outs3+= "0"
       
        outs1+= hex( val( "&B" + left( n1 , s1 ) ) )
        outs2+= mid( n1 , s1 + 1 )
       
        bits+= right( "00000000" + n1 , 8 )
       
        'print
        'print n1
        'print outs2
        'print outs1
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c bin = " ; len( bits )  , bits
    print
    print "c out = " ; len( outs1 )  , outs1
    print "c out = " ; len( outs2 )  , outs2
    print "c out = " ; len( outs3 )  , outs3
   
    dim as ubyte count = 0
    dim as string str1
    dim as ubyte dec1
    do
        str1 = str( len( outs2 ) / 8 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0 then outs2+= "0" : count+= 1
    loop until dec1 = 0
   
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 2
        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( outs3 ) step 8
        final+= chr( val( "&B" + mid( outs3 , a , 8 ) ) )
    next
   
    final = chr( count ) + final
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )
   
    dim as ubyte count = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
   
    dim as longint place
   
    place = instr( 1 , chrs , "END" ) - 1
   
    dim as string in1 = left( chrs , place )
    chrs = mid( chrs , place + 4 )
   
    place = instr( 1 , chrs , "END" ) - 1
    dim as string in2 = left( chrs , place )
   
    chrs = mid( chrs , place + 4 )
    dim as string in3 = chrs
   
    dim as string outs1 = ""
    dim as string n1
    dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr( in1 ) )
    for a as longint = 1 to len( in1 ) step 1
        n1 = "00" + hex( *ubp1 ) : ubp1+= 1
        n1 = right( n1 , 2 )
        outs1+= n1
    next
   
    print "d out = " ; len( outs1 ) , outs1

    dim as string outs2 = ""
    dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr( in2 ) )
    for a as longint = 1 to len( in2 ) step 1
        n1 = "00000000" + bin( *ubp2 ) : ubp2+= 1
        n1 = right( n1 , 8 )
        outs2+= n1
    next
    outs2 = left( outs2 , len( outs2 ) - count )

    print "d out = " ; len( outs2 ) , outs2

    dim as string outs3 = ""
    dim as ubyte ptr ubp3 = cptr( ubyte ptr , strptr( in3 ) )
    for a as longint = 1 to len( in3 ) step 1
        n1 = "00000000" + bin( *ubp3 ) : ubp3+= 1
        n1 = right( n1 , 8 )
        outs3+= n1
    next

    print "d out = " ; len( outs3 ) , outs3

    return chrs
   
end function

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

Re: Squares

Postby albert » May 04, 2020 19:37

Never mind.. It has an error...

if frac( s1 ) > 0 then s1+= .5

if s1 mod 2 = 1 then outs3+= "1" else outs3+= "0"

Needs to be:

if frac( s1 ) <> 0 then s1+= .5 : outs3+= "1" else outs3+= "0"

With the change , it doesn't compress...

Back to the drawing board !!!
Imortis
Moderator
Posts: 1729
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: Squares

Postby Imortis » May 04, 2020 19:49

Albert, you are not a doctor. Please refrain from dispensing medical advice. I have removed your post.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 04, 2020 21:35

@Imortis

Sorry for the post...

But it might become the next college frat craze..

Like beer bongs , and beer funnels... "Rum & Vodka , Nebulizers."

But you can only get a Nebulizer with a doctors prescription , here in the U.S.A. And it costs like $150.00
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 04, 2020 23:30

I came up with an idea for a stock-exchange..

The exchange gets the number of stocks the company posts.
Then the exchange sells the stocks for the company asking price.
The proceeds from the initial sale go to the company.

All the sold stocks , must pay a dividend based on company profits.. All stocks are par

Then the buyers can post how many shares they want to sell and , their asking price.
Sort of an online auction.. Maybe , having to sell and buy in 1,000 share blocks.

If the seller has shown a profit for the sale , ( sold for more than they bought it for. ) then they have to pay a small commission.
If someone wants to buy shares , then they have to pay a small sales commission...

If a stock price drops to a low level , the the exchange can buy stock and get the dividends, until a resale...

Buyers can negotiate directly with sellers , to try to secure a lower price..

So the exchange always makes a profit... either by dividends or sales , purchase commissions..

The Stock Exchange would all be electronic , no paper or employees , except the IT guys running the servers..

The exchange gets the dividends from the companies and posts the money to the user accounts...

Unlike other exchanges.. only sellers ( not the exchange ) can sell their stocks.. If and only if , they decide to sell...
As far as i can think , most people would only sell shares , if their dividends go down to a low enough level..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » May 05, 2020 1:40

@Dodicat

I've got another compression formula..

Compresses 100,000 by 9% after 100 loops.
Compresses 1,000,000 by 73% after 100 loops.
Compresses 10,000,000 by 79% after 100 loops: Takes like 1500 seconds.

========================================
n1 = bin( *ubp ) : ubp+= 1

if len( n1 ) <= 4 then
outs1+= "0"
outs2+= hex( val( "&B" + n1 ) )
goto done
end if

outs1+= hex( val( "&B" + left( n1 , 4 ) ) )
outs2+= mid( n1 , 5 )
outs3+= right( "00" + bin( len( n1 ) - 5 ) , 2 )

done:
========================================

Here's Dodicat's Zlib doing the compression of 1,000,000.

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A


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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        randomize
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        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 esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100

time2 = timer

print
print  "Compress time = " ; time2 - time1
print
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
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as string outs3 = ""
    dim as string n1
    dim as longint v1 , v2
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = bin( *ubp ) : ubp+= 1
       
        if len( n1 ) <= 4 then
            outs1+= "0"
            outs2+= hex( val( "&B" + n1 ) )
            goto done
        end if
       
        outs1+= hex( val( "&B" + left( n1 , 4 ) ) )
        outs2+= mid( n1 , 5 )
        outs3+= right( "00" + bin( len( n1 ) - 5 ) , 2 )
       
        done:
        'print
        'print n1
        'print outs1
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = " ; len( outs1 ) ' , outs1
   
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 2
        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( outs3 ) step 8
        final+= chr( val( "&B" + mid( outs3 , a , 8 ) ) )
    next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )
   
    return chrs
   
end function

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

Re: Squares

Postby albert » May 05, 2020 23:17

@Dodicat

I've got another compression formula... Compresses 100,000 by 68% after 100 loops.

==============================================
n1 = bin( *ubp ) : ubp+= 1

if len( n1 ) mod 2 = 1 then n1 = "0" + n1

outs1+= hex( val( "&B" + left( n1 , len( n1 ) \ 2 ) ) )
outs2+= hex( val( "&B" + right( n1 , len( n1 ) \ 2 ) ) )
==============================================

The problem is:
if n1 begins with a "0" , you don't know how many bits are in outs2..

If n1 = "0100 - 0000" , you would think you need 3 bits for outs2 instead of 4..

0100 - 0000
100 - 000
Both equal the same output...

Can you think of a solution??
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 06, 2020 0:37

@Dodicat

I played with it some....

==========================================
n1 = bin( *ubp ) : ubp+= 1

if len( n1 ) = 1 then
outs1+= "0"
outs2+= n1
goto done
end if

if len( n1 ) = 3 then
outs1+= hex( val( "&B" + left( n1 , 1 ) ) )
outs2+= hex( val( "&B" + right( n1 , 2 ) ) )
goto done
end if

if len( n1 ) = 5 then
outs1+= hex( val( "&B" + left( n1 , 3 ) ) )
outs2+= hex( val( "&B" + right( n1 , 2 ) ) )
goto done
end if

if len( n1 ) = 7 then
outs1+= hex( val( "&B" + left( n1 , 3 ) ) )
outs2+= hex( val( "&B" + right( n1 , 4 ) ) )
goto done
end if

outs1+= hex( val( "&B" + left( n1 , len( n1 ) \ 2 ) ) )
outs2+= hex( val( "&B" + right( n1 , len( n1 ) \ 2 ) ) )

done:
==========================================

Len = 5 and len = 7 are both 3.. i couldn't figure out how else to do it...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 06, 2020 0:50

@Dodicat

I got it figured out...

Now it compresses 100,000 by 22% after 100 loops..
Now it compresses 100,000 by 42% after 200 loops..

Now it compresses 1,000,000 by 53% after 100 loops..
Now it compresses 1,000,000 by 73% after 200 loops..

=========================================
n1 = bin( *ubp ) : ubp+= 1

if len( n1 ) = 1 then
outs1+= "0"
outs2+= n1
goto done
end if

if len( n1 ) = 3 then
outs1+= hex( val( "&B" + left( n1 , 1 ) ) )
outs2+= hex( val( "&B" + right( n1 , 2 ) ) )
goto done
end if

if len( n1 ) = 5 then
outs1+= hex( val( "&B" + left( n1 , 3 ) ) )
outs2+= right( n1 , 2 )
goto done
end if

if len( n1 ) = 7 then
outs1+= hex( val( "&B" + left( n1 , 3 ) ) )
outs2+= hex( val( "&B" + right( n1 , 4 ) ) )
goto done
end if

outs1+= hex( val( "&B" + left( n1 , len( n1 ) \ 2 ) ) )
outs2+= hex( val( "&B" + right( n1 , len( n1 ) \ 2 ) ) )

done:
=========================================

If len = 5 then outs2 = right 2 bits instead of a hex value..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 06, 2020 2:22

@Dodicat

I forgot about the case of 6 = 3 bit + 3 bits..

I got to work all the values out , before i re-post..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 06, 2020 18:10

@Dodicat

I came up with another formula... Compresses 100,000 bytes 44% after 100 loops.

===================================
n1 = bin( *ubp ) : ubp+= 1

if len( n1 ) <= 4 then
outs1+= "100"
outs2+= right( "0000" + n1 , 4 )
goto done
end if

if len( n1 ) = 5 then outs1+= "11"
if len( n1 ) = 6 then outs1+= "10"
if len( n1 ) = 7 then outs1+= "01"
if len( n1 ) = 8 then outs1+= "00"

outs2+= mid( n1 , 2 )

done:
===================================

Now : it's just telling , "100" from "00"
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » May 07, 2020 17:25

@angros47

This formula only compresses 100,000 by 19% after 100 loops... 300 loops does 45%

===================================
n1 = bin( *ubp ) : ubp+= 1

if len( n1 ) <= 5 then
outs1+= "000"
outs2+= right( "00000" + n1 , 5 )
goto done
end if

if len( n1 ) = 6 then outs1+="100"
if len( n1 ) = 7 then outs1+="01"
if len( n1 ) = 8 then outs1+="1"

outs2+= mid( n1 , 2 )

done:
==================================

You have 1 , 01 , 100 , 000

Are there any duplicates???
angros47
Posts: 1673
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 07, 2020 18:11

What happens if you have to compress any sequence made by 8 bit starting with 100? Like 10010101 ?
How can you distinguish it from a 6 bit sequence?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 07, 2020 20:17

@angros47

10010101 ?

it starts with a 1 and there's no 10 so it must be 100

Again there's no 10 so it must be 1 , 01 , 01

A 100 - 01 though , could look like a 1 - 000 - 1 ??

Return to “General”

Who is online

Users browsing this forum: Bing [Bot] and 7 guests