Squares

General FreeBASIC programming questions.
Richard
Posts: 3029
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jul 25, 2020 2:34

Albert wrote:When was "multiplicative reciprocal" invented???
When i came up with the idea , Richard didn't have any knowledge of it , And Richard is a professional mathematician..
And he used it in his code :
Anyone who has ever been shown how to divide fractions was taught to invert and multiply. That has been done for more than 1000 years. It was used for floating point in the early 1960s in the CDC 6600, then later in the IBM System/360 Model 91 in about 1965.

I used the technique in 1982 when I was designing a new floating point unit for a parallel processor. The technique was 20 year old technology, and any patents had expired.

I was just a geologist then, who got distracted by electronic instrumentation and number crunching.
I am not a professional mathematician.
dodicat
Posts: 6630
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jul 25, 2020 8:40

Sorry to hear about your patients Richard.
Albert, I have been busy trying to revive my Win 10 box, it went crook, as they say.
Looks like it is the power supply unit, I have ordered another machine from Ebay.
I think maybe something like your tube, on the spot virus tests would be a great idea.
Regarding geology Richard, I have been watching the Australian gold hunters and the opal hunters on the telly these past few weeks.
To me here it looks like they just tear the landscape apart and leave gaping holes all over the place.
I note that they need permits e.t.c., and I am with the gold detectorists, but those folk investing in heavy diggers e.t.c. just seem to get greedier and greedier.
Of course I am judging from an armchair thousands of miles away.
Anyway, as I remarked a few months ago, people with skills in geography (geology), and any of the life sciences are the most important bank of knowledge on the planet at the present time, IMHO.
I don't have any code to post this visit to squares, I am on Linux just now, without a proper ide.
Richard
Posts: 3029
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jul 25, 2020 10:36

@dodicat. It is good to hear you are still extant.

I see the news from USA and UK on TV here and it seems like Covid 19 has really gone viral. Australia is reasonably well isolated, and this island is more isolated again, being as it is at the end of the Earth.

Those reality TV series are certainly good entertainment, if you are stuck at home.

A while ago I came to the conclusion that there is more money to be made designing and selling metal detectors than there is by using them. Gold fever is a virus that affects the prospector's minds. As soon as they find a couple of ounces of gold, they spend $3k on a new detector.
BasicCoder2
Posts: 3571
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Squares

Postby BasicCoder2 » Jul 25, 2020 23:44

.
Last edited by BasicCoder2 on Jul 26, 2020 18:28, edited 1 time in total.
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 25, 2020 23:50

@Richard

I found gold in Nevada , USA.... I never told anyone about it til now...

I'ts in a small town named "Beatty"... By the old "Kay's Coral" trailer lot...

I used to be a meat cutter , at the "Little General" , local grocery store there..
I dug up a mix of copper and gold.. The rocks in the area were greenish turquoise.. like sea aged copper...

I was planning to one day return there , and stake a claim and maybe sell the claim to a gold mining company like "Barrick"
Barrick has another mine in the city elsewhere to the north...

You can google "Barrick" , they have mines all over the U.S.
They're the leading gold mining company in the U.S. They buy up claims and do the mining...
badidea
Posts: 2112
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Jul 26, 2020 0:30

Richard wrote:A while ago I came to the conclusion that there is more money to be made designing and selling metal detectors than there is by using them. Gold fever is a virus that affects the prospector's minds. As soon as they find a couple of ounces of gold, they spend $3k on a new detector.

Yes, better start digging for coal. A Chinese coalmine in Australia is expected to deliver 900 million AUD and a thousand jobs according the a dutch news site (last Friday). A few people however don't like a big hole in the land where their ancestors used to live. Same news item on The Guardian.
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 26, 2020 1:37

I came up with an idea for a bicycle...

You have two spring loaded pedals , out front..

So you can pedal one after the other , or both pedals at the same time , for more power going up hills...
You have a big tire in back , then a seat and then the pedal bar out front.. with the pedal sliders..

It's what they call a "Recumbent" design...

It would also be good for people with only one leg.. Then they can ride a bicycle like they couldn't before...

Not sure if it would have a steering wheel , or long handlebars , stretching back to the seat...

The pedals would be like a lawn mower , you pull the string and it sucks it back in...
It would be a bike that could win the "Tour de France"

I was going to write and FB program , to show how it would work , but couldn't figure out how to do the animation...
Richard
Posts: 3029
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jul 26, 2020 1:40

badidea wrote:Yes, better start digging for coal.
Coal is a dirty and addictive habit. It destroys the users and the dealers, along with the environment.
Coal will destroy the economy like an addicts budget, if it cannot be controlled.

What we really need is an FB mine, somewhere we can dig up new algorithms that have never been seen before.

I dreamt that a shelf of books was eaten by silverfish, leaving only a thick soft layer of black letters on the shelf. The nightmare was trying to put them back together. They were black against black, difficult to pick up, and is was difficult to get them back into a sensible order without an intact dictionary.
The lesson? Recycling is hard to do.
It is easier to manufacture new letters as they are needed than it is to recycle the old ones.
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 26, 2020 2:17

@Richard

I've been having dreams , where I'm floating and soaring along off the ground....
Maybe it means that I'm gonna die??? or something... I'm too young to die , I'm only 54..

Dreams are usually glimpses of the future... They usually happen within 20 years of the dream...

I read a book in the library called "The Initiate Into The Hermetics" ( A which craft book of the "Golden Dawn" society.. )
And in the book they teach you how to fly...

Maybe that's what I'm; dreaming???
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 26, 2020 19:03

@Coder Jeff

Is it okay to post a compression code directed at Dodicat??

Me and him have been playing with compression for quite awhile...
He wrote the Zlib patch code for me to call the Zlib library from FB..

The code is a little confusing...
1,000,000 bytes in ; only compresses by 50% after 200 loops, And it's real slow , taking over 600 seconds , to run 200 loops...
It requires 300,000 bytes in , or more , to compress..

I need Dodicat or possibly someone else , to help me speed the code up , and to possibly help write the decompression..

The decompression is pretty simple.. Simple octal..
if the val = 0 to 3 and map = 0 then the out is 0 to 3 else if map = 1 then add 4..
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 27, 2020 1:21

@Dodicat

For Dodicat only....
No one else is to respond , unless they can help sped the code up...

Dodicat , i need to somehow speed this code up... 1,000,000 bytes takes 192 seconds to do 100 loops... for 30% compression..
Can you have a look-see.. and maybe work some of your magic on it???

I haven't yet wrote the decompression , but it's quite simple..
I'll work on it , if i can get the thing running in short time..
Else there's no reason to work on decmpresion , if i can't speed it up..

Please see the compress_loop() code..

Code: Select all


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


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


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        randomize
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100"
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100
time2 = timer

print
print  "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string outs1 = ""
    dim as string map1 = ""
    dim as string zeros = "000"
    dim as ubyte v1 , v2 , v3
    dim as string n1 , n2 , n3
    dim as ubyte ptr ubp = cptr( ubyte ptr, strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = zeros + oct( *ubp ) : ubp+= 1
        n1 = right( n1 , 3 )
       
        v1 = n1[ 0 ] - 48
        v2 = n1[ 1 ] - 48
        v3 = n1[ 2 ] - 48
       
        if v2 > 3 then v2-= 4 : map1+= "1" else map1+= "0"
        if v3 > 3 then v3-= 4 : map1+= "1" else map1+= "0"
       
        n3 =  bin( v1 ) ' zero to 3
        n3+= "0" + bin( v2 ) ' zero to 3
        if v3 = 0 then n3+= "0" else n3+= "0" + bin( v3 ) ' zero to 3
       
        outs1+= chr( val( "&B" + n3 ) )
       
        'print n1 , n2 , n3
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = " ; len( outs1 )  ', outs1   
   
    dim as string final = outs1
    'for a as longint = 1 to len( outs1 ) step 8
    '    final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )
    'next
    final+= "END"
    for a as longint = 1 to len( map1 ) step 8
        final+= chr( val( "&B" + mid( map1 , 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

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

Re: Squares

Postby dodicat » Jul 27, 2020 20:11

Hi Albert.
I think you should do the decompress, then start to optimize both sections.
It would be nice to see a working model, each way, no matter how slow.
I have to set up a new computer and try to get data from my hard drive from my broken one.
Some stuff I didn't back up on a stick, silly me.
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 27, 2020 20:22

@Dodicat

All right Dodi.... I'll fumble along on my own....

For the decompression ,
You just loop thru all 256 values and recreate the string like the compression..
And then compare it to the input to see which output matches the input.. Then you have your output decpomp values...For the output...

No body wants to wait 3 whole minutes , to get 30% compression...
If i can't speed it up , then its worthless..

For the decompression , Looping 0 to 255 fro each input byte.. would take 10 times longer than the compression...
So there's no reason to write the decompression , if i can't get the formula sped up ,,
I need to get the timing down to under a minute for 1,000,000 bytes in... Else its as worthless as my other of my ( non-functional ) formulas..
dodicat
Posts: 6630
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jul 27, 2020 22:27

n1=right("00"+oct(chrs[a-1]),3)
does instead of your pointer in the loop, but it is only a fraction faster.
albert
Posts: 5884
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 28, 2020 0:59

@Dodicat

The de-compressor , looping thru all 256 values for each input byte..
Would take some number , up to 256 times longer , to run , than the compressor..

So it's no good...
I got to rack my brains and find another formula that compresses... and compresses faster..

Just doing a ? = oct( byte) : out = rtrim( ? , "0" ) works...
But you don't know how many digits are in the original oct( byte )
If you put in a binary map of the trimmings , it expands...??

Back to the drawing board!!! ( yet again )

Return to “General”

Who is online

Users browsing this forum: Google [Bot] and 3 guests