Squares

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

Re: Squares

Post by albert »

I've got an idea for a popular website...

Called "Twins"

You have the people create a page with their photograph...
The the website takes all the peoples pictures and scans them.

And it posts to each users photo page , all the other peoples photos that look like them..

It measures eyes , noses , foreheads , cheeks , chins, lips , shape of the head...
I guess they would need to take their glasses off to take the photo..

But then you keep checking back , as more people upload their photos...
And it keeps expanding the photos on your page , of people that look like you..

Each "Look like you photo" , comes with a name , country , city , age , and contact info , so you can communicate with people that look like you..
Or select "private", to keep it from posting your contact info...

I think it would be a very popular , website... Maybe make you a millionaire or even a billionaire...
It would have a messenger service built-in , to let you communicate with all your "Twins"...
You see an interesting photo of one of your twins , you can click on the photo and message them ( unless they selected private )..

The photo scanning computer program , ( the heart of the website ). I don't know if it could be done in FB or not???

I got the idea when i flew cross country and landed in an airport , and saw a man in the airport , that looked exactly like my brother-in-law Rick Keener..
I said ; what are you doing Rick , keeping tabs on me.. And he said my name is James.. His voice and accent , wasn't the same as Rick's
He was inline to go to another city than me...different boarding gate.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Post by albert »

I agreed , or promised , to not post compression code unless i have a decompression..

But i need help with the decompression..

s1 is a single precision var

Code: Select all

    for a as longint = 1 to len( chrs ) step 1
        
        n1 = bin( *ubp ) : ubp+= 1
        
        if len( n1 ) = 1 then which+= "1" else which+= "0"
        
        s1 = len( n1 ) / 2
        if frac( s1 ) <> 0 then s1+= .5
        
        v1 = val( "&B" + left( n1 , s1 ) )
        v2 = val( "&B" + mid( n1 , s1 + 1 ) )
        
        if v1 < v2 then 
            which+= "1"
            outs1+= hex( v1 ) + hex( v2 - v1 )
        else
            which+= "0"
            outs1+= hex( v1 ) + hex( v1 - v2 )
        end if
        
        'print n1 , which
        'sleep
        'if inkey = " " then end
        
    next    

Here's the whole code in Dodicat's Zlib code..

Compresses 1,000,000 bytes to 75% after 100 loops..
Compresses 100,000 bytes to 6% after 100 loops.
Expands less than 100,000 bytes

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 which = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1 , n2 , n3 , n4 , n5
    dim as ubyte v1 , v2 , v3 , v4
    dim as single s1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        
        n1 = bin( *ubp ) : ubp+= 1
        
        if len( n1 ) = 1 then which+= "1" else which+= "0"
        
        s1 = len( n1 ) / 2
        if frac( s1 ) <> 0 then s1+= .5
        
        v1 = val( "&B" + left( n1 , s1 ) )
        v2 = val( "&B" + mid( n1 , s1 + 1 ) )
        
        if v1 < v2 then 
            which+= "1"
            outs1+= hex( v1 ) + hex( v2 - v1 )
        else
            which+= "0"
            outs1+= hex( v1 ) + hex( v1 - v2 )
        end if
        
        'print n1 , which
        'sleep
        'if inkey = " " then end
        
    next    
    
    print "c out = " ; len( outs1 ) ' , outs1
    print "c whi = " ; len( which ) ' , which
    
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 2
        final+= chr( val( "&H" + mid( outs1 , a  , 2 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( which ) step 8
        final+= chr( val( "&B" + mid( which , 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

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

Re: Squares

Post by albert »

For the "Twins" website idea...

There's a Linux picture editing program called "Gimp" that has an outline function..
That can create outlines of facial features..

Maybe it could be done in FB ??
angros47
Posts: 2323
Joined: Jun 21, 2005 19:04

Re: Squares

Post by angros47 »

The outline effect can be done using a convolution filter (I made one in FreeBasic here: https://freebasic.net/forum/viewtopic.p ... 21#p199321). Basically, it subtracts the value of a pixel from the average value of surrounding pixels: in that way, if the pixel is on a plain part of an image, it has the same value of surrounding one, and the subtraction brings its value to zero. If the pixel is on an edge, the closest pixels have different values, so the result will be non zero, and the pixel will be visible. In this way, only edge pixels will be visible.
The algorithm used in GIMP works in the same way.

And please, STOP POSTING COMPRESSION STUFF! If you can't decompress, it means your compression algorithm is wrong. Period. So, don't ask help with the decompression. We all know that it will end with another "back to the drawing board"
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@angros47

You were right... It's a "Back to the drawing board" !!!
After playing around for 6 hours trying to write the de-compressor..

outs1+= hex( v1 ) + hex( v2 - v1 )

hex( v2 - v1 ) , trims the leading zeros , so you don't know how many bits to undo it to..

110 000 or 110 00 ?? it comes down to a "Pick & Choose"..

hex( v1 ) gives the right value , because all bin() except "0" start with a "1"

Any ideas about it?

If the input byte is 1 , 3 , 5 , 7 bits then ( v2 - v1 ) is one bit less than bin( v1 ) , otherwise both are the same length..
angros47
Posts: 2323
Joined: Jun 21, 2005 19:04

Re: Squares

Post by angros47 »

Yes, Albert, I have an idea: and the idea is that you should drop compression algorithms. You lack the theoretical knowledge, and without it, you are unable to understand that your approach is totally, absolutely wrong. It won't work. It can't work. It's less likely to work than faster than light travel (at least, FTL travel has not been absolutely proven to be impossible, while the compression you want to achieve has a mathematical proof to be impossible).

You don't want to believe me? Fine, then, believe your results. Look at the year of futile attempts you made to achieve it. Have you done any progress at all? Isn't that enough to prove you that it is not possible?
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Squares

Post by Tourist Trap »

I'm absolutely not able to do compression. I can change the representation of a number throught its base, that's all. However, if I wanted to get started in the domain, I would probably try to implement simple and well known already existing algorithm. For instance, here is a website that I find very good as a starting point:
https://ethw.org/History_of_Lossless_Da ... Algorithms
Compression Techniques

Many different techniques are used to compress data. Most compression techniques cannot stand on their own, but must be combined together to form a compression algorithm. Those that can stand alone are often more effective when joined together with other compression techniques. Most of these techniques fall under the category of entropy coders, but there are others such as Run-Length Encoding and the Burrows-Wheeler Transform that are also commonly used.

Run-Length Encoding

Run-Length Encoding is a very simple compression technique that replaces runs of two or more of the same character with a number which represents the length of the run, followed by the original character; single characters are coded as runs of 1. RLE is useful for highly-redundant data, indexed images with many pixels of the same color in a row, or in combination with other compression techniques like the Burrows-Wheeler Transform.

Here is a quick example of RLE:

Input: AAABBCCCCDEEEEEEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA

Output: 3A2B4C1D6E38A
Sometimes starting simple is not the bad way.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Tourist Trap

That run-length encoding , won't work on a string of random characters..

That's what I've been experimenting on , for over a year now..

======================================================================
One idea i had was to create a array of 0 to 255
and bring in 2 chars and put the second ( following char ) into the array of the leading char...

So every time you run into a "A" you know to pull in the next "A" following byte...
It didn't work.. So far nothing has...

I've invented many formulas that can compress data , but can't decompress it , due to duplicates in the output , or coding errors..
=====================================================================

I also tried swapping bits.. You make the chr() 8 bits , and no matter how you swap them bits around , it won't compress..

One that did compress is , bits[ 0 ] = 49 , but if you record the bit you wiped out it doesn't compress.

Richard keep telling me , "The only way to compress data , is to search for patterns"
In a string of randomly created characters , there are no patterns , there's all 256 chars , and they are all jumbled and mixed up...
coderJeff
Site Admin
Posts: 4326
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Yah-Zip

Post by coderJeff »

albert wrote:I agreed , or promised , to not post compression code unless i have a decompression..
Take a few days to read over the old posts and replies...
caseih
Posts: 2157
Joined: Feb 26, 2007 5:32

Re: Squares

Post by caseih »

albert wrote:That run-length encoding , won't work on a string of random characters..

That's what I've been experimenting on , for over a year now..
Correct. Truly random sequences of bytes cannot be compressed by any algorithm. It's mathematically impossible (and provably so I'd wager). You'll be working on it for years to come.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

If your text is purely numerical chr(48) to chr( 57) then you can do substitutions, but general asci text to numerical expands by a factor you cannot shrink by substitutions.
Like Albert, I have plugged away at this in the past.
angros47
Posts: 2323
Joined: Jun 21, 2005 19:04

Re: Squares

Post by angros47 »

albert wrote: That run-length encoding , won't work on a string of random characters..
Nothing can work on a string of random characters. The only thing that can work, if the string is REALLY random, is to just store the length of the string, and during decompression you reconstruct a string of the same length using random data (it won't be identical, but it will still be a string of random characters. If all you wanted was random characters, you don't need them to be the same ones you started with)

Otherwise, you must tell what kind of data were you trying to compress: text? code? pictures? sounds? (and no, "generic data" is not an acceptable answer)
That's what I've been experimenting on , for over a year now..
And after a year you made no progress at all. Shouldn't you consider that perhaps there is something wrong in your approach to the problem?

Code: Select all

I've invented many formulas that can compress data , but can't decompress it , due to duplicates in the output , or coding errors..
You fail to understand that, if you can't decompress, your formula is not compressing. It is just deleting.

Want a basic code that compress a file reducing its size by 100%? Here it is:

Code: Select all

KILL "file.txt"
It reduces the size of "file.txt" by 100%. Unfortunately I have no way to decompress it.... who knows why?

Your approach is just like that.
Richard keep telling me , "The only way to compress data , is to search for patterns"
Haven't you thought that perhaps, just perhaps, Richard might be right?
In a string of randomly created characters , there are no patterns , there's all 256 chars , and they are all jumbled and mixed up...
I still don't understand why you need to compress such a string. What important informations are stored in that string? Because that's the ONLY thing that matters. If the string contains no informations, you don't need to compress it. If it contains an information, all you need to do is to extract such information (and likely it will contain a pattern)
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

Albert wrote:Richard keep telling me , "The only way to compress data , is to search for patterns"
In a string of randomly created characters , there are no patterns , there's all 256 chars , and they are all jumbled and mixed up...
If the randomly created characters were truly random then it might be expected that there will be some repetition, pattern or run somewhere. If such a pattern can be recognised, then it can be compressed by creating a dictionary. Random data will compress, but not by very much at all. Meanwhile, it is easy to prove that a fixed algorithm, such as Albert has been trying to find, cannot work.

If you look at random noise for long enough you will begin to believe you see patterns, that are really delusions. Pareidolia is a type of apophenia, which is a more generalised term for seeing patterns in random data. Some common examples are seeing a likeness of a chicken in the clouds or an image of a man on the surface of a moon. Those patterns cannot be used to compress data because they occur only once in the data, and once in the mind of the deluded victim.
https://en.wikipedia.org/wiki/Pareidolia
https://en.wikipedia.org/wiki/Apophenia
Muttonhead
Posts: 139
Joined: May 28, 2009 20:07

Re: Squares

Post by Muttonhead »

*cough*...very early in the morning staring sleepily at the bathroom floor tiles...
https://1drv.ms/u/s!AsTPhVzcfzRriKZsb10 ... Q?e=tCxPQc
https://1drv.ms/u/s!AsTPhVzcfzRriKZtcVQ ... A?e=PF7436
Hmmm....
paul doe
Moderator
Posts: 1733
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Squares

Post by paul doe »

God, much like Pareidolia, works in mysterious ways too:
Image
Locked