#980 Banned From Forum

[Albert Redditt]

Hello Guys..

Albert Redditt Here...

I got a compressor that does not require a zipper library..
( Recursive Lossless Random Data Compression )

This compresses a string of random characters down to under 800 bytes..

FB Code:

screen 19

declare function encode( chrs as string ) as string
declare function decode( chrs as string ) as string

do

cls
print "=========================="
print "Albert Redditt Zip  ( ARZ )"
print
print "Albert Redditt"
print
print "albert_redditt@yahoo.com"
print "========================="
print
print "Press SpaceBar to exit    ( Press any other key to reloop )"
print

dim as string chrs = ""
for a as longint = 1 to 100000
    chrs+= chr( int( rnd * 256 ) )
next

dim as single t1 = timer
print
print "Input Length = " ; len( chrs )
dim as longint check1 , check2
do

    check1 = len( chrs )
    chrs = encode( chrs )
    check2 = len( chrs )

    locate 14 , 1 : print "                   "
    locate 14 , 1 : print "Size = " ; len( chrs )

    if check2 > = check1 then exit do

    if inkey = " " then end

loop
dim as single t2 = timer

print
print "Compress Time = " ; t2 - t1 ; "  Seconds"

sleep
if inkey = " " then end

loop

'=================================================
'=================================================
'Encode Loop
'=================================================
'=================================================
function encode( chrs as string ) as string

'=================================
'Turn input characters into binary
'=================================
dim as string bits = ""
dim as string * 8 n1 = "00000000"
dim as ubyte in
for a as longint = 0 to len( chrs ) - 1 step 1
    in = chrs[a]
    n1[7] = ( in mod 2 ) + 48 : in = in shr 1
    n1[6] = ( in mod 2 ) + 48 : in = in shr 1
    n1[5] = ( in mod 2 ) + 48 : in = in shr 1
    n1[4] = ( in mod 2 ) + 48 : in = in shr 1
    n1[3] = ( in mod 2 ) + 48 : in = in shr 1
    n1[2] = ( in mod 2 ) + 48 : in = in shr 1
    n1[1] = ( in mod 2 ) + 48 : in = in shr 1
    n1[0] = ( in mod 2 ) + 48 : in = in shr 1
    bits+= n1
next

dim as ubyte count = 0
do
    if len( bits ) mod 4 <> 0 then bits+= "0" : count+= 1 else exit do
loop

'=================================
'Sort hex chracters into most prevalent first
'=================================
dim as string vals( 0 to 15 )
dim as longint cnt( 0 to 15 )
dim as string s1
dim as ubyte v1
for a as longint = 1 to len( bits ) step 4
    s1 = mid( bits , a , 4 )
    v1 = val( "&B" + s1 )
    vals( v1 ) = hex( v1 )
    cnt( v1 )+= 1
next
for b as ubyte = 0 to 14
    for c as ubyte = b to 15
        if cnt( c ) > cnt( b ) then
            swap cnt( b ) , cnt( c )
            swap vals( b ) , vals( c )
        end if
    next
next
dim as string dict
for b as ubyte = 0 to 15
    dict+= vals( b )
next
'=====================================================================
'compress loop ( you can alter the m1 , mp vals ) , There's lots of combos that compress..
'=====================================================================
chrs = chr( count ) + dict
dim as string outs = ""
dim as string map = ""
dim as string m1 , mp
for a as longint = 1 to len( bits ) step 4

    s1 = mid( bits , a , 4 )

    s1 = hex( val( "&B" + s1 ) )

    if s1 = vals(00) then m1 = "10" : mp = "0"
    if s1 = vals(01) then m1 = "10" : mp = "1"
    if s1 = vals(02) then m1 = "11" : mp = "0"
    if s1 = vals(03) then m1 = "11" : mp = "1"

    if s1 = vals(04) then m1 = "00" : mp = "00"
    if s1 = vals(05) then m1 = "00" : mp = "01"
    if s1 = vals(06) then m1 = "00" : mp = "10"
    if s1 = vals(07) then m1 = "00" : mp = "11"

    if s1 = vals(08) then m1 = "01" : mp = "00"
    if s1 = vals(09) then m1 = "01" : mp = "01"
    if s1 = vals(10) then m1 = "01" : mp = "10"
    if s1 = vals(11) then m1 = "01" : mp = "11"

    if s1 = vals(12) then m1 = "101" : mp = "00"
    if s1 = vals(13) then m1 = "101" : mp = "01"
    if s1 = vals(14) then m1 = "101" : mp = "10"
    if s1 = vals(15) then m1 = "101" : mp = "11"

    outs+= m1
    map+= mp

next

for a as longint = 1 to len( outs ) step 8
    chrs+= chr( val( "&B" + mid( outs , a , 8 ) ) )
next
chrs+= "END"
for a as longint = 1 to len( map ) step 8
    chrs+= chr( val( "&B" + mid( map , a , 8 ) ) )
next

return chrs

end function
'=================================================
'=================================================
'Decode Loop
'=================================================
'=================================================
function decode( chrs as string ) as string

return chrs

end function

[Albert Redditt]

This combo compresses down to 300 bytes in 5 seconds..

    if s1 = vals(00) then m1 = "10" : mp = "0"
    if s1 = vals(01) then m1 = "10" : mp = "1"
    if s1 = vals(02) then m1 = "11" : mp = "0"
    if s1 = vals(03) then m1 = "11" : mp = "1"

    if s1 = vals(04) then m1 = "000" : mp = "0"
    if s1 = vals(05) then m1 = "001" : mp = "0"
    if s1 = vals(06) then m1 = "010" : mp = "0"
    if s1 = vals(07) then m1 = "011" : mp = "0"

    if s1 = vals(08) then m1 = "000" : mp = "1"
    if s1 = vals(09) then m1 = "001" : mp = "1"
    if s1 = vals(10) then m1 = "010" : mp = "1"
    if s1 = vals(11) then m1 = "011" : mp = "1"

    if s1 = vals(12) then m1 = "101" : mp = "0"
    if s1 = vals(13) then m1 = "101" : mp = "1"
    if s1 = vals(14) then m1 = "111" : mp = "0"
    if s1 = vals(15) then m1 = "111" : mp = "1"

[Albert Redditt]

I think I've got a working combo that can be decoded?? Not sure...

if s1 = vals(00) then m1 = "0" : mp = "10"
if s1 = vals(01) then m1 = "1" : mp = "10"
if s1 = vals(02) then m1 = "0" : mp = "11"
if s1 = vals(03) then m1 = "1" : mp = "11"

if s1 = vals(04) then m1 = "000" : mp = "0"
if s1 = vals(05) then m1 = "001" : mp = "0"
if s1 = vals(06) then m1 = "010" : mp = "0"
if s1 = vals(07) then m1 = "011" : mp = "0"

if s1 = vals(08) then m1 = "100" : mp = "0"
if s1 = vals(09) then m1 = "101" : mp = "0"
if s1 = vals(10) then m1 = "110" : mp = "0"
if s1 = vals(11) then m1 = "111" : mp = "0"

if s1 = vals(12) then m1 = "110" : mp = "10"
if s1 = vals(13) then m1 = "110" : mp = "11"
if s1 = vals(14) then m1 = "111" : mp = "10"
if s1 = vals(15) then m1 = "111" : mp = "11"

[Jeff Marshall]

Albert, the bug tracker is for bug reports about the compiler, not for your attempts at compression.

At least you got rid of zlib.

I think I've got a working combo that can be decoded?? Not sure...

Next, instead of wondering about if it works, get rid of the recursion / iteration and write a decode function that works with your formula / combo just once. Can you make sense of what you saved in chrs / map? As usual: watch for duplicates / ambiguous encoding or information will be unrecoverable. you wrote 4 years ago

Lots of good advice on the forum dedicated to random compression where you also posted this encode.su

Related, from past 13 months: [#979], [#976], [#973], [#969], [#964], [#960], [#956]