Base85

gerrut · **Posted:** Thu Mar 29, 2012 1:44 pm

Ok, probably not the best code around, but I needed a quick and dirty solution for Base85 (ASCII85) encoding and decoding. You can look it up at http://www.magicforreal.com/home/base85 ... -decoding/ .

arthofer · **Posted:** Fri Mar 30, 2012 3:13 am

Here you go with something i quickly hacked together. Works with the example of wikipedia.

Function Base85Encode(text as String) As String
  dim padding as integer
  dim output as String
  
  for i as integer = 1 to text.len step 4
    //Split in parts of 4
    dim part as String = text.Mid(i,4)
    
    //if the last part is too short, padd id with \0
    while part.len < 4
      part = part + chr(0)
      padding = padding + 1
    Wend
    
    //Convert into a number
    dim num as integer
    for j as integer = 1 to part.Len
      dim val as integer = asc(part.mid(j,1))
      dim shift as integer = (4-j)*8
      
      num = num + Bitwise.ShiftLeft(val,shift)
    next
    
    //Split in potences of 85 and convert to char again
    dim subtract as integer
    for j as integer = 4 downto 0
      dim val as integer = (num-subtract) / ( 85 ^ j)
      
      output = output + chr(val+33)
      
      subtract = subtract + (val * 85 ^j)
    next
  next
  
  return "<~"+output.left(output.len-padding)+"~>"
End Function

Function Base85Decode(text as String) As String
  if text.left(2) = "<~" Then text = text.right(text.len-2)
  if text.right(2) = "~>" Then text = text.left(text.len-2)
  
  dim padding as integer
  dim output as String
  
  for i as integer = 1 to text.len step 5
    //Split in parts of 5
    dim part as String = text.Mid(i,5)
    
    //if the last part is too short, padd id with "u"
    while part.len < 5
      part = part + "u"
      padding = padding + 1
    Wend
    
    //Convert into a number
    dim num as integer
    for j as integer = 1 to part.Len
      dim char as String = part.mid(j,1)
      dim val as Integer = asc(char)-33
      
      num = num + val * 85 ^ (5 - j)
    next
    
    //Convert number into ascii chars
    dim substract as integer
    for j as integer = 24 downto 0 step 8
      dim val as integer = Bitwise.ShiftRight(num,j)
      
      //Mask the bits we already used
      val = Bitwise.BitAnd(val,&hFF)
      
      output = output + chr(val)
    next
  next
  
  return output.left(output.len-padding)
End Function

gerrut · **Posted:** Fri Mar 30, 2012 6:11 am

Thanks! That really is much more elegant than my shoddy solution. Now I feel a bit ashamed by mine :$
The only thing that has to be added to your solution is putting a new line in the encoded string after every (at most) 80 bytes. This is a requirement by Adobe.

arthofer · **Posted:** Fri Mar 30, 2012 6:34 am

Fixed version. Line length and new line definition is in the first 2 lines of the encode section.

Function Base85Encode(text as String) As String
  dim eol as String = chr(10)
  dim lineLength as Integer = 80
  
  dim padding as integer
  dim output as String
  
  for i as integer = 1 to text.len step 4
    //Split in parts of 4
    dim part as String = text.Mid(i,4)
    
    //if the last part is too short, padd id with \0
    while part.len < 4
      part = part + chr(0)
      padding = padding + 1
    Wend
    
    //Convert into a number
    dim num as integer
    for j as integer = 1 to part.Len
      dim val as integer = asc(part.mid(j,1))
      dim shift as integer = (4-j)*8
      
      num = num + Bitwise.ShiftLeft(val,shift)
    next
    
    //Split in potences of 85 and convert to char again
    dim subtract as integer
    for j as integer = 4 downto 0
      dim val as integer = (num-subtract) / ( 85 ^ j)
      
      output = output + chr(val+33)
      
      if output.Len mod lineLength = 0 Then
        output = output + eol
      end
      
      subtract = subtract + (val * 85 ^j)
    next
  next
  
  return "<~"+output.left(output.len-padding)+"~>"
End Function

Function Base85Decode(text as String) As String
  if text.left(2) = "<~" Then text = text.right(text.len-2)
  if text.right(2) = "~>" Then text = text.left(text.len-2)
  
  text = text.ReplaceAll(chr(10),"")
  text = text.ReplaceAll(chr(13),"")
  
  dim padding as integer
  dim output as String
  
  for i as integer = 1 to text.len step 5
    //Split in parts of 5
    dim part as String = text.Mid(i,5)
    
    //if the last part is too short, padd id with "u"
    while part.len < 5
      part = part + "u"
      padding = padding + 1
    Wend
    
    //Convert into a number
    dim num as integer
    for j as integer = 1 to part.Len
      dim char as String = part.mid(j,1)
      dim val as Integer = asc(char)-33
      
      num = num + val * 85 ^ (5 - j)
    next
    
    //Convert number into ascii chars
    dim substract as integer
    for j as integer = 24 downto 0 step 8
      dim val as integer = Bitwise.ShiftRight(num,j)
      
      //Mask the bits we already used
      val = Bitwise.BitAnd(val,&hFF)
      
      output = output + chr(val)
    next
  next
  
  return output.left(output.len-padding)
End Function

NaNdummy · **Joined:** Thu Dec 01, 2011 2:13 pm **Posts:** 288

gerrut wrote:

Now I feel a bit ashamed by mine :$

Why? Youre one works, it is good. May the other one is better, but it would not exist if you would not have created your one.

arthofer · **Posted:** Fri Mar 30, 2012 8:42 am

And i must confess, i mis-read his first post, in the first moment i thought that he needed a solution and was not posting one

GreatOm · **Joined:** Fri Sep 30, 2005 8:25 am **Posts:** 97

Do not use the Unicode string fuctions here.
Use LeftB instead of Left, LenB instead of Len, etc.

Add " #pragma BackgroundTasks false " into Base85Encode and Base85Decode.

A quick test here shows a speed improvement from 180 ms for a test string down to 40 ms.

Cheers,

GreatOm

GreatOm · **Joined:** Fri Sep 30, 2005 8:25 am **Posts:** 97

Hi!

Now I got a few minutes to improve the code, now it is down to 35 ms from 180 ms using the original code.

Function Base85Encode(text as String) As String
  #pragma BackgroundTasks false
  
  dim padding as integer
  dim output() as String
  dim padStr As String = chr(0) + chr(0) + chr(0)
  
  for i as integer = 1 to text.lenB step 4
    //Split in parts of 4
    dim part as String = text.MidB(i,4)
    if part.lenB<4 then
      padding = 4 - part.lenB
      part = leftB(part + padStr, 4)
    end
    
    //Convert into a number
    dim num as integer
    for j as integer = 1 to part.LenB
      dim val as integer = ascB(part.midB(j,1))
      dim shift as integer = (4-j)*8
      
      num = num + Bitwise.ShiftLeft(val,shift)
    next
    
    //Split in potences of 85 and convert to char again
    dim subtract as integer
    for j as integer = 4 downto 0
      dim val as integer = (num-subtract) / ( 85 ^ j)
      
      output.Append chr(val+33)
      
      subtract = subtract + (val * 85 ^j)
    next
  next
  dim s As String = join(output, "")
  return "<~"+s.leftB(s.lenB-padding)+"~>"
End Function

Function Base85Decode(text as String) As String
  #pragma BackgroundTasks false
  
  if text.leftB(2) = "<~" Then text = text.rightB(text.lenB-2)
  if text.rightB(2) = "~>" Then text = text.leftB(text.lenB-2)
  
  text = text.ReplaceAllB(chr(10),"")
  text = text.ReplaceAllB(chr(13),"")
  
  dim padding as integer
  dim output() as String
  
  for i as integer = 1 to text.lenB step 5
    dim part as String = text.MidB(i,5)
    if part.lenB < 5 then
      padding= 5 - part.lenB
      part = LeftB(part + "uuuu", 5)
    end
    
    //Convert into a number
    dim num as integer
    for j as integer = 1 to part.LenB
      dim val as Integer = ascB(part.midB(j,1))-33
      num = num + val * 85 ^ (5 - j)
    next
    
    //Convert number into ascii chars
    for j as integer = 24 downto 0 step 8
      dim val as integer = Bitwise.ShiftRight(num,j)
      
      //Mask the bits we already used
      val = Bitwise.BitAnd(val,&hFF)
      
      output.Append chr(val)
    next
  next
  dim s As String = join(output, "")
  return s.leftB(s.lenB-padding)
End Function

Posting was changed due to a bug in the previous code.

HTH,

GreatOm

GreatOm · **Joined:** Fri Sep 30, 2005 8:25 am **Posts:** 97

Just a comment about the speed of the code...

The original code will be much more slower for larger test sizes. Here some timings from my machine:

Text size, Original Code Time, Optimized code time
8 kB, 0.15 s, 0.03 s
79 kB, 12.5 s, 0.3 s
158 kB, 50 s, 0.6 s

HTH,

GreatOm

gerrut · **Posted:** Tue Apr 03, 2012 10:44 am

Wow that difference is truly enormous! With the original you mean my first implementation?
Maybe a stupid question from this newbie, but how exactly did you measure these timings?

NaNdummy · **Joined:** Thu Dec 01, 2011 2:13 pm **Posts:** 288

The #pragma backgroundtasks false and the LeftB/LenB.

If you are 100% sure that your code doesnt throws an exception, you can write #pragma BoundsChecking false, #pragma NilObjectChecking false, #pragma StackOverFlowChecking false

GreatOm · **Joined:** Fri Sep 30, 2005 8:25 am **Posts:** 97

gerrut wrote:

Maybe a stupid question from this newbie, but how exactly did you measure these timings?

Here is my test code:

dim ms As Double
dim outStr as String
dim testStr As String = GetTestStr()
taOut.AppendText "Test string size: " + str(testStr.lenB/1024) + " kB" + EndOfLine

ms = Microseconds
dim b85str as string = Base85Encode(testStr)

outStr = Base85Decode(b85str)
taOut.AppendText "Time: " + str((Microseconds-ms)/1000) + " ms, "

if StrComp(GetTestStr, Outstr, 0) = 0 then
  taOut.AppendText "Ok"
else
  taOut.AppendText "ERROR"
end
taOut.AppendText EndOfLine

Cheers,

GreatOm

	Real Software Forums The forum for Real Studio and other Real Software products.
[ REAL Software Website \| Board Index ]

Real Software Forums

Base85