Squares

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

Re: Squares

Postby albert » Jul 20, 2019 0:12

@Dodicat

In the compress_loop() we have:

n1 = mid(binari,a,3)

if n1="000" then outs+="0" : map+="00"
if n1="001" then outs+="1" : map+="00"

if n1="010" then outs+="0" : map+="01"
if n1="011" then outs+="1" : map+="01"

if n1="100" then outs+="0" : map+="10"
if n1="101" then outs+="1" : map+="10"

if n1="110" then outs+="0" : map+="1"
if n1="111" then outs+="1" : map+="1"

Were trying to find and locate and isolate the "1"'s ( single 1's) from "110" and "111" inputs...( map+="1" )

The solitary 1's have to be expanded to "11"
albert
Posts: 4918
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 20, 2019 16:58

@Dodicat

I made it so it tells you how many "1's" were looking for..

I think if you start at the end of "map" and work backwards by 2's and look for "11" ??

Code: Select all



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

screen 19

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))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp=s
        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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string binari=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        n1 = zeros + bin( chrs[a-1] )
        binari+=right(n1,8)
    next
   
    'we need to make binari and even multiple of 3
   
    print "c inp = " ; len(chrs)
    print "c bin = " ; len(binari) , binari
   
    dim as string bin_count
    dim as longint count = 0
    dim as string str1
    dim as longint dec1
    do
        str1 = str(len(binari)/3)
        dec1=instr(1,str1,".")
        if dec1<>0 then binari+="0" : count+=1
    loop until dec1=0
    bin_count = chr(count)
   
    print "c bin = " ; len(binari) , binari
   
    dim as string outs= ""
    dim as string map= ""
    dim as longint ones=0
    for a as longint = 1 to len(binari) step 3
       
        n1 = mid(binari,a,3)
       
        if n1="000" then outs+="0" : map+="00"
        if n1="001" then outs+="1" : map+="00"
       
        if n1="010" then outs+="0" : map+="01"
        if n1="011" then outs+="1" : map+="01"
       
        if n1="100" then outs+="0" : map+="10"
        if n1="101" then outs+="1" : map+="10"
       
        if n1="110" then outs+="0" : map+="1" : ones+=1
        if n1="111" then outs+="1" : map+="1" : ones+=1
       
    next
   
    print "c out = " ; len(outs) , outs
    print "c map = " ; len(map) , map
    print
    print "c ones = " ; ones
    print
   
    'we need to make outs and map and even multiple of 8
    dim as string out_count
    count = 0
    do
        str1 = str(len(outs)/8)
        dec1=instr(1,str1,".")
        if dec1<>0 then outs+="0" : count+=1
    loop until dec1=0
    out_count = chr(count)
   
    dim as string map_count
    count = 0
    do
        str1 = str(len(map)/8)
        dec1=instr(1,str1,".")
        if dec1<>0 then map+="0" : count+=1
    loop until dec1=0
    map_count = chr(count)

    dim as string final_out = ""
    for a as longint = 1 to len(outs) step 8
        final_out+=chr(valulng("&B"+mid(outs,a,8)))
    next
    final_out+="END"
    for a as longint = 1 to len(map) step 8
        final_out+=chr(valulng("&B"+mid(map,a,8)))
    next
   
    final_out = chr(ones) + bin_count + out_count + map_count + final_out
   
    print "c fin = "  ; len(final_out) ', binari
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as longint ones = asc(left(chrs,1))
    chrs = mid(chrs,2)
    dim as longint bin_count = asc(left(chrs,1))
    chrs=mid(chrs,2)
    dim as longint out_count = asc(left(chrs,1))
    chrs=mid(chrs,2)
    dim as longint map_count = asc(left(chrs,1))
    chrs=mid(chrs,2)
       
    dim as longint place = instr(1,chrs,"END")
    dim as string outs = left(chrs,place-1)
    dim as string map = mid(chrs,place+3)
   
    dim as string bin_outs=""
    dim as string zeros = "00000000"
    dim as string n1
    for a as longint = 1 to len(outs) step 1
        n1 = zeros + bin( outs[a-1] )
        bin_outs+=right(n1,8)
    next
    bin_outs = left(bin_outs,len(bin_outs)-out_count)
   
    dim as string bin_map=""
    for a as longint = 1 to len(map) step 1
        n1 = zeros + bin( map[a-1] )
        bin_map+=right(n1,8)
    next
    bin_map = left(bin_map,len(bin_map)-map_count)
   
    print "d out = "    ; len(bin_outs) , bin_outs
    print "d map = " ; len(bin_map) , bin_map
   
    dim as string bin_0 = string( len(bin_map) , chr(0) )
    for a as longint = 1 to len(bin_map) step 1
        if mid(bin_map,a,1) = "0" then mid(bin_0,a,1) = "0"
    next
   
    dim as string bin_1 = string( len(bin_map) , chr(0) )
    for a as longint = 1 to len(bin_map) step 1
        if mid(bin_map,a,1) = "1" then mid(bin_1,a,1) = "1"
    next
   
    print
    print "d zer = "   ; len(bin_0) , bin_0
    print "d one = " ; len(bin_1) , bin_1
   
    dim as string outputs = string(len(bin_map),chr(0))
   
    place=0
    do
        place = instr(place+1,bin_map,"1001")
        mid(outputs,place,4) = "1001"
        mid(bin_map,place,4) = "    "
    loop until place = 0
   
    place=0
    do
        place = instr(place+1,bin_map,"00")
        mid(outputs,place,2) = "00"
        mid(bin_map,place,2) = "  "
    loop until place = 0
   
    place=0
    do
        place = instr(place+1,bin_map,"01")
        mid(outputs,place,2) = "01"
        mid(bin_map,place,2) = "   "
    loop until place = 0
   
    place=0
    do
        place = instr(place+1,bin_map,"10")
        mid(outputs,place,2) = "10"
        mid(bin_map,place,2) = "   "
    loop until place = 0
   
    print
    print "c ones = " ; ones
    print
    print "d map = " ; len(bin_map) , bin_map
    print "d out = " ; len(outputs) , outputs
   
       
    dim as string final_out = ""
   
    return final_out

end function

badidea
Posts: 1421
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Jul 20, 2019 19:35

Still trying the impossible?
E.g. 11011 can be 1, 1, 01, 1 or 1, 10, 1, 1
coderJeff
Site Admin
Posts: 2964
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Squares

Postby coderJeff » Jul 20, 2019 20:08

albert wrote:For my "Time Rhyme" program:


So, what are you doing? Just testing our limits? Need a time-out away from fb.net? I trust Imortis to make good choices even had we not discussed what to do with this nonsense first. Please be mindful of our readers and keep it clean. Thanks.
albert
Posts: 4918
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 21, 2019 16:51

@coderjeff
@imortis

I'll keep it to just posting code.... and asking for programming help...I'll keep everything on topic...
albert
Posts: 4918
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 21, 2019 16:56

@Dodicat
@Richard

This code is 1:1 compression.. But I'd like to figure out the de-compression, anyways.

Keep pressing a key the next compression.

It's sometimes de-compressing okay. but mostly not..

Can one of you guys help??

Code: Select all


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

screen 19

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))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp=s
        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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as longint v1
    for a as longint = 1 to len(chrs) step 1
       
        v1 = chrs[a-1]
       
        if v1 mod 2 = 0 then chrs[a-1] = ( chrs[a-1] \ 2 )
       
    next
   
    dim as string final_out = chrs
   
    print "c fin = "  ; len(final_out) ', binari
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as longint v1
    for a as longint = 1 to len(chrs) step 1
       
        v1 = chrs[a-1]
       
        if v1 mod 2 = 0 then chrs[a-1] = ( chrs[a-1] * 2 )
       
    next
   
    dim as string final_out = chrs
   
    return final_out

end function

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

Re: Squares

Postby albert » Jul 22, 2019 0:17

@Richard
@Dodicat

I got compression without Zlib... Now to write the de-compressor...

Can one of you two or someone else, help with the de-compressor?

Code: Select all


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

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 10000
        s+=chr(Int(Rnd*256))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp=s
        do'for a as longint = 1 to 200 step 1
            dim as longint chk = len(comp)-1
            comp = compress_loop(comp)
            if len(comp) = chk then exit do
        loop
        '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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string binari1 = ""
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
       
        n1 = str( chrs[a-1] )
       
        if len(n1) < 3 then n1+= "0"
       
        binari1+=n1
       
    next
   
    dim as string final_out = ""
    for a as longint = 1 to len(binari1) step 3
        final_out+=chr(valulng(mid(binari1,a,3)))
    next
   
    print "c fin = "  ; len(final_out) ', binari
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as string final_out = chrs
   
    return final_out

end function

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

Re: Squares

Postby albert » Jul 22, 2019 1:09

@Richard
@Dodicat

An update!!

It was sometimes getting stuck , I fixed the bug... Now sometimes the output = the input instead of being 1 lower.

Can someone help write the de-compressor ????

It compresses 100,000 bytes to less than 10,000 in 7-8 seconds..
It compresses 1,000,000 bytes to less than 20,000 in 80 seconds..

Code: Select all



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

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 10000
        s+=chr(Int(Rnd*256))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp=s
        do'for a as longint = 1 to 200 step 1
            dim as longint chk = len(comp) - 1
            comp = compress_loop(comp)
            if len(comp) >= chk then exit do
        loop
        '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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string binari1 = ""
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
       
        n1 = str( chrs[a-1] )
       
        if len(n1) < 3 then n1+= "0"
       
        binari1+=n1
       
    next
   
    dim as string final_out = ""
    for a as longint = 1 to len(binari1) step 3
        final_out+=chr(valulng(mid(binari1,a,3)))
    next
   
    print "c fin = "  ; len(final_out) ', binari
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as string final_out = chrs
   
    return final_out

end function

Imortis
Moderator
Posts: 1625
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: Squares

Postby Imortis » Jul 22, 2019 5:03

albert wrote:@coderjeff
@imortis

I'll keep it to just posting code.... and asking for programming help...I'll keep everything on topic...


See that you do please. That's two times I have had to edit a post. On three I will be recommending a temporary ban. Please don't make me do that.
dodicat
Posts: 5893
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jul 22, 2019 10:34

Albert, I think your almost impossible tasks (and trying to resolve them) are sometimes spilling out from your subconscious to your keyboard.
It is only human nature of course, none of us are happy with a block in our way.
Why don't you compose a compress and decompress step by step together.
As soon as you get one bit done in one routine, you can undo it in another, one piece at a time.
I know advice is easy to give -- and all that.
Last year I was so engrossed in something on this computer, I wanted to resolve the issue. When I stood up the outside of my right foot was numb.
I was dragging a leg for several weeks while walking the dogs.
Seemingly I was sitting for too long in one position, and caused some nerve damage.
So, there are hidden dangers in FreeBASIC.
albert
Posts: 4918
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jul 22, 2019 15:20

@Dodicat

Soon ; i should have it working!!!

I've been analyzing the outputs , and i think i got it figured out..
Now it's just a matter of fumbling around till i get it working..

In the compression , final_out+= chr( 3 nums ) , sometimes the "3 nums" are greater than 255. ?? How to proceed??


Code: Select all



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

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 10
        s+=chr(Int(Rnd*256))'+8)
    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
        '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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string binari = ""
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
       
        n1 = str( chrs[a-1] )
       
        if len(n1) < 3 then n1 = "0" + n1
       
        binari+=n1
       
        print n1
           
    next
   
    print "c bin = " ; len(binari) , binari
   
    dim as longint count=0
    dim as string str1
    dim as longint dec1
    do
        str1=str(len(binari)/3)
        dec1=instr(1,str1,".")
        if dec1<> 0 then binari ="0" + binari : count+=1
    loop until dec1 = 0
   
   
    dim as string final_out = ""
    for a as longint = 1 to len(binari) step 3
        final_out+=chr(valulng(mid(binari,a,3)))
    next
   
    final_out = chr(count) + final_out
   
    'print "c fin = "  ; len(final_out) ', binari
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as longint count = asc(left(chrs,1))
   
    chrs=mid(chrs,2)
   
    dim as string binari = ""
    dim as string n1
    for a as longint = 1 to len(chrs) step 1
        binari+= right("000"+str( chrs[a-1] ),3)
    next
   
    binari = mid(binari , count+1)
   
    print "d bin = " ; len(binari) , binari
   
   
    dim as string final_out = chrs
   
    return final_out

end function

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

Re: Squares

Postby albert » Jul 22, 2019 18:23

@Richard

While playing and and fumbling around , trying to figure out how to handle the "3 nums" that are larger than 255..

I happened upon a cool formula..

( v1 + ( 255 * count ) ) + count = the input

Code: Select all


screen 19

dim as longint v1 , count
for a as longint = 0 to 9999
   
    v1 = asc( chr(a) ) 
   
    if a > 0 and v1 = 0 then count+=1
   
    print a , v1 , count , ( v1 + ( 255 * count ) ) + count
   
    if a mod 1000 = 0 then sleep
   
    if inkey = chr(27) then exit for
       
next

sleep
end

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

Re: Squares

Postby albert » Jul 22, 2019 19:14

works the same with:

a = 9999

v1 = asc( chr( a ) ) , same as v1 = a mod 256
count = a \ 256
answer = v1 + ( 256 * count )

Code: Select all


screen 19

dim as longint v1 , count
for a as longint = 0 to 9999
   
    v1 = asc( chr(a) ) 
   
    count = a \ 256
   
    print a , v1 , count , ( v1 + ( 256 * count ) )
   
    if a mod 1000 = 0 then sleep
   
    if inkey = chr(27) then exit for
       
next

sleep
end

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

Re: Squares

Postby albert » Jul 23, 2019 0:24

@Richard
@Dodicat

@everyone

How would you reverse the following??

n1 = 0 to 255
v1 = n1 mod 8
v2 = n1 \ 16

How would you get n1 back , out of the v1 and v2 ???
D.J.Peters
Posts: 7780
Joined: May 28, 2005 3:28

Re: Squares

Postby D.J.Peters » Jul 23, 2019 1:10

albert wrote:How would you get n1 back , out of the v1 and v2 ???
Really ?

The answer is never !

v1 = (n1 and &b00000111)
v2 = (n1 and &b11110000) shr 4

Where is bit 3 ?

Or with other words you don't encode bit 3 and this information are lost for ever in space and time :-)

May be it's a typo and you mean:
v1 = n1 mod 16
v2 = n1 \ 16
n1= v2 shl 4 or v1
or
n1 = v2 * 16 + v1

v1 is the LO 4-bit nibble of n1
v2 is the HI 4-bit nibble of n1

Joshy

Return to “General”

Who is online

Users browsing this forum: Knatterton and 11 guests