Squares

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

Yah-Zip

Postby albert » Dec 18, 2019 20:04

I edited the above "Yah-Zip" post...

Here it is again... It only needs 20 loops to get 99% compression.

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 a key for next compression." ; " loops = " ; loops ; " out of 20."
    print
    print "press esc to exit."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 20

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)
   
    'CONVERT INPUT TO 8 BIT BINARY
    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 bin = " ; len( bits ) ', bits
   
    'STEP THROUGH BINARY BY 6'S AND BUILD OUTPUT
    'FOR SOME REASON STEPPING BY 6'S , COMPRESSES MORE THAN STEPPING BY 8'S
    dim as string outs = ""
    dim as longint sum0
    dim as longint sum1
    for a as longint = 1 to len( bits ) step 2
       
        n1 = mid( bits , a , 2 )
       
        'SUM 1'S AND 0'S
        sum0 = 0
        sum1 = 0
        for b as longint = 1 to len( n1 ) step 1
            if n1[ b - 1 ] = 48 then sum0+= ( 1 shl ( len( n1 ) - b ) )
            if n1[ b - 1 ] = 49 then sum1+= ( 1 shl ( len( n1 ) - b ) )
        next
       
        sum1+=1
       
        'DECIDE WHICH SUM IS LOWER AND PUT THAT CHR() INTO THE OUTPUT
        if sum0 < sum1 then outs+= chr( sum0 )
        if sum1 < sum0 then outs+= chr( 3 + sum1 )
       
        'UN COMMENT TO SEE IF VALUES EQUAL OKAY. 
        'print n1 , val( "&B" + n1 ) , sum0 , sum1
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = " ; len( outs ) ', outs
       
   
    'CREATE OUTPUT
    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 "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Dec 18, 2019 21:14

It doesn't work after all..

I had taken out the case of ( sum0 = sum1 )
Because ; the two are inversions of each other , there's no way they could equal..

But if you add 1 to one of the sums , then there's the possibility of an equate.

I was wondering why the output was only 3 times the input , instead of 4 times the input..
It's because there are a lot of equates...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 19, 2019 1:57

If your stepping by 2 bits , summing the 1's and summing the 0's , and taking the lowest value.

The lowest value can only be 0 , 1 , 2 ; There is no 3 , so it compresses..

you have:

3 - 0 = 0
0 - 3 = 0

2 - 1 = 1
1 - 2 = 1

So the output is only 0 or 1
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Dec 20, 2019 23:36

@Dodicat
@StoneMonkey

I've got another compressor that compresses...

You step through the binary by 6 bits , and build 2 arrays to hold the count in one and the bits in the other.
Then you bubble sort the two arrays to put the most prolific first.
Then you take the first 15 elements and put them into a dictionary.
Then you run through the input bit stream by 6 bits and search the dictionary.

If the bits are in the dictionary then you output a hex( 0 to F ) else you output a chr( val of 6 bits )
Then you add the dictionary in at the end..

But i think there might be a problem... Some of the output chr()'s might equal a hex( 0 to F ) value???

For 100 loops :
Compresses 10,000 to 63% , takes < 2 seconds
Compresses 100,000 to 85% , takes 20 seconds
Compresses 1,000,000 to 90% but it takes like 185 seconds..
Compresses 10,000,000 to 91% , but it takes 1800 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 10000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    print
    print "press esc to exit."
    '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)
   
    'CONVERT INPUT TO 8 BIT BINARY
    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 bin = " ; len( bits ) ', bits
   
    'STEP BY 6 BITS AND PUT VALUES INTO ARRAYS
    redim as longint vals_c( 0 to 63 )
    redim as string vals_b( 0 to 63 )
    for a as longint = 1 to len( bits ) step 6
        n1 = mid( bits , a , 6 )
        vals_c( val( "&B" + n1 ) ) += 1
        vals_b( val( "&B" + n1 ) )  =  n1
    next
   
    'BUBBLE SORT ARRAYS TO PUT MOST PROLIFIC VALUES FIRST
    for b as longint = 0 to 63
        for c as longint = b to 63
            if vals_c( b ) < vals_c( c ) then
                swap vals_c( b ) , vals_c( c )
                swap vals_b( b ) , vals_b( c )
            end if
        next
    next
   
    'TAKE OUT 15 MOST PROLIFIC AND PUT THEM INTO A DICTIONARY
    redim preserve vals_b( 14 )
    redim preserve vals_c( 14 )
    dim as string dict = ""
    for a as longint = 0 to ubound( vals_b ) step 1
        dict+= vals_b( a ) + " "
    next
   
    print "c dic =  "; len( dict ) , len( dict ) / 7
   
    'STEP BY 6 BITS AND BUILD OUTPUT , SEARCHING THE DICTIONARY FOR THE VALUES
    'IF VAL IS IN DICTIONARY THEN OUTPUT HEX POSITION "0" TO "F" , ELSE OUTPUT 6 BIT INPUT AS CHR()
    dim as string outs = ""
    dim as longint place
    for a as longint = 1 to len( bits ) step 6
        n1 = mid( bits , a , 6 )
        place = instr( 1 , dict , n1 )
        if place > 0 then outs+= hex( place \ 7 ) else outs+= chr( val( "&B" + n1 ) )
    next
   
    print "c out = " ; len( outs ) ' , outs
   
    dim as string final = outs
    'for a as longint = 1 to len( outs ) step 2
    '    final+= chr( val( "&H" + mid( outs , a , 2 ) ) )
    'next
   
    final+= "END" + dict
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Dec 21, 2019 3:02

I changed the output lines:

for a as longint = 1 to len( bits ) step 6
n1 = chr( val( "&B" + mid( bits , a , 6 ) ) )
place = instr( 1 , dict , n1 )
if place > 0 then outs+= chr( 64 + ( place - 1 ) ) else outs+= n1
next

Since n1 can only equal 0 to 63 , making the dictionary pointer chr( 64 + ( place-1) ) , it expands instead of compressing...
It was only compressing because there were equates in the output.. Dups..

So it's a failure.... Back to the drawing board...
Stonemonkey
Posts: 646
Joined: Jun 09, 2005 0:08

Re: Squares

Postby Stonemonkey » Dec 21, 2019 14:38

@albert I think we must have quite large drawing boards.
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 22, 2019 4:14

You can search the volume of a large multidimensional drawing board, for ever, for a solution.
But it only takes a couple of lines on the back of an envelope to prove, there can be no solution.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Solstice Calendar

Postby albert » Dec 22, 2019 4:19

I came up with an idea for a new type of calendar..

You have months that are portions of the suns position in the tropics.. ( 8 months in a year )

1) equator to north half tropic
2 ) north halt tropic to north tropic
3 ) north tropic to north half tropic
4 ) north half tropic to equator

5 ) equator to south half tropic
6 ) south half tropic to south tropic
7 ) south tropic to south half tropic
8 ) south half tropic to equator

Then you don't need a leap year..

The months would be 45 or 46 or 47 days long..
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 22, 2019 5:34

@Albert. Are you aware that you posted in the minute of your winter solstice.
Your days are getting longer since you posted, mine are getting shorter.

Months were called “moon'ths” because they are lunar = Moon cycles.
You have invented half-seasons which would need to be called “sun'ths”.

A leap day is still required every 4 years because the period of the Moon's orbit about the Earth; the rotation period of the Earth relative to the Sun; and the period of Earth's orbit about the Sun; are related by irrational multiples.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Dec 22, 2019 22:27

I got another formula that compresses...

It builds a dictionary of the first 64 non repeating chrs...
Then it steps through the input chr stream by 1 and searches the dictionary..

place = instr( 1 , dict , n1 )

if place > 0 then
outs+= chr( place - 1 )
else
outs+= chr( 64 + asc( n1 ) )
end if

The 64 + asc( n1 ) , i'm not sure how to handle it ?? cause a 255 byte , would roll over to equal a 0 to 63 ???

Need some help with it.....

For 100 loops : Compresses 10,000,000 bytes to 99% , takes 140 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 a key for next compression." ; " loops = " ; loops ; " out of 100."
    print
    print "press esc to exit."
    '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)
   
    dim as string dict = ""
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = mid( chrs , a , 1 )
       
        if instr( 1 , dict , n1 ) = 0 then dict+= n1
       
        if len( dict ) = 64 then exit for
       
    next
   
    dim as string outs = ""
    dim as longint place
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = mid( chrs , a , 1 )
       
        place = instr( 1 , dict , n1 )
       
        if place > 0 then
            outs+= chr( place - 1 )
        else
            outs+= chr( 64 + asc( n1 ) )
        end if
       
    next
   
    dim as string final = outs + "END" + dict
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

Last edited by albert on Dec 22, 2019 23:33, edited 2 times in total.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 22, 2019 22:41

@Richard

I figured my "sunths" calendar out..

You break each tropic into 5 sunths of 36 days each.. ( 5 north topic sunths , and 5 south tropic sunths. ) for 360 days

Then every other sunth would have 37 days for a total of 365. ( then you have the leap year every 4 years. )

Then the solstices would happen on the 18th of the third and 8th months.. 1 + 8 = 9

With the current lunar calendar, there's 12 full moons one year and 13 full moons the next..
A full moon happens every 28 point something days. it's an odd fractional number. You can't make a good calendar out of it...
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 23, 2019 12:10

Albert.
I believe the native people in your land used a moon calendar, (many moons have passed . . . e.t.c).
I think your native people were much better at looking after America than the present bunch.
Same with Australia, it now burns under a regime of greed, criminality (arson), and looking after number one.
Sorry to say that, but I believe it is true, and it is no better in this country.
I no longer think that maths and science are the most important academic topics for humanity, but old fashioned physical and human geography should take their place, for our survival.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 23, 2019 21:13

@Dodicat

I think the best type of social order would be : "Total Communism"

Everyone works and everything is free... No monetary system..

Free houses , you can have your house torn down and rebuilt or build a new house on vacant land,
Free college education
Free groceries
Free medical and dental
Free Jewelry
Free automobiles
Free everything

Anyone can start a business , just sign up for the land and build your factory.. or remodel an existing building..

Everyone owns a business or works for one.

Companies can do unlimited free research.

All the jobs that humans don't or won't do , can be done by robots and machines..

Everyone is equally able to own anything they want.... You couldn't tell a pauper from a king...

There would be no poor or rich..

Everyone works doing something , and everything is free....

Mankind could colonize space in no time at all... The governments could do things that now , are monetarily impossible or prohibitive..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 23, 2019 22:27

@Dodicat
@StoneMonkey

I got another compression idea...

You step through the input by 2 chrs..

v1 = asc left chr + 1
v2 = asc right chr + 1

v3 = ( v1 + v2 ) \ 2 ( the average )

output+= chr( v1 ) + chr( v3 )

10,000 bytes in it expands
100,000 or more bytes in , it compresses 11% - 12% after 100 loops... ( only compresses 100 bytes each loop )

Just keep pressing a key or esc to exit...

See compress_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 a key for next compression." ; " loops = " ; loops ; " out of 100."
    print
    print "press esc to exit."
    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)
   
    dim as string outs1 = ""
    dim as string n1
    dim as longint v1 , v2 , v3
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 2
       
        v1 = ( *ubp ) + 1 : ubp+= 1
        v2 = ( *ubp ) + 1 : ubp+= 1
       
        v3 = ( v1 + v2 ) \ 2
       
        outs1+= chr( v1 ) + chr( v3 )
       
        'print v1 , v2 , v3
        'sleep
        'if inkey = " " then end
       
    next
   
    dim as string final = outs1
    'for a as longint = 1 to len( outs1 ) step 2
    '   final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    'next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function



If you do : v3 = ( v1 + v2 ) \ 4 ( half the average )... It compresses 90+% after 100 loops. Don't know if you can reverse it or not...
D.J.Peters
Posts: 8179
Joined: May 28, 2005 3:28
Contact:

Re: Squares

Postby D.J.Peters » Dec 23, 2019 22:45

dodicat wrote:I no longer think hat maths and science are the most important academic topics for humanity, but old fashioned physical and human geography should take their place, for our survival.
(after a half of bottle johnnie walker)
Robots (we made) will survival and travels our milky way, they know "shakespeare" but never understand it.

Same as the most humans here, don't worry I have fun.

In scope of education, before the internet I wrote 12 text BTX messages (more letters per msg. than as SMS later)
about neural nets and got a "golden modem" from WDR (a TV station in germany)
for my easy to understand study about neural networks.

My first try was on "Schneider" CPC 64 what a fun at all.
Not only about AI, ray tracing on "green only" monitor also.
(imagine a red sphere with mirror of a black and white chess field in green)

Other results on a Commodore C64 with color monitor "ray tracing" of the same simple scene
a hour for a low resolution image was a kind of "modern math adventure" :-)

Joshy

Return to “General”

Who is online

Users browsing this forum: No registered users and 7 guests