Squares

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

Re: Squares

Postby albert » Jan 10, 2020 18:00

I think i got it corrected...

20,000 compresses 6% after 100 loops... Under 20,000 it expands..
100,000 compresses to 79%
1,000,000 compresses to 95% after 100 loops...Takes 50 to 60 seconds.


v = chrs[ a - 1 ]

n1 = ""

if v > 127 then v-= 128 : n1+= "0"

if v > 063 then v-= 064 : n1+= "1"

if v > 031 then v-= 032 : n1+= "11"

if v > 015 then v-= 016 : n1+= "10"

if n1 = "" then n1 = "00"

bits1+= right( "0000" + bin( v ) , 4 )
bits2+= n1 + "0"

Each set ends with a "0"

I put the 10 at the end..
So now , if there's a 10 , it would come out to 100

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 bits1 = ""
    dim as string bits2 = ""
    dim as string n1
    dim as longint v
    for a as longint = 1 to len( chrs ) step 1
       
        v = chrs[ a - 1 ]
       
        n1 = ""
       
        if v > 127 then v-= 128 : n1+= "0"
       
        if v > 063 then v-= 064 : n1+= "1"
       
        if v > 031 then v-= 032 : n1+= "11"
       
        if v > 015 then v-= 016 : n1+= "10"
       
        if n1 = "" then n1 = "00"
       
        bits1+= right( "0000" + bin( v ) , 4 )
        bits2+= n1 + "0"
   
    next
   
    print "c out = " ; len( bits1 ) , bits1
    print "c out = " ; len( bits2 ) , bits2
   
    dim as ubyte count1
    dim as string str1
    dim as ubyte dec1
    do
        str1 = str( len( bits2 ) / 8 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0 then bits2+= "0" : count1+= 1
    loop until dec1 = 0
   
    dim as string final = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        final+= chr( val( "&B" + mid( bits2 , a , 8 ) ) )
    next
   
    final = chr( count1 ) + 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 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 zeros = string( 8 , "0" )
    dim as string n1
   
    dim as string outs1 = ""
    for a as longint = 1 to len( bits1 ) step 1
        n1 = zeros + bin( bits1[ a - 1 ] )
        n1 = right( n1 , 8 )
        outs1+= n1
    next
   
    dim as string outs2 = ""
    for a as longint = 1 to len( bits2 ) step 1
        n1 = zeros + bin( bits2[ a - 1 ] )
        n1 = right( n1 , 8 )
        outs2+= n1
    next
    outs2 = left( outs2 , len( outs2 ) - count1 )
   
    print "d bit = " ; len( outs1 ) , outs1
    print "d bit = " ; len( outs2 ) , outs2
       
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Jan 10, 2020 20:05

Now i got the problem of 00 , 000

Back to the drawing board....
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Alter-Bin

Postby albert » Jan 10, 2020 22:33

@Richard
@Dodicat
@StoneMonkey
@badidea
@angros47


I got it this time....Using an altered binary..

n1 = mid( bits , a , 6 )

v1 = 0
if mid( n1 , 1 , 1 ) = "1" then v1+= 1
if mid( n1 , 2 , 1 ) = "1" then v1+= 2
if mid( n1 , 3 , 1 ) = "1" then v1+= 5

if mid( n1 , 4 , 1 ) = "1" then v1+= 9
if mid( n1 , 5 , 1 ) = "1" then v1+= 13
if mid( n1 , 6 , 1 ) = "1" then v1+= 26

outs+= chr( v1 )

Compresses 100,000 to 94% after 100 loops.. Takes 7 seconds
1,000,000 takes like 120 seconds.. So i got to speed it up somehow..

I got the idea from a dream last night , about picking lottery numbers...( !!~~ I hit the jackpot~~!! )


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
    for a as longint = 1 to len( chrs ) step 1
        n1 = right( "00000000" + bin( chrs[ a - 1 ] ) , 8 )
        bits+= n1
    next
   
    print "c bit =  "; len( bits) ' , bits
   
    dim as string outs = ""
    dim as longint v1 , v2
    for a as longint = 1 to len( bits ) step 6
       
        n1 = mid( bits , a , 6 )
       
        v1 = 0
        if mid( n1 , 1 , 1 ) = "1" then v1+= 1
        if mid( n1 , 2 , 1 ) = "1" then v1+= 2
        if mid( n1 , 3 , 1 ) = "1" then v1+= 5
       
        if mid( n1 , 4 , 1 ) = "1" then v1+= 9
        if mid( n1 , 5 , 1 ) = "1" then v1+= 13
        if mid( n1 , 6 , 1 ) = "1" then v1+= 26
       
        outs+= chr( v1 )
       
    next
   
    print "c out = " ; len( outs ) ' , outs
   
    dim as string final = outs
    'for a as longint = 1 to len( outs ) step 8
    '    final+= chr( val( "&B" + mid( outs , 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   
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 10, 2020 23:50

I did it again!!! Stupid mistake....
I did this routine a few pages back , and there's values that add up to other values..

So it doesn't work....


I've done so many formulas that ; i revisit some , without remembering it..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 11, 2020 0:03

dim as string outs = ""
dim as longint v1
for a as longint = 1 to len( bits ) step 6

n1 = mid( bits , a , 6 )

v1 = 0
if mid( n1 , 1 , 1 ) = "1" then v1+= 1
if mid( n1 , 2 , 1 ) = "1" then v1+= 2
if mid( n1 , 3 , 1 ) = "1" then v1+= 3

if mid( n1 , 4 , 1 ) = "1" then v1+= 7
if mid( n1 , 5 , 1 ) = "1" then v1+= 14
if mid( n1 , 6 , 1 ) = "1" then v1+= 28

outs+= chr( v1 )

next

Compresses 92% after 100 loops... just telling 2 - 1 = 3 from 3 ?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Alter-Bin

Postby albert » Jan 11, 2020 2:13

I think I've got it worked out..

Again Altered Binary..

n1 = mid( bits , a , 8 )

count = 0
v1 = 0
if n1[ 0 ] = 49 then v1+= 96 : count+= 1
if n1[ 1 ] = 49 then v1+= 48 : count+= 1
if n1[ 2 ] = 49 then v1+= 24 : count+= 1
if n1[ 3 ] = 49 then v1+= 12 : count+= 1

if n1[ 4 ] = 49 then v1+= 06 : count+= 1
if n1[ 5 ] = 49 then v1+= 03 : count+= 1
if n1[ 6 ] = 49 then v1+= 02 : count+= 1
if n1[ 7 ] = 49 then v1+= 01 : count+= 1

if count = 1 then count = 0 else count = 1

outs1+= chr( v1 )
outs2+= bin( count )

Each digit is the sum of the previous digits...
Then you have the count... if only 1 bit is set the count = 0 else it equals 1 ( to specify zero or multiple digits. )

For 100 loops:
10,000 bytes in expands
20,000 bytes in compresses to 25% : takes 7 seconds
100,000 bytes compresses to 70%.: takes 22 seconds.
1,000,000 bytes in compresses to 87% : takes 155 seconds.
10,000,000 bytes in compresses to 90% : takes 1420 seconds.. Way to slow.. Got to speed it up..

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 zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ulp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ulp ) : ulp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bit =  "; len( bits) ' , bits
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as longint v1 , count
    for a as longint = 1 to len( bits ) step 8
       
        n1 = mid( bits , a , 8 )
       
        count = 0
        v1 = 0
        if n1[ 0 ] = 49 then v1+= 96 : count+= 1
        if n1[ 1 ] = 49 then v1+= 48 : count+= 1
        if n1[ 2 ] = 49 then v1+= 24 : count+= 1
        if n1[ 3 ] = 49 then v1+= 12 : count+= 1
       
        if n1[ 4 ] = 49 then v1+= 06 : count+= 1
        if n1[ 5 ] = 49 then v1+= 03 : count+= 1
        if n1[ 6 ] = 49 then v1+= 02 : count+= 1
        if n1[ 7 ] = 49 then v1+= 01 : count+= 1
       
        if count = 1 then count = 0 else count = 1
       
        outs1+= chr( v1 )
        outs2+= bin( count )
       
    next
   
    print "c out = " ; len( outs1 ) ' , outs1
    print "c out = " ; len( outs2 ) ' , outs2
   
    dim as string final = outs1 + "END"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , 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



( !!~~ EDITED ~~!! )

( !!~~ EDITED ~~!! ) a second time, i got it sped up...

Now :
100,000 takes 4 to 5 seconds..
1,000,000 takes 60 seconds..
10,000,000 takes 480 seconds..
Last edited by albert on Jan 11, 2020 18:56, edited 1 time in total.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Alter-Bin

Postby albert » Jan 11, 2020 18:19

I need some help with the decompression....

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
'=====================================================================
'=====================================================================
'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 zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ubp ) : ubp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bit = " ; len( bits) , bits
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as longint v1 , count
    for a as longint = 1 to len( bits ) step 8
       
        n1 = mid( bits , a , 8 )
       
        count = 0
        v1 = 0
        if n1[ 0 ] = 49 then v1+= 96 : count+= 1
        if n1[ 1 ] = 49 then v1+= 48 : count+= 1
        if n1[ 2 ] = 49 then v1+= 24 : count+= 1
        if n1[ 3 ] = 49 then v1+= 12 : count+= 1
       
        if n1[ 4 ] = 49 then v1+= 06 : count+= 1
        if n1[ 5 ] = 49 then v1+= 03 : count+= 1
        if n1[ 6 ] = 49 then v1+= 02 : count+= 1
        if n1[ 7 ] = 49 then v1+= 01 : count+= 1
       
        if count = 1 then count = 0 else count = 1
       
        outs1+= chr( v1 )
        outs2+= bin( count )
       
    next
   
    print "c out = " ; len( outs1 ) ' , outs1
    print "c out = " ; len( outs2 ) , outs2
   
    dim as ubyte count1 = 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" : count1+= 1
    loop until dec1 = 0
   
    dim as string final = outs1 + "END"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
   
    final = chr( count1 ) + 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 longint place = instr( 1 , chrs , "END" ) - 1
    dim as string outs1 = left( chrs , place )
    dim as string outs2 = mid( chrs , place + 4 )
       
    dim as string bits1 = ""
    dim as string n1
    for a as longint = 1 to len( outs1 ) step 1
        n1 = "000" + str( outs1[ a - 1 ] )
        n1 = right( n1 , 3 )
        bits1+= n1 + "-"
    next
   
    dim as string bits2 = ""
    dim as string zeros = string( 8 , "0" )
    for a as longint = 1 to len( outs2 ) step 1
        n1 = zeros+ bin( outs2[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits2+= n1
    next
    bits2 = left( bits2 , len( bits2 ) - count1 )
   
    print "d bit = " ; len( bits1 ) , bits1
    print "d bit = " ; len( bits2 ) , bits2
   
   
   
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Jan 11, 2020 20:33

@Dodicat
@StoneMonkey

I got the decompression written... I'm getting errors..

It sometimes decompresses okay , but mostly not.. Just keep pressing a key or esc to exit..

===========================================
Could someone go over it and see where i got errors???
Or , why it's not decompressing properly.
===========================================

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 zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ubp ) : ubp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bit = " ; len( bits) , bits
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as longint v1 , count
    for a as longint = 1 to len( bits ) step 8
       
        n1 = mid( bits , a , 8 )
       
        count = 0
        v1 = 0
        if n1[ 0 ] = 49 then v1+= 96 : count+= 1
        if n1[ 1 ] = 49 then v1+= 48 : count+= 1
        if n1[ 2 ] = 49 then v1+= 24 : count+= 1
        if n1[ 3 ] = 49 then v1+= 12 : count+= 1
       
        if n1[ 4 ] = 49 then v1+= 06 : count+= 1
        if n1[ 5 ] = 49 then v1+= 03 : count+= 1
        if n1[ 6 ] = 49 then v1+= 02 : count+= 1
        if n1[ 7 ] = 49 then v1+= 01 : count+= 1
       
        if count = 1 then count = 0 else count = 1
       
        outs1+= chr( v1 )
        outs2+= bin( count )
       
    next
   
    print "c out = " ; len( outs1 )  , 'outs1
    for a as longint = 1 to len( outs1 ) step 1
        n1 = "000" + str( outs1[ a - 1 ] )
        n1 = right( n1 , 3 ) + "-"
        print n1 ;
    next
    print
    print "c out = " ; len( outs2 ) , outs2
   
    dim as ubyte count1 = 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" : count1+= 1
    loop until dec1 = 0
   
    dim as string final = outs1 + "END"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
   
    final = chr( count1 ) + 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 longint place = instr( 1 , chrs , "END" ) - 1
    dim as string outs1 = left( chrs , place )
    dim as string outs2 = mid( chrs , place + 4 )
       
    dim as string bits1 = ""
    dim as string n1
    for a as longint = 1 to len( outs1 ) step 1
        n1 = "000" + str( outs1[ a - 1 ] )
        n1 = right( n1 , 3 )
        bits1+= n1 + "-"
    next
   
    dim as string bits2 = ""
    dim as string zeros = string( 8 , "0" )
    for a as longint = 1 to len( outs2 ) step 1
        n1 = zeros+ bin( outs2[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits2+= n1
    next
    bits2 = left( bits2 , len( bits2 ) - count1 )
   
    print "d bit = " ; len( bits1 ) , bits1
    print "d bit = " ; len( bits2 ) , bits2
   
    dim as string outs = ""
    dim as string  n2
    place = 1
    dim as longint v1 , v2
    for a as longint = 1 to len( bits1 ) step 4
       
        n1 = mid( bits1 , a , 4 )
        n1 = left( n1 , 3 )
       
        v1 = val( mid( bits2 , place , 1 ) ) : place+= 1
       
        v2 = val( n1 )
       
        if v1 = 1 and v2 = 00 then n2 = "00000000" : goto done
        if v1 = 0 and v2 = 01 then n2 = "00000001" : goto done
        if v1 = 0 and v2 = 02 then n2 = "00000010" : goto done
        if v1 = 0 and v2 = 03 then n2 = "00000100" : goto done
        if v1 = 0 and v2 = 06 then n2 = "00001000" : goto done
        if v1 = 0 and v2 = 12 then n2 = "00010000" : goto done
        if v1 = 0 and v2 = 24 then n2 = "00100000" : goto done
        if v1 = 0 and v2 = 48 then n2 = "01000000" : goto done
        if v1 = 0 and v2 = 96 then n2 = "10000000" : goto done
       
        if v1 = 1 and v2 = 96 then n2 = "01111111" : goto done
        if v1 = 1 and v2 = 48 then n2 = "00111111" : goto done
        if v1 = 1 and v2 = 24 then n2 = "00011111" : goto done
        if v1 = 1 and v2 = 12 then n2 = "00001111" : goto done
        if v1 = 1 and v2 = 06 then n2 = "00000111" : goto done
        if v1 = 1 and v2 = 03 then n2 = "00000011" : goto done
       
        n2 = ""
        if v2 >= 96 then n2+= "1" : v2-= 96 else n2+= "0"
        if v2 >= 48 then n2+= "1" : v2-= 48 else n2+= "0"
        if v2 >= 24 then n2+= "1" : v2-= 24 else n2+= "0"
        if v2 >= 12 then n2+= "1" : v2-= 12 else n2+= "0"

        if v2 >= 06 then n2+= "1" : v2-= 06 else n2+= "0"
        if v2 >= 03 then n2+= "1" : v2-= 03 else n2+= "0"
        if v2 >= 02 then n2+= "1" : v2-= 02 else n2+= "0"
        if v2 >= 01 then n2+= "1" : v2-= 01 else n2+= "0"
       
        done:
       
        outs+= n2
       
    next
   
    dim as string final = ""
    for a as longint = 1 to len( outs ) step 8
        final+= chr( val( "&B" + mid( outs , a , 8 ) ) )
    next
   
    return final
   
end function

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

Re: Squares

Postby albert » Jan 12, 2020 0:50

Never mind , i did it again , stupid mistake... 6 = 321 ..

With only 1 bit of count, you can't tell them apart...
if you add in the full bit count , it doesn't compress.

Back to the drawing board....
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 12, 2020 22:05

Here's another attempt at compression..

it steps by 8 bits binary..

Sums 1'st 3 bits , 00 01 10 11
Sums 2nd 3 bits , 00 01 10 11
Sums last 2 bits , 00 01 10

Then it mods the 8 bits by 4

=====================================================
''PUT 3 COUNTS INTO OUTPUT
outs1+= right( "00" + bin( v1 ) , 2 )
outs1+= right( "00" + bin( v2 ) , 2 )
outs1+= right( "00" + bin( v3 ) , 2 )

'ADD 8 BITS MOD 4'
outs1+= right( "00" + bin( val( "&B" + n1 ) mod 4 ) , 2 ) + "-"
====================================================

Knowing the number of set bits in each group and the final mod 4 , can it be solved???

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
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ulp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ulp ) : ulp+= 1
        n1 = right( n1 , 8 )
        bits+=n1 + "-"
    next
   
    print "c bin = " ; len( bits ) , bits
   
    dim as string show = "3b3b2bmd-"
    dim as string outs1 = ""
    dim as ubyte v1 , v2 , v3 , v4
    for a as longint = 1 to len( bits ) step 9
        n1 = mid( bits , a , 9 )
        n1 = left( n1 , 8 )
       
        'COUNT FIRST 3 BITS
        v1 = 0
        if n1[ 0 ] = 49 then v1+= 1
        if n1[ 1 ] = 49 then v1+= 1
        if n1[ 2 ] = 49 then v1+= 1
       
        'COUNT SECOND 3 BITS
        v2 = 0
        if n1[ 3 ] = 49 then v2+= 1
        if n1[ 4 ] = 49 then v2+= 1
        if n1[ 5 ] = 49 then v2+= 1
       
        'COUNT LAST 2 BITS
        v3 = 0
        if n1[ 6 ] = 49 then v3+= 1
        if n1[ 7 ] = 49 then v3+= 1
   
        ''PUT 3 COUNTS INTO OUTPUT
        outs1+= right( "00" + bin( v1 ) , 2 )
        outs1+= right( "00" + bin( v2 ) , 2 )
        outs1+= right( "00" + bin( v3 ) , 2 )
       
        'ADD 8 BITS MOD 4'
        outs1+= right( "00" + bin( val( "&B" + n1 ) mod 4 ) , 2 ) + "-"
       
        show+=left( show , 9 )
       
        'print n1 , v1 , v2 , v3 , val( "&B" + n1 ) mod 4
        'sleep
        'if inkey = " " then end
       
    next
   
    show = left( show , len( show ) - 9 )
   
    print "c out = " ; len( outs1 ) , outs1
    print "c sho = "; len( show ) , show
   
    print
    print "3b = sum of three bits"
    print "2b = sum of two bits"
    print "md = val of 8 bits mod 4"
    print
    print
   
    dim as string final = ""
    'for a as longint = 1 to len( outs1 ) step 8
    '    final+= chr( val( "&B" + mid( outs1 , 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



If it can be solved ??? : It compresses 90+% after 10 loops..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 12, 2020 23:09

I wrote a scanner to go through all 256 values , and compare the outputs...

It can't be solved...

Maybe trying other lengths of bits???

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 10."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 10

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 zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ulp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ulp ) : ulp+= 1
        n1 = right( n1 , 8 )
        bits+=n1
    next
   
    print "c bit = " ; len( bits ) ' , bits
   
    dim as string outs1 = ""
    dim as ubyte v1 , v2 , v3 , v4 , md1
    for a as longint = 1 to len( bits ) step 8
        n1 = mid( bits , a , 8 )
       
        v1 = 0
        if n1[ 0 ] = 49 then v1+= 1
        if n1[ 1 ] = 49 then v1+= 1
        if n1[ 2 ] = 49 then v1+= 1
       
        v2 = 0
        if n1[ 3 ] = 49 then v2+= 1
        if n1[ 4 ] = 49 then v2+= 1
        if n1[ 5 ] = 49 then v2+= 1
       
        v3 = 0
        if n1[ 6 ] = 49 then v3+= 1
        if n1[ 7 ] = 49 then v3+= 1
   
        outs1+= right( "00" + bin( v1 ) , 2 )
        outs1+= right( "00" + bin( v2 ) , 2 )
        outs1+= right( "00" + bin( v3 ) , 2 )
       
        md1 = val( "&B" + n1 ) mod 4
       
        outs1+= right( "00" + bin( md1 ) , 2 )
       
        dim as ubyte s1 , s2 , s3 , s4 , md2 , value
        dim as string n2
        for b as longint = 0 to 255 step 1
            n2 = right( "00000000" + bin( b) , 8 )
           
            s1 = 0
            if n2[ 0 ] = 49 then s1+= 1
            if n2[ 1 ] = 49 then s1+= 1
            if n2[ 2 ] = 49 then s1+= 1
           
            s2 = 0
            if n2[ 3 ] = 49 then s2+= 1
            if n2[ 4 ] = 49 then s2+= 1
            if n2[ 5 ] = 49 then s2+= 1
           
            s3 = 0
            if n2[ 6 ] = 49 then s3+= 1
            if n2[ 7 ] = 49 then s3+= 1
           
            md2 = b mod 4
           
            if s1 = v1 and s2 = v2 and s3 = v3 and md2 = md1 then value = b : exit for
       
        next
       
        print val( "&B" + n1 ) , value
        sleep
        if inkey = " " then end
       
       
    next
   
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 8
        final+= chr( val( "&B" + mid( outs1 , 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

angros47
Posts: 1673
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » Jan 13, 2020 0:18

Albert, I would recommend you to try a simple thing: write all numbers from 0 to 15 (since each of them can represent a different nibble, and they represent all possible nibbles). Then, , write all the possible combinations of three bits, and count them. Then, try to match every three bit sequence to a number, if you can, avoiding every duplicate.

If you can do it, you will have solved your problem.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 13, 2020 0:55

Here's an interesting bit of code.... comparing mods..

The only thing is ; it requires 9 bits per byte , so it doesn't compress..

All 256 values can be represented by mod 3 , mod 8 , mod 11...

Code: Select all


screen 19

dim as longint v , v1 , v2 , v3
do
        randomize
        v = int( rnd * 256 )
       
        v1 = v mod 3    '<---- 2 bits
        v2 = v mod 8    '<---- 3 bits
        v3 = v mod 11  '<---- 4 bits
       
        dim as longint s , s1 , s2 , s3 , value
        for b as longint = 0 to 255 step 1
            s = b
            s1 = s mod 3
            s2 = s mod 8
            s3 = s mod 11
            if s1 = v1 and s2 = v2 and s3 = v3 then value = b : exit for
        next
       
        print v , value , "press a key for next , press esc to exit.."
        sleep
       
loop until inkey = chr( 27 )

sleep
end

dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 13, 2020 2:28

Hi Albert.
Looks like an example of the Chinese remainder theorem.

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 " element 1":return 0
            If HCF(array(p1),array(p2))<>1 Then  print"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
   
 '====================== EXAMPLE =====================================
 screen 19
 randomize 1
 do
    var  v = int( rnd * 256 )
    var v1=v mod 3
    var v2=v mod 8
    var v3=v mod 11
     print
    Dim As Integer mods(1 To ...)       = {3,8,11}
    Dim As Integer remainders(1 To ...) = {v1,v2,v3}
   
   
    if TestPairwisecoprime(mods()) then
    Var ans= Cremainder(mods(),remainders())'<------- result
   
    'displaying and checking only
    dim as longint prod=1
    color 2
    print "Result = ";ans
    color 15
    print "Mods array:"
    'color 3
    print "(";
    for z as integer=lbound(mods) to ubound(mods)
        print mods(z);",";
        prod*=mods(z)
    next z
   ' color 15
    print ")"
    print
    print "remainders array (v1,v2,v3):"
    print "(";
    for z as integer=lbound(remainders) to ubound(remainders)
        print ans mod mods(z);",";
    next z
    print ")"
    print
    print "I.E.:"
    for z as integer=lbound(remainders) to ubound(remainders)
        print ans;" mod ";mods(z);" = ";remainders(z)
    next z
    print
    print ans; " <"; prod;" ( product of the mods array) --It should be!";
    print " ---> ";ans<prod
    print "Press a key"
    print "_______________________"
    else
    print "Array is not pairwise co-prime via at least these elements"
    end if
    Sleep
    loop until inkey=chr(27)
     
     
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 13, 2020 2:39

@Dodicat

What's the < 264 ???

Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests