## Squares

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

### Re: Squares

This compresses as well....

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="00"
if n1="01" then outputs+="01"
if n1="10" then outputs+="10"
if n1="11" then outputs+="0001"
next

10 bits output....

You step through "outputs" by 2's and if you hit a zero you read ahead to see if it's a 0001...
But 00 01 , snafu!!
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

After playing aorund for a couple days , trying every conceivable combination...

I've come to a conclusion ; that it only compresses , if combinations of bits , equal other combinations of bits..

If combinations , equal other combinations , then it develops patterns that make it compressible..

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="1"
if n1="01" then outputs+="10"
if n1="10" then outputs+="100"
if n1="11" then outputs+="1000"
next

Won't compress , But if you turn the first bit "1" into a "0" it compresses like crazy...( 98%)

This one compresses pretty good,,,(92% after 40 loops)

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="0"
if n1="01" then outputs+="01"
if n1="10" then outputs+="11"
if n1="11" then outputs+="101"
next
I can't see any combo's that equate to other combos....
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Back in 2003 , i had a communion.. Space ship and orbs going up & down in the beam..
The orbs were making rainbow circles on the ground..

I think i figured out how the space ships operate.. ( what makes them move. )

if you create a magnetic field in space and then repel that field , you can move...
Maybe a coil within a coil???
The outer coil creates a field and then turns off , and then the inner coil comes on and repels that field before it collapses..

The field would collapse at the speed of light, so the outer coil would need to be a certain size, to allow the inner coil to come on and repel it in time..

I didn't get to see the inside of the spaceship , or see any aliens, just the orbs and the beam..

Maybe i invented the Star-Trek , warp coil???

Some who have been abducted , say the tube at the center of the spaceship , makes a low frequency hum.. So the coils might be using an audio frequency...

It might be the tube they saw a the center of the space ship , can rotate on a 3d axis , and which ever way it is pointing , that's the way you move...

High tension lines make a low frequency hum, so maybe they use a real high voltage on the coils at a low frequency???
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I came up with an idea for electric cars??

You have a capacitor made up of alternating carbon and aluminum plates..
You put a voltage on the aluminum plates and draw off the carbon plates..

The carbon plates would have resistance , so they would discharge slowly.. While the aluminum plates would charge quickly.
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I got a formula that compresses...( 80% after 40 loops.. )

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="0"
if n1="01" then outputs+="01"
if n1="10" then outputs+="001"
if n1="11" then outputs+="11"
next

Since there's no combo that equals "11" you can start the search by searching for "11"'s

I need help doing the de-compression...( searching the output string for the bits..)
I'm sometimes , getting a stray "10" or "1", Can't have a "10" or a single "1"..

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do       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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari        dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="0"        if n1="01" then outputs+="01"        if n1="10" then outputs+="001"        if n1="11" then outputs+="11"    next        print "c bin = "  ; len(outputs) , outputs        dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0        dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        final_out = str(count) + final_out        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string            dim as ubyte count = val(left(chrs,1))        chrs=mid(chrs,2)        dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next        binari=left(binari,len(binari)-count)        print "d bin = "  ; len(binari) , binari        dim as longint place=0    place=0    do        place = instr(place+1,binari,"0111")        mid(binari,place,4) = string(4,chr(0))    loop until place=0    place=0    do        place = instr(place+1,binari,"00111")        mid(binari,place,5) = string(5,chr(0))    loop until place=0        place=0    do        place = instr(place+1,binari,"11")        mid(binari,place,2) = string(2,chr(0))    loop until place=0        place=0    do        place = instr(place+1,binari,"01")        mid(binari,place,2) = string(2,chr(0))    loop until place=0        print "d bin = "  ; len(binari) , binari        dim as string final_out = chrs        return final_outend function`
dodicat
Posts: 6469
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Not quite sure of your method, but you can use a find and replace function instead of all those loops in the decompress.

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do      ' 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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function findAndReplace(instring As String,find As String,replace As String) As String    dim as string s=instring     dim as long position=Instr(s,find)    While position>0        s=Mid(s,1,position-1) & replace & Mid(s,position+Len(find))        position=Instr(position+Len(replace),s,find)    Wend    return sEnd FunctionFunction compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari        dim as string outputs=""       for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="0"        if n1="01" then outputs+="01"       if n1="10" then outputs+="001"        if n1="11" then outputs+="11"    next          print "c bin = "  ; len(outputs) , outputs        dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0        dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        final_out = str(count) + final_out        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string            dim as ubyte count = val(left(chrs,1))        chrs=mid(chrs,2)        dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next               binari=left(binari,len(binari)-count)        print "d bin = "  ; len(binari) , binari          ' dim as longint place=0   ' place=0   ' do       ' place = instr(place+1,binari,"0111")       ' mid(binari,place,4) = string(4,chr(0))    'loop until place=0   ' place=0    'do    '    place = instr(place+1,binari,"00111")       ' mid(binari,place,5) = string(5,chr(0))    'loop until place=0       ' place=0   ' do       ' place = instr(place+1,binari,"11")       ' mid(binari,place,2) = string(2,chr(0))    'loop until place=0       ' place=0   ' do       ' place = instr(place+1,binari,"01")       ' mid(binari,place,2) = string(2,chr(0))    'loop until place=0                binari=findAndReplace(binari,"0111",chr(0,0,0,0))    binari=findAndReplace(binari,"00111",chr(0,0,0,0,0))    binari=findAndReplace(binari,"11",chr(0,0))    binari=findAndReplace(binari,"01",chr(0,0))    'binari=sar(binari,chr(0),"0")        print "d bin = "  ; len(binari) , binari        dim as string final_out = chrs        return final_outend function  `
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Your Search & Replace still leaves some stray "10" and "1" : that can't happen... cant have 10 or 1 it's not in the bits...

This one is easier.... (Compresses 96% after 40 loops)

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="0"
if n1="01" then outputs+="01"
if n1="10" then outputs+="001"
if n1="11" then outputs+="0001"
next

you search for
0 0001
0 001
0 01

then you search for
0001
001
01
0

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do       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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari        dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="0"        if n1="01" then outputs+="01"        if n1="10" then outputs+="001"        if n1="11" then outputs+="0001"    next        print "c bin = "  ; len(outputs) , outputs        dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0        dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        final_out = str(count) + final_out        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string            dim as ubyte count = val(left(chrs,1))        chrs=mid(chrs,2)        dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next        binari=left(binari,len(binari)-count)        print "d bin = "  ; len(binari) , binari        dim as longint place=0    place=0    do        place = instr(place+1,binari,"00001")        mid(binari,place,5) = string(5,chr(0))    loop until place=0    place=0    do        place = instr(place+1,binari,"0001")        mid(binari,place,4) = string(4,chr(0))    loop until place=0        place=0    do        place = instr(place+1,binari,"001")        mid(binari,place,3) = string(3,chr(0))    loop until place=0        place=0    do        place = instr(place+1,binari,"01")        mid(binari,place,2) = string(2,chr(0))    loop until place=0        print "d bin = "  ; len(binari) , binari        dim as string final_out = chrs        return final_outend function`
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

After i cancel the bits out in the "binari" string , I've got to assign the proper values to an output string...
Only then , to compare the output to the input , will i know if its working or not..
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Here's another try..

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="1"
if n1="01" then outputs+="10"
if n1="10" then outputs+="010"
if n1="11" then outputs+="0100"
next

( compresses 68% after 40 loops. )

you search for:
1 - 10
010 - 010
0100
010
10
1

Code: Select all

`Declare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do       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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next        print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari        dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="1"        if n1="01" then outputs+="10"        if n1="10" then outputs+="010"        if n1="11" then outputs+="0100"    next        print "c bin = "  ; len(outputs) , outputs        dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0        dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next        final_out = str(count) + final_out        print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string            dim as ubyte count = val(left(chrs,1))        chrs=mid(chrs,2)        dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next        binari=left(binari,len(binari)-count)        print "d bin = "  ; len(binari) , binari        dim as longint place=0    place=0    do        place = instr(place+1,binari,"110")        mid(binari,place,3) = string(3,chr(0))    loop until place=0    place=0    do        place = instr(place+1,binari,"0100")        mid(binari,place,4) = string(4,chr(0))    loop until place=0        place=0    do        place = instr(place+1,binari,"010")        mid(binari,place,4) = string(4,chr(0))    loop until place=0    place=0    do        place = instr(place+1,binari,"10")        mid(binari,place,3) = string(3,chr(0))    loop until place=0    'place=0    'do    '    place = instr(place+1,binari,"0")    '    mid(binari,place,1) = string(1,chr(0))    'loop until place=0        print "d bin = "  ; len(binari) , binari        dim as string final_out = chrs        return final_outend function`
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I'm sometimes getting a stray "0" , but i think this formula works..

Just have to work on the Search & Replace...

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="1"
if n1="01" then outputs+="10"
if n1="10" then outputs+="011"
if n1="11" then outputs+="010"
next

Code: Select all

`Declare Function findAndReplace(instring As String,find As String,replace As String) As StringDeclare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do       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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function findAndReplace(instring As String,find As String,replace As String) As String    dim as string s=instring    dim as long position=Instr(s,find)    While position>0        s=Mid(s,1,position-1) & replace & Mid(s,position+Len(find))        position=Instr(position+Len(replace),s,find)    Wend    return sEnd Function'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next       print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari       dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="1"        if n1="01" then outputs+="10"        if n1="10" then outputs+="011"        if n1="11" then outputs+="010"    next     print "c bin = "  ; len(outputs) , outputs       dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0       dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next       final_out = str(count) + final_out       print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string           dim as ubyte count = val(left(chrs,1))       chrs=mid(chrs,2)       dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next       binari=left(binari,len(binari)-count)       print "d bin = "  ; len(binari) , binari           'if n1="00" then outputs+="1"        'if n1="01" then outputs+="10"        'if n1="10" then outputs+="010"        'if n1="11" then outputs+="101"       binari=findAndReplace( binari,"010" ,chr(0,0,0) )    binari=findAndReplace( binari,"011" ,chr(0,0,0))    binari=findAndReplace( binari,"110" ,chr(0,0,0))    binari=findAndReplace( binari,"10"   ,chr(0,0))        print "d bin = "  ; len(binari) , binari       dim as string final_out = chrs       return final_outend function  `
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Getting closer!!!

dim as string outputs=""
for a as longint = 1 to len(binari) step 2
n1=mid(binari,a,2)
if n1="00" then outputs+="00"
if n1="01" then outputs+="01"
if n1="10" then outputs+="10"
if n1="11" then outputs+="001"
next

You step through the string by "2"'s if you run into a "0" you search ahead to see if its a "001"
Sounds simple , but i'm getting wrong values..
Sometimes ; it de-compresses okay...And sometimes not...

Need Dodicat to the rescue!!

Code: Select all

`Declare Function findAndReplace(instring As String,find As String,replace As String) As StringDeclare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do       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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function findAndReplace(instring As String,find As String,replace As String) As String    dim as string s=instring    dim as long position=Instr(s,find)    While position>0        s=Mid(s,1,position-1) & replace & Mid(s,position+Len(find))        position=Instr(position+Len(replace),s,find)    Wend    return sEnd Function'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next       print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari       dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="00"        if n1="01" then outputs+="01"        if n1="10" then outputs+="10"        if n1="11" then outputs+="001"    next     print "c bin = "  ; len(outputs) , outputs       dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0       dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next       final_out = str(count) + final_out       print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string           dim as ubyte count = val(left(chrs,1))       chrs=mid(chrs,2)       dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next       binari=left(binari,len(binari)-count)       print "d bin = "  ; len(binari) , binari           'if n1="00" then outputs+="00"        'if n1="01" then outputs+="01"        'if n1="10" then outputs+="10"        'if n1="11" then outputs+="001"      dim as string outputs=""   dim as ubyte toggle = 0   for a as longint = 1 to len(binari) step 2       n1 = mid(binari,a,2)       toggle = 0       if left(n1,1) = "0" then             n1 = mid(binari,a,3)             if n1 = "001" then                 outputs+="11"                a+=1                toggle=1            end if        end if        if toggle = 0 then             n1 = mid(binari,a,2)            outputs+=n1        end if    next        print "d out = "  ; len(outputs) , outputs       dim as string final_out = ""    for a as longint = 1 to len(outputs) step 64        final_out+=mklongint(valulng("&B"+mid(outputs,a,64)))    next       return final_outend function  `
coderJeff
Posts: 3175
Joined: Nov 04, 2005 14:23
Contact:

### Re: Squares

Albert, fascinating, such a distraction for me thanks :). I should really unsubscribe this topic...

if n1="00" then outputs+="1"
if n1="01" then outputs+="10"
if n1="10" then outputs+="011"
if n1="11" then outputs+="010"

duplicates:
"00 01" => "1010"
"00 11" => "1010"
"00 10" => "1011"
"01 00 00" => 1011"

Here's something to play with using a dictionary that won't give duplicates. It encodes/decodes between fixed 2-bit length and variable 1-3 bit length words, only. Doesn't do any compress/decompress as it just showing the encode/decode part. And assumes only four words in the dictionary and that the length of the bit stream is encoded elsewhere. The total length to decode must be known, since there is no word in the dictionary to indicate "end of stream":
"00" = > "0"
"01" => "10"
"10" => "110"
"11" => "111"

Code: Select all

`const MAX_WORDS = 4dim shared words( 0 to MAX_WORDS-1 ) as stringsub init_words()   words(0) = "0"   words(1) = "10"   words(2) = "110"   words(3) = "111"end subfunction string_to_bits( byref s as const string ) as string   dim ret as string = ""   for i as integer = 0 to len(s)-1      ret &= bin( s[i], 8 )   next   function = retend functionfunction bits_to_string( byref s as const string ) as string   dim ret as string = ""   '' assume input length is multiple of 8   assert( (len(s) mod 8) = 0 )   for i as integer = 1 to len(s) step 8      ret &= chr( cubyte( "&b" & mid( s, i, 8 ) ) )    next   function = ret end functionfunction encode( byref s as const string ) as string   dim bits as string = ""   '' loop through every byte in 's'   for i as ulongint = 0 to len(s) - 1      dim b as ubyte = s[i]      '' look at each pair of bits, most significant to least significant      for j as integer = 0 to 7 step 2         '' look up word from the dictionary         bits &= words( cint( "&b" & mid( bin( b, 8 ), j+1, 2 ) ) )      next   next      '' pad bits to multiple of 8   bits &= string( (8 - (len(bits) mod 8) mod 8), "0" )   function = bits_to_string( bits )end function function decode( byref s as const string, byval n as integer ) as string   dim bits as string = string_to_bits( s )   dim i as integer = 1, count as integer = 0   dim ret as string = ""   '' loop through entire bit string      while i <= len(bits) and (count < n*8 )      '' check for words      for j as integer = 0 to MAX_WORDS-1         if( mid( bits, i, len(words(j)) ) = words(j) ) then            ret &= bin( j, 2 )             i += len(words(j))            count += 2            continue while         end if                  next      print "bad input for decode"      exit while   wend      function = bits_to_string( ret )end functionsub print_string( byref s as const string )   for i as integer = 0 to len(s) - 1      print hex(s[i],2);   next   print   printend subfunction random_string( byval n as integer ) as string   dim ret as string = ""   for i as integer = 1 to n      ret &= chr( cint( rnd * 256 ) )   next   function = retend function'' maininit_words()dim s1 as string = random_string( 40 )print "Input String:"print_string( s1 )print "Encoded String:"dim s2 as string = encode( s1 )print_string( s2 )print "Output String:"dim s3 as string = decode( s2, len(s1) )print_string( s3 )`

The fundamental flaw is that the input data is random:

Given random data and translation of:
"00" = > "0", "01" => "10", "10" => "110", "11" => "111"

Then:
25% chance the output will be shorter than input: "00" = > "0"
25% chance the output will be same size as input: "01" => "10"
50% chance the output will be longer than input "10" => "110", "11" => "111"

If the input data was not random, you might have a chance. Count up the number of "00"'s "01"'s, "10"'s and "11"'s and you can probably take an educated guess if the data will compress. If they are all about the same count, it won't compress.

Now, you are not just encoding, but rather feeding it back to the compressor, so you might get lucky that the encoded string compresses. I'm going to guess 50% chance.
coderJeff
Posts: 3175
Joined: Nov 04, 2005 14:23
Contact:

### Re: Squares

albert wrote: if n1="00" then outputs+="00"
if n1="01" then outputs+="01"
if n1="10" then outputs+="10"
if n1="11" then outputs+="001"

Dude, you keep changing your post!

Duplicates:
"11 11" => "001001"
"00 10 01" => "001001"

From the output, impossible to know the original input.
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@coderJeff

' words(0) = "0"
' words(1) = "10"
' words(2) = "110"
' words(3) = "111"
Doesn't compress ....
=========================================

@Dodicat

My formula , It's decompressing okay sometimes...

00
01
10
001

got to alter the way it looks ahead..

when you run into a 0 it could be
01
00 00
00 01
001
00 10
00 001

When you figure out the "0" then you have to increment the for,next pointer by 1

It might take several loops through the binari string... to see if there's any stray bits left behind...

Need Dodicat to the rescue!!!

Code: Select all

`Declare Function findAndReplace(instring As String,find As String,replace As String) As StringDeclare Function compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1,time2,time3,time4do       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."       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function findAndReplace(instring As String,find As String,replace As String) As String    dim as string s=instring    dim as long position=Instr(s,find)    While position>0        s=Mid(s,1,position-1) & replace & Mid(s,position+Len(find))        position=Instr(position+Len(replace),s,find)    Wend    return sEnd Function'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string binari=""    dim as string n1    dim as string zeros = string(64,"0")    dim as ulongint ptr ubp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        n1 = bin(*ubp) : ubp+=1        n1 = right(zeros+n1,64)        binari+= n1    next       print "c inp = "  ; len(chrs) ', binari    print "c bin = "  ; len(binari) , binari       dim as string outputs=""    for a as longint = 1 to len(binari) step 2        n1=mid(binari,a,2)        if n1="00" then outputs+="00"        if n1="01" then outputs+="01"        if n1="10" then outputs+="10"        if n1="11" then outputs+="001"    next     print "c bin = "  ; len(outputs) , outputs       dim as ubyte count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outputs)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outputs+="0" : count+=1    loop until dec1=0       dim as string final_out = ""    for a as longint = 1 to len(outputs) step 8        final_out+=chr(val("&B"+mid(outputs,a,8)))    next       final_out = str(count) + final_out       print "c out = "; len(final_out)           return final_out       end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string           dim as ubyte count = val(left(chrs,1))       chrs=mid(chrs,2)       dim as string binari=""    dim as string n1    dim as string zeros = string(8,"0")    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        n1 = right(zeros+n1,8)        binari+= n1    next       binari=left(binari,len(binari)-count)       print "d bin = "  ; len(binari) , binari           'if n1="00" then outputs+="00"        'if n1="01" then outputs+="01"        'if n1="10" then outputs+="10"        'if n1="11" then outputs+="001"      dim as string outputs=""   dim as ubyte toggle = 0   for a as longint = 1 to len(binari) step 2       n1 = mid(binari,a,2)       toggle = 0       if left(n1,1) = "0" then             n1 = mid(binari,a,3)             if n1 = "001" then                 outputs+="11"                a+=1                toggle=1            end if        end if        if toggle = 0 then             n1 = mid(binari,a,2)            outputs+=n1        end if    next        print "d out = "  ; len(outputs) , outputs       dim as string final_out = ""    for a as longint = 1 to len(outputs) step 64        final_out+=mklongint(valulng("&B"+mid(outputs,a,64)))    next       return final_outend function  `
coderJeff
Posts: 3175
Joined: Nov 04, 2005 14:23
Contact:

### Re: Squares

albert wrote:@coderJeff

' words(0) = "0"
' words(1) = "10"
' words(2) = "110"
' words(3) = "111"
Doesn't compress ....

Exactly... well compressed data looks a lot like random data.

Albert, you are missing the point:

Given the dictionary is 00, 01, 10, 001 from your earlier post, then

Decoding "001001001001" is impossible, even if the length is known, no matter how you step through it.

"11 11 00 10 01" => "001001001001"
"00 10 01 11 11" => "001001001001"

Input lengths are the same, output lengths are the same, output is the same. Except input was different. There is no other information in the bits to determine the correct input. And, it doesn't really matter if input is multiple of 8 or not as I can just create a longer sequence to make it multiple of 8.

You get the false positive of compression because you are losing information from the original input.