Squares

[albert]

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]

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]

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]

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]

@Dodicat

I need your help!!

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 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."
   
    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
    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_out

end function

[dodicat]

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 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."
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'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 s
End 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+="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_out

end function
  

[albert]

@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 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."
   
    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
    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_out

end function

[albert]

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]

@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 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."
   
    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
    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_out

end function

[albert]

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 String

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."
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'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 s
End 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_out

end function
  

[albert]

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 String

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."
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'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 s
End 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_out

end function
  

[coderJeff]

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 = 4
dim shared words( 0 to MAX_WORDS-1 ) as string

sub init_words()
	words(0) = "0"
	words(1) = "10"
	words(2) = "110"
	words(3) = "111"
end sub

function 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 = ret
end function

function 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 function

function 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 function

sub print_string( byref s as const string )
	for i as integer = 0 to len(s) - 1
		print hex(s[i],2);
	next
	print
	print
end sub

function 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 = ret
end function

'' main

init_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]

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]

@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 String

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."
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'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 s
End 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_out

end function
  

[coderJeff]

@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.