Squares

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

Re: Squares

Postby albert » Feb 17, 2020 0:40

@Dodicat

I got a search function done in the decompression... It's sometimes getting it right..

Got to figure out how to do the search , first to last and backwards , last to first ....

Here's the "Test-Bed"

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 n1
    dim as longint v1 , v2 , v3 , v4
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) , bits
   
    dim as string bits1 = ""
    dim as string bits2 = ""
    for a as longint = 1 to len( bits ) step 4
       
        n1 = mid( bits , a , 4 )
       
        if n1 = "0000" then bits1+= "0" : bits2+= "0"
        if n1 = "0001" then bits1+= "1" : bits2+= "0"
        if n1 = "0010" then bits1+= "2" : bits2+= "0"
        if n1 = "0011" then bits1+= "3" : bits2+= "0"
       
        if n1 = "0100" then bits1+= "0" : bits2+= "10"
        if n1 = "0101" then bits1+= "1" : bits2+= "10"
        if n1 = "0110" then bits1+= "2" : bits2+= "10"
        if n1 = "0111" then bits1+= "3" : bits2+= "10"
       
        if n1 = "1000" then bits1+= "0" : bits2+= "11"
        if n1 = "1001" then bits1+= "1" : bits2+= "11"
        if n1 = "1010" then bits1+= "2" : bits2+= "11"
        if n1 = "1011" then bits1+= "3" : bits2+= "11"
       
        if n1 = "1100" then bits1+= "00" : bits2+= "0"
        if n1 = "1101" then bits1+= "11" : bits2+= "0"
        if n1 = "1110" then bits1+= "22" : bits2+= "0"
        if n1 = "1111" then bits1+= "33" : bits2+= "0"

    next
   
    print
    print "c out = " ; len( bits1 ) , bits1
    print "c out = " ; len( bits2 ) , bits2
   
    dim as ubyte count1 = 0
    dim as string str1 = ""
    dim as ubyte dec1
    do
        str1 = str( len( bits1 ) / 4 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0 then bits1+= "0" : count1+= 1
    loop until dec1 = 0
   
    dim as ubyte count2 = 0
    dim as string str2 = ""
    dim as ubyte dec2
    do
        str2 = str( len( bits2 ) / 8 )
        dec2 = instr( 1 , str2 , "." )
        if dec2 <> 0 then bits2+= "0" : count2+= 1
    loop until dec2 = 0
   
    dim as string final = ""
    dim as string s , n
    for b as longint = 1 to len( bits1 ) step 4
        s = mid( bits1 , b , 4 )
        n = ""
        n+= right( "00" + bin( val( mid( s , 1 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 2 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 3 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 4 , 1 ) ) ) , 2 )
        final+= chr( val( "&B" +  n ) )
        'final+= chr( val( "&B" + mid( bits1 , b , 8 ) ) )
    next
    final+= "END"
    for b as longint = 1 to len( bits2 ) step 8
        final+= chr( val( "&B" + mid( bits2 , b , 8 ) ) )
    next
   
    final = chr( count1 ) + chr( count2 )  + 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 count1 = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
    dim as ubyte count2 = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
   
    dim as longint place = instr( 1 , chrs , "END" ) - 1
    dim as string bits1 = left( chrs , place )
    dim as string bits2 = mid( chrs , place + 4 )
   
    dim as string outs1 = ""
    dim as string n1
    dim as string v1 , v2 , v3 , v4
    for a as longint = 1 to len( bits1 ) step 1
        n1 = "00000000" + bin( bits1[ a - 1 ] )
        n1 = right( n1 , 8 )
        v1 = str( val( "&B" + mid( n1 , 1 , 2 ) ) )
        v2 = str( val( "&B" + mid( n1 , 3 , 2 ) ) )
        v3 = str( val( "&B" + mid( n1 , 5 , 2 ) ) )
        v4 = str( val( "&B" + mid( n1 , 7 , 2 ) ) )
        outs1+= v1 + v2 + v3 + v4
    next
    outs1 = left( outs1 , len( outs1 ) - count1 )
   
    dim as string outs2 = ""
    for a as longint = 1 to len( bits2 ) step 1
        n1 = "00000000" + bin( bits2[ a - 1 ] )
        n1 = right( n1 , 8 )
        outs2+= n1
    next
    outs2 = left( outs2 , len( outs2 ) - count2 )
   
    print "d out = " ; len( outs1 ) , outs1
    print "d out = " ; len( outs2 ) , outs2
   
   
    dim as string show1 = ""
    dim as string show2 = ""
    dim as string n2
    dim as longint pl1 = 1 , pl2 = 1
    do
        n1 = mid( outs2 , pl1 , 1 )
        n2 = mid( outs1 , pl2 , 1 )
       
        if n1 = "0" then
            show2+= "_" + n1 + "_"  : pl1+= 1
            if mid( outs1 , pl2 + 1 , 1 ) = n2 then
                show1+= n2 + n2 + "_"  : pl2+= 2
            else
                show1+= "_" + n2 + "_" : pl2+=1
            end if
        end if
           
        if n1 = "1" then
            n1+= mid( outs2 , pl1 + 1 , 1 ) : pl1+= 2 : show2+= n1 + "_"
            show1+= "_" + n2 + "_" : pl2+=1
        end if
       
    loop until pl1 > len( outs2 )
       
    print
    print "d sho = " ; len( show1 ) , show1
    print "d sho = " ; len( show2 ) , show2
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Feb 18, 2020 23:54

@Dodicat

I went back to mods... Here's another compressor..

7 bits input..
===============================================
n1 = mid( bits , a , 7 )

v1 = val( "&B" + n1 )

v2 = v1 mod 3
v3 = v1 mod 4
v4 = v1 mod 11

n2 = str( ( ( v2 * 100 ) + ( v3 * 10 ) ) + v4 )

bits1+= chr( val( n2 ) )
==============================================

How would you tell if v4 = 10 ????

Compresses 100,000 bytes by 78% , after 100 loops : Takes 13 seconds...

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 100000
            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 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 bits = ""
    dim as string n1 , n2
    dim as longint v1 , v2 , v3 , v4
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) ' , bits
   
    dim as string bits1 = ""
    for a as longint = 1 to len( bits ) step 7
       
        n1 = mid( bits , a , 7 )
       
        v1 = val( "&B" + n1 )
       
        v2 = v1 mod 3
        v3 = v1 mod 4
        v4 = v1 mod 11
       
        n2  = str( ( ( v2 * 100 ) + ( v3 * 10 ) ) + v4 )
       
        bits1+= chr( val( n2 ) )
       
        'print v1 , v2 , v3 , v4 , n2
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = " ; len( bits1 ) ', bits1
   
    dim as string final = bits1
    'for a as longint = 1 to len( bits1 ) step 2
    '    final+= chr( val( mid( bits1 , a , 2 ) ) )
    '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: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

3 MOD

Postby albert » Feb 19, 2020 3:14

@Richard
@Dodicat

How would you alter the below code, to automatically search for the 3 lowest values??

We need md1 , md2 , md3 , to equal the three lowest values , that will equal ( V = 127 or V = ?? )

Code: Select all


screen 19

dim as longint v , v1 , v2 , v3 , v4
dim as longint  md1 , md2 , md3 , md4
do
           
            do
                'ADJUST ( RND * ? ) TO DIFFERENT VALUES , HAS TO BE 3 OR GREATER
                'YOU CAN PLAY AROUND AND FIND THE LOWEST MODS THAT EQUAL ( V ) BELOW.
                md1 = int( rnd * 4 )
                md2 = int( rnd * 5 )
                md3 = int( rnd * 12 )
               
            loop until md1 > 1 and md2 > 1 and md3 > 1
           
            'SET ( V ) TO MAX BIT VALUE YOU WANT TO SEARCH.
            v = 127
           
            v1 = v mod md1
            v2 = v mod md2
            v3 = v mod md3
           
            dim as longint s , s1 , s2 , s3 , s4 , value
            'IF YOUR DOING MORE THAN 16 BITS SET ,BELOW TO MAX BIT VALUE
            for b as longint = 0 to 65536 step 1
                s = b
                s1 = s mod md1
                s2 = s mod md2
                s3 = s mod md3
                if s1 = v1 and s2 = v2 and s3 = v3 then value = b : exit for
            next
       
        if v = value then print v , value  , md1 , md2 , md3 : sleep
       
loop until inkey = chr( 27 )

sleep
end

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

Re: Squares

Postby albert » Feb 19, 2020 3:37

I got another song written...

Pearl Snap Studios is working on the demo.. It should be done in a few days..
Here's the lyric.

===================================================================
I think Adam & Eve were the beginning of the Jewish genealogy..
After Cain killed Able , he went to a village and picked out a wife.. and had offspring..
Maybe Adam & Eve were alien grays and Cain married a humanoid??? Then the offspring genome was contaminated and couldn't live as long??
===================================================================

( genre = Country Rock )

( title= Hallelujah )

( entry music )

never thought too much about it
i never had too much to say

read the bible while i stumble
hoping that , my soul can be saved

reading the books of the bible
just stumble along as i pray

asking jesus's forgiveness
for all the mistakes that i've made

and i sing a hallelujah
(music)
and i sing a hallelujah

( music )

just kneeling down in the temple
before the altar and i pray

asking god for his forgiveness
i know somehow i have to pay

he resides up in the heavens
like a beacon he always shines

and i hope that my , soul is saved
i take a sip of holy wine

and i sing a hallelujah
(music)
and i sing a hallelujah

( music )

and the empty church i ponder
i wonder if i might be saved

and just kneeling at the altar
somehow living got in the way

here to ask for my forgiveness
and kneeling down i start to pray

thanking jesus of nazareth
for taking all my sins away

and i sing a hallelujah
(music)
and i sing a hallelujah

( exit music )

albert_redditt@yahoo.com

Albert Redditt
315 W. Carrillo St. #104
Santa Barbara , Ca. 93101 U.S.A.
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 21, 2020 3:07

I came up with a funny name for a Chinese dish...

Pi Don Shu

( peed on shoe ) !!~ HA-HA ~!!

Maybe a flank steak with lemon sauce???
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Quad Mul

Postby albert » Feb 22, 2020 0:32

@Dodicat

I was working with quadra-decimal... stepping by 3 digits.. 000 to 333

You add 1 to the left digit , and add 1 to the right 2 digits...

So you have 1 , 2 , 3 , 4 and ( 01 02 03 04 ) , ( 11 12 13 14 ) , ( 21 22 23 24 ) , ( 31 32 33 34 )

Then you multiply the left digit by the right 2 digits.
If the left digit is less than the right 2 digits then you add 100 to the output..

I'm getting some duplicates...

Code: Select all


screen 19

dim as longint v1 , v2 , v3 , ans
dim as string n1

for a as longint = 1 to 4
       
    v1 = a
   
    for b as longint = 0 to 3
       
        v2 = b
       
        for c as longint = 1 to 4
           
            v3 = ( b * 10 ) + c
           
            ans = v1 * v3
           
            if v1 < v3 then ans+=100
           
            n1 = right( "   " + str( ans ) , 3 )
           
            print n1 ; " " ;
           
        next
   
    next
   
    print

next

sleep
end

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

Re: Squares

Postby albert » Feb 22, 2020 3:26

@Dodicat

I got something that works.. Now i got to see if it can be reversed...

Compresses 100,000 by 98% after 100 loops : Takes 3 seconds.. It's real fast...

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 100000
            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 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 bits1 = ""
    dim as string n1
    dim as longint v1
    for a as longint = 1 to len( chrs ) step 1
       
        v1 = chrs[ a - 1 ]
       
        if v1 = 0 then
            bits1+=chr( 0 )
        else
            dim as longint v2 = 0
            dim as single count = 0
            do
                v2+= 1
                count+= .5
            loop until v2 = v1
            if frac( count ) <> 0 then count+= 128
            bits1+= chr( count )
        end if
       
     next
   
    print "c bin = " ; len( bits1 ) ' , bits1
   
    dim as string final = bits1
    'for a as longint = 1 to len( bits2 ) step 2
    '    final+= chr( val( mid( bits2 , a , 2 ) ) )
    '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: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Feb 26, 2020 2:14

@Richard
@Dodicat

( !!~ COMPRESSION SUCCESS ~!! )

It's a formula , i tried before and it didn't compress...
I tried it again with different sizes , and it compresses above 30,000 bytes in. ( i was trying it at 10,000 bytes in.. it expanded 116% )

30,000 bytes in compresses 27%
100,000 bytes in compresses 59% ( stays at 59% for for 30 or 40 loops. )
1,000,000 bytes in compresses 93% : takes 78 seconds... Got to speed it up...

Here it is doing 1,000,000 bytes in.

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 1000000
            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 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 bits1 = ""
    dim as string bits2 = ""
    dim as string n1
    dim as longint ones , zeros
    dim as ubyte ptr ulp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = bin( *ulp ) : ulp+= 1
       
        ones = 0
        zeros = 0
        for b as longint = 1 to len( n1 ) step 1
            if n1[ b - 1 ] = 49 then ones+=1
            if n1[ b - 1 ] = 48 then zeros+= 1 shl ( len( n1 ) - b )
        next
       
        bits1+= bin( zeros )
        bits2+= right( "0000" + bin( ones ) , 4 )
       
        'print n1 , ones , zeros
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c bin = " ; len( bits1 ) ' , bits1
   
    dim as string final = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    for a as longint = 1 to len( bits2 ) step 8
        final+= chr( val( "&B"  +mid( bits2 , 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



It inputs a byte stripping the left zeros ,
it then sums the binary values of the 0's and puts it into a binary output string ( bits1 ).
it then counts the number of 1's and puts it into a 4 bit output string ( bits2 )

Then it turns the two binary strings into chars....
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 26, 2020 19:14

I got my "Hallelujah" and "Gone" songs demo'd

https://soundcloud.com/user-704620747

Pearl Snap Studios , did a good job on the music for "Hallelujah"
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 26, 2020 19:36

For the "Yah-Zip" above..

bits1+= bin( zeros )
bits2+= right( "0000" + bin( ones ) , 4 )

Changed to:

bits1+= bin( zeros )
bits2+= right( "0000" + bin( len( n1 ) ) , 4 )

Then you know how long the input is supposed to be...
srvaldez
Posts: 2262
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Feb 27, 2020 0:12

albert wrote:I got my "Hallelujah" and "Gone" songs demo'd

https://soundcloud.com/user-704620747

Pearl Snap Studios , did a good job on the music for "Hallelujah"

Hi Albert
yes, they did a good rendition of Hallelujah, congratulations.
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 27, 2020 1:30

@srvaldez

The "Gone" song , i didn't like too much...

It was supposed to be a light rock song.. A sombre song... It's a song about a man coming home and finding his wife dead of an overdose.

The music was supposed to sound similar to the KISS song "Beth" from the 1970's

I came up with the lyric while i was singing "Beth"

The "Beth" line:
"This place , seems so empty , that our house , just ain't our home"
Became:
"Never seemed so empty , until i found you gone"
"Leaving me alone to , to try to carry on"


Here's my "Gone" lyric :

[ Genre = Rock ]

[ Title = Gone ]

[entry music ]

never seemed so empty , until i found you gone
leaving me alone to , to try to carry on

[ music ]

they say your soul goes on , long after you have gone
why do i feel empty , the emptiness goes on
memories they flash by , the memories of you
i can't stop the feeling , what am i supposed to do
two of us together , and oh the times we had
fighting back a tear and , the thought just makes me mad

[ music ]

never seemed so empty , until i found you gone
leaving me alone to , to try to carry on

[ music ]

the life of the party , the parties that we had
time to say a goodbye , goodbye just makes me mad
memories they linger , the memories of you
i can't stop the feeling , what am i supposed to do
i will still remember , remember that you've gone
time for me to just try, just try to carrry on

[ music ]

never seemed so empty , until i found you gone
leaving me alone to , to try to carry on

[ music ]

struggled with addiction , how could you go so wrong
took to much of heaven , and now i found you gone

[ exit music ]


albert_redditt@yahoo.com

Albert Redditt
315 W. Carrillo St. #104
Santa Barbara, Ca. 93101 U.S.A
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 27, 2020 2:16

@Richard

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

'ones = 0
'zeros = 0
sum = 0
for b as longint = 1 to len( n1 ) step 1
'if n1[ b - 1 ] = 48 then zeros+=1
'if n1[ b - 1 ] = 49 then ones+=1
if n1[ b - 1 ] = 48 then sum+= 1 shl ( len( n1 ) - b )
next

bits1+= bin( sum )
bits2+= str( len( n1 ) )
====================================================

How would you determine , how many bits of "bits1" , you need to bring in , for each digit of "bits2" ???

Bits2 holds the length of the n1 input byte.. bits2 holds the binary sum of the zeros of the n1 input....

Can it be undone?
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 27, 2020 2:40

One of the guys in my apartment complex , was saying his pecker gets hard when the wind blows..

So i said: Mr. SlightBreez.

Then SlightBreez became SlyBreez ( get some on the sly )
Then SlyBreez became CheatinBreez then CheatinBreez became ChetBreez

Just playing around with words... Doing Calculus with names..
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Mar 01, 2020 1:08

@Richard
@Dodicat

I got another compression formula that compresses...

It builds a random dictionary of 128 bytes...
Then it searches through the input for the dictionary bytes..
If the dictionary bytes are in the input , then it cuts it out of the input , and adds a dict pointer into an output string..

Requires input to be 30,000 bytes or greater...

Compresses 100,000 bytes in by 61% : Takes 17 seconds..
It's real slow, I've got to figure out how to speed it up.. 1,000,000 bytes takes like 7 minutes for the first loop..

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 100000
            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 esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 50."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 50

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 dict = ""
    dim as string n1
    randomize 0
    do
        n1 = chr( int( rnd * 256 ) )
        if instr( 1 , dict , n1 ) = 0 then dict+= n1
    loop until len( dict ) = 128
   
    dim as string bits = string( len( chrs ) , chr( 130 ) )
    dim as longint place1 , place2
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = mid( chrs , a , 1 )
       
        place1 = instr( 1 , dict , n1 )
       
        if place1 > 0 then
           
            place2 = 0
            do
                place2 = instr( place2 + 1 , chrs , n1 )
                if place2 > 0 then
                    chrs = left( chrs , place2 - 1 ) + mid( chrs , place2 + 1 )
                    mid( bits , place2 , 1 ) = chr( place1 )
                end if
            loop until place2 = 0
       
        end if
       
    next
   
    print "c bin = " ; len( bits ) ' , bits

    dim as string final = chrs + "END" + bits + "End" + dict
   
    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


Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests