Real Software Forums

The forum for Real Studio and other Real Software products.
[ REAL Software Website | Board Index ]
It is currently Thu Aug 17, 2017 1:04 am
xojo

All times are UTC - 5 hours




Post new topic Reply to topic  [ 12 posts ] 
Author Message
 Post subject: Base85
PostPosted: Thu Mar 29, 2012 1:44 pm 
Offline
User avatar

Joined: Sat Apr 02, 2011 1:20 pm
Posts: 92
Location: Netherlands
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/ .


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Fri Mar 30, 2012 3:13 am 
Offline

Joined: Tue Feb 14, 2012 5:39 am
Posts: 99
Location: Austria
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Fri Mar 30, 2012 6:11 am 
Offline
User avatar

Joined: Sat Apr 02, 2011 1:20 pm
Posts: 92
Location: Netherlands
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Fri Mar 30, 2012 6:34 am 
Offline

Joined: Tue Feb 14, 2012 5:39 am
Posts: 99
Location: Austria
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Fri Mar 30, 2012 8:12 am 
Offline

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.

_________________
Mac OS X 10.3-10.8
Windows 2000 (I know it sucks)
Windows Server 2007

You want a bunch of new classes and web styles? realstudiodevspot.com (search there for Web Styles Plugin)
Folderitem is too hard? File Bin Class
I hate cows.


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Fri Mar 30, 2012 8:42 am 
Offline

Joined: Tue Feb 14, 2012 5:39 am
Posts: 99
Location: Austria
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 ;)


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Fri Mar 30, 2012 10:27 am 
Offline
User avatar

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

_________________
Some things need no explanation. Elephants, for instance. (Peter Atkins)


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Mon Apr 02, 2012 2:18 am 
Offline
User avatar

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

_________________
Some things need no explanation. Elephants, for instance. (Peter Atkins)


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Tue Apr 03, 2012 7:07 am 
Offline
User avatar

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

_________________
Some things need no explanation. Elephants, for instance. (Peter Atkins)


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Tue Apr 03, 2012 10:44 am 
Offline
User avatar

Joined: Sat Apr 02, 2011 1:20 pm
Posts: 92
Location: Netherlands
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?


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Wed Apr 04, 2012 1:20 am 
Offline

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

_________________
Mac OS X 10.3-10.8
Windows 2000 (I know it sucks)
Windows Server 2007

You want a bunch of new classes and web styles? realstudiodevspot.com (search there for Web Styles Plugin)
Folderitem is too hard? File Bin Class
I hate cows.


Top
 Profile  
Reply with quote  
 Post subject: Re: Base85
PostPosted: Wed Apr 04, 2012 1:37 am 
Offline
User avatar

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

_________________
Some things need no explanation. Elephants, for instance. (Peter Atkins)


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 12 posts ] 

All times are UTC - 5 hours


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group