Squares

General FreeBASIC programming questions.
dodicat
Posts: 6555
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Feb 13, 2020 19:21

This sounds like the Beast of Craggy Island from Father Ted's episode Cirpy Burpy Cheap Sheep.
badidea
Posts: 2078
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Feb 13, 2020 19:37

albert wrote:To do all they could do , would require data compression , to hold all that info in a small 2 inch sphere.... plus the batteries , motors and lasers...

If aliens can store 1 bit per molecule, they can store about 1E+24 bits in a 2 inch sphere. Or roughly 100 ZB (zettabyte). Should be enough for your footprints.
albert
Posts: 5709
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Feb 14, 2020 0:15

@Richard
@Dodicat

I think i figured the "Alien Compression" out....

I need some help with the decompression.... It's rather confusing..

========================================================
It takes the input chr()'s in lengths of 256 bytes.
It then creates a 256 byte count string , of chr( 0 ) to chr( 255 )

It then steps through the data string by 2's , bubble sorting the 256 bytes..

It then :
assigns the data 256 bytes to an output string.
assigns the count 256 bytes to an output string.
========================================================

Here's Dodicats , Zlib compression code , with my sorting formula...

Just press a key , a couple times... It only does 3 loops.. for 98% 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 esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 3."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 3

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 longint count1 = 0
    dim as string str1
    dim as longint dec1
    do
        str1 = str( len( chrs ) / 256 )
        dec1 = instr( 1 ,str1 , "." )
        if dec1 <> 0 then chrs+= "0" : count1+= 1
    loop until dec1 = 0
   
    dim as string swaps = ""
    for a as longint = 0 to 255
        swaps+= chr( a )
    next
   
    dim as string bits1 = ""
    dim as string bits2 = ""
    dim as string n1 , n2
    for a as longint = 1 to len( chrs ) step 256
       
        n1 = mid( chrs , a , 256 )
        n2 = swaps
       
        dim as string s1 , s2
        dim as string t1 , t2
        for b as longint = 1 to len( n1 ) step 2
           
            s1 = mid( n1 , b , 2 )
             t1 = mid( n2 , b , 2 )
           
            for c as longint = b + 2 to len( n1 ) step 2
               
                s2 = mid( n1 , c , 2 )
                t2 = mid( n2 , c , 2 )
               
                if s1 > s2 then
                    mid( n1 , b , 2 ) = s2 : mid( n1 , c , 2 ) = s1
                    mid( n2 , b , 2 ) = t2  : mid( n2 , c , 2 ) = t1
                end if
               
            next
        next
       
        bits1+= n1
        bits2+= n2
       
    next
   
    dim as string final = bits1 + "END" + bits2
    'for a as longint = 1 to len( bits1 ) step 8
    '    final+= chr( val( "&B" + mid( bits1 , 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



Can someone trouble shoot it , to see if i have an error somewhere????
albert
Posts: 5709
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 14, 2020 2:56

I found the error

Code: Select all

 for b as longint = 1 to len( n1 ) step 2
           
            s1 = mid( n1 , b , 2 )
             t1 = mid( n2 , b , 2 )
           
            for c as longint = b + 2 to len( n1 ) step 2
               
                s2 = mid( n1 , c , 2 )
                t2 = mid( n2 , c , 2 )
            next
next



needs to be:

Code: Select all

 for b as longint = 1 to len( n1 ) step 2
           
            for c as longint = b + 2 to len( n1 ) step 2
           
                s1 = mid( n1 , b , 2 )
                t1 = mid( n2 , b , 2 )
           
               
                s2 = mid( n1 , c , 2 )
                t2 = mid( n2 , c , 2 )
            next
next


With the fix , it doesn't compress...
albert
Posts: 5709
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 14, 2020 4:08

@badidea

100 ZB (zettabyte)

What is a zettabyte ??

When i went to school and learned the number system it only goes up to dectillions ( 10 )

ones
tens
hundreds
thousands
1 )millions
2) billions
3) trillions
4) quadrillions
5) quintillions
6) sextillions
7) septillions
8) octillions
9 ) novtillions
10 ) dectillions

I guess it based on the roman number scheme???

They never taught us numbers beyond dectillions....
Richard
Posts: 3027
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Feb 14, 2020 5:36

Zetta = 10^21

Code: Select all

Const As Double Pi = 4 * Atn(1), TwoPi = 2 * Pi
Const As Double Yotta = 1e24,  Zetta = 1e21,  Exa   = 1e18
Const As Double Peta  = 1e15,  Tera  = 1e12,  Giga  = 1e9
Const As Double Mega  = 1e6,   kilo  = 1e3,   hecto = 100
Const As Double deca  = 10,    deci  = 1e-1,  centi = 1e-2
Const As Double milli = 1e-3,  micro = 1e-6,  nano  = 1e-9
Const As Double pico  = 1e-12, femto = 1e-15, atto  = 1e-18
Const As Double zepto = 1e-21, yocto = 1e-24
dodicat
Posts: 6555
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Feb 14, 2020 10:51

quote:
In the American system one billion is 1,000,000,000 and a trillion is 1,000,000,000,000 so one trillion is one thousand times one billion. In the British system one billion is 1,000,000,000,000 and one trillion is 1,000,000,000,000,000,000 so one trillion is one million times one billion.
. . .
So Albert's list goes awry at number 2) if you are not American.
Richard
Posts: 3027
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Feb 14, 2020 11:12

The English language is confused by the choice of short scale or long scale terms shown here.
https://en.wikipedia.org/wiki/Long_and_ ... rent_usage

The matter is fully resolved in science by the use of the SI prefixes.
https://en.wikipedia.org/wiki/Metric_pr ... I_prefixes
dodicat
Posts: 6555
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Feb 14, 2020 12:13

Thanks a yotta Richard.
srvaldez
Posts: 2462
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Feb 14, 2020 13:22

I just came across a series of YouTube videos on Calculus, for someone like me with very little formal education, I would call them "Calculus - the common sense approach" https://www.youtube.com/watch?v=WUvTyaa ... VRMYO3t5Yr
dodicat
Posts: 6555
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Feb 14, 2020 20:23

Thanks srvaldez.
A gradient line.

Code: Select all


Const pi=4*Atn(1)
Dim Shared As Integer xres,yres
Dim Shared As Double lower,upper,ratio
dim as integer w,h
screeninfo w,h
screen 20
Screeninfo xres,yres

Function gradient(f As Function(As Double) As Double,x As Double) As Double
    Dim As Double dx=1e-6
    Return (f(x+dx)-f(x))/dx
End Function

Function map(a As Double,b As Double,x As Double,c As Double,d As Double) As Double
    Return ((d)-(c))*((x)-(a))/((b)-(a))+(c)
End Function

Function Fn(x As Double) As Double 'some function
    Return Sin(x)+2*Cos(2*x)-3*Sin(3*x)-x^2-7*x+6
End Function

Sub drawline(x As Double,y As Double,angle As Double,ln As Double)
    Var x2=x+ln*Cos(angle)
    Var y2=y+ln*Sin(angle)
    Circle(x,y),5,3,,,,f
    Line(x,y)-(x2,y2),3
End Sub

Sub getrange(Byref min As Double,Byref max As Double)
    min=1e10
    max=-1e10
    Dim As Double xpos,res
    For x As Long=0 To xres
        xpos=map(0,xres,x,lower,upper)
        res=Fn(xpos)
        If min>res Then min=res
        If max<res Then max=res
    Next x
End Sub

lower=-2*pi
upper=2*pi
Dim As Double xpos,x,ypos
Dim As Double min,max
getrange(min,max) 'get the y range

 ratio=(h/w)*((upper-lower)/(max-min))*(yres/xres)'to adjust the gradient to graph x/y ratio
dim as string key
Do
    x+=1
    key=inkey
    Screenlock
    Cls
    For n As Long=0 To xres
        xpos=map(0,xres,n,lower,upper)
        ypos=map(min,max,Fn(xpos),.1*yres,.9*yres)
        If n=0 Then  Pset(n,ypos) Else Line -(n,ypos)
    Next n
    xpos=map(0,xres,x,lower,upper)
    ypos=map(min,max,Fn(xpos),.1*yres,.9*yres)
    drawline(x,ypos,Atn(ratio*gradient(@Fn,xpos)),200)
    Screenunlock
    Sleep 20
Loop Until x=xres or key=chr(27)
print "Done"
Sleep
 
Last edited by dodicat on Feb 14, 2020 21:03, edited 1 time in total.
srvaldez
Posts: 2462
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Feb 14, 2020 20:26

nice dodicat, what's your opinion on the videos?
dodicat
Posts: 6555
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Feb 14, 2020 21:09

Slight edit on the gradient thing.
I like the first one (area of a circle)
I'll work through the others.
The area of the circle is really a summation (integration style).
Usually calculus starts with differentiation, (slope of a curve), which is easier than integration.
But as the guy says, it is a different approach to calculus.
albert
Posts: 5709
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( 4 bit )

Postby albert » Feb 15, 2020 1:33

@Dodicat

I got yet another compression formula that works..

It only compresses 100,000 by 65% after 100 lops and takes about a minute...Got to speed it up....


Here's the "Test-Bed" , where i write the decompression.... Can you help with the decompression???

Just let me know , if it can't be decompressed... I got the decompression started...

Code: Select all


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

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s = ""
    For n As Long = 1 To 8
        s+=chr(Int(Rnd*256))
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
            'do
            '    dim as longint chk = len(comp) - 1
            '    comp = compress_loop(comp)
            '    if len(comp) >= chk then exit do
            '    if inkey = chr( 27 ) then end
            'loop
            for a as longint = 1 to 1 step 1
                comp = compress_loop(comp)
            next
    'end compress
    time2 = timer
   
    time3=timer
    'begin decompress
        dim as string final_out = comp
        for a as longint = 1 to 1 step 1
            final_out = decompress_loop(final_out)
        next
    'end decompress
    time4 = timer
   
   'sleep
   
    print string(99,"=")
    print "inp = " ; (s)
    print string(99,"=")
    print "out = " ; (final_out)
    print
    print "compress time   = "; time2-time1
    print "decompress time = "; time4-time3
    print
   
    if s = final_out then print "Decompressed OK" else print "Decompression failed."
    print string(99,"=")
   
    sleep
   
loop until inkey = chr(27)

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

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



( !!~~ EDITED ~~!! )
angros47
Posts: 1636
Joined: Jun 21, 2005 19:04

Re: Yah-Zip ( 4 bit )

Postby angros47 » Feb 15, 2020 9:31

albert wrote:Just let me know , if it can't be decompressed... I got the decompression started...


It can't be decompressed, because there are some duplicates. And I know for sure that there are duplicates, because of the pigeongole principle: https://en.wikipedia.org/wiki/Pigeonhole_principle

Return to “General”

Who is online

Users browsing this forum: No registered users and 8 guests