The routine works fine and depending on the given values, the results are very good (in my case better than 20:1). My question is, if someone will have a look at these routines, if they can be optimized in speed (and in compression level, if you like):
Code: Select all
; Define
; Check Routines...
RandomSeed(0)
#Number=20
#Fuzzy=#False
Global Dim ArrVals.s(#Number)
Global Dim ArrComp.s(#Number)
Global LenValue
Global LenCompressed
; Compression Routine...
Enumeration
#A
#B
#C
#Buffersize=#C
EndEnumeration
Enumeration
#InitialValue
#PreviousValue
EndEnumeration
Global Dim Buffer.s(#Buffersize,#PreviousValue)
#Nil="%"
; EndDefine
Procedure.s RemoveChars(nr,s.s)
Protected i,a,b
Protected type,flag
Enumeration
#InitialOnly
#PreviousAndInitial
#PreviousOnly
EndEnumeration
If Buffer(nr,#InitialValue)="";#Nil
Buffer(nr,#InitialValue)=s
Buffer(nr,#PreviousValue)=s
Else
i=-1
flag=#False
type=#PreviousAndInitial
Repeat
i+1
a=PeekB(@s+i)
If type>#InitialOnly; also #PreviousAndInitial oder #PreviousOnly
b=PeekB(@Buffer(nr,#PreviousValue)+i)
;If (a*b=0) Or (a<>b)
If (a=0) Or (b=0) Or (a<>b)
If type=#PreviousAndInitial
type=#InitialOnly
Else
flag=#True
EndIf
EndIf
EndIf
If type<#PreviousOnly; also #PreviousAndInitial oder #InitialOnly
b=PeekB(@Buffer(nr,#InitialValue)+i)
;If (a*b=0) Or (a<>b)
If (a=0) Or (b=0) Or (a<>b)
If type=#PreviousAndInitial
type=#PreviousOnly
Else
flag=#True
EndIf
EndIf
EndIf
Until flag
Buffer(nr,#PreviousValue)=s
If i>1; es bringt nichts, ein einzelnes Zeichen zu ersetzen...
If type=#PreviousOnly
ProcedureReturn Chr(i+96)+PeekS(@s+i)
Else
ProcedureReturn Chr(i+64)+PeekS(@s+i)
EndIf
EndIf
EndIf
ProcedureReturn s
EndProcedure
Procedure.s RemoveZeros(s.s,mode)
Protected l
l=FindString(s,".",1); Mode=1: eine Nachkommastelle merken...
If l; Komma vorhanden...
If mode=0
l=Len(s)-1; Mode=0: alle Nachkommastellen merken...
EndIf
While PeekB(@s+l)='0'; redundante Nullen (hinten) abschneiden...
l-1
Wend
If PeekB(@s+l)='.'; "Komma" als letztes Zeichen entfernen...
l-1
EndIf
ProcedureReturn Left(s,l+1)
EndIf
ProcedureReturn s
EndProcedure
Procedure.s ExpandString(i,zeile.s)
Protected c
If Buffer(i,#InitialValue)=#Nil
Buffer(i,#InitialValue)=PeekS(@Zeile)
Buffer(i,#PreviousValue)=Buffer(i,#InitialValue)
Else
c=PeekB(@Zeile)
If c>'@'; 64
If c>'`'; 96
Zeile=Left(Buffer(i,#PreviousValue),c-96)+PeekS(@Zeile+1)
Else
Zeile=Left(Buffer(i,#InitialValue),c-64)+PeekS(@Zeile+1)
EndIf
EndIf
Buffer(i,#PreviousValue)=Mid(Zeile,1); ohne Kennung (§A,...) im Buffer speichern
EndIf
ProcedureReturn zeile
EndProcedure
; ------------------------------------------------------------------------------------------------------------------
; Compress...
; ------------------------------------------------------------------------------------------------------------------
For i=1 To #Number
ArrVals(i)=Str(12498+Random(4))+"."+Str(Random(1000))+Str(Random(5))+Str(Random(1))
ArrComp(i)=RemoveChars(#B,RemoveZeros(ArrVals(i),#Fuzzy))
LenValue+Len(ArrVals(i))
LenCompressed+Len(ArrComp(i))
Next i
Debug Str(LenCompressed) + " <– " + Str(LenValue)
; ------------------------------------------------------------------------------------------------------------------
; Decompress...
; ------------------------------------------------------------------------------------------------------------------
Buffer(#B,0)=#Nil
Buffer(#B,1)=#Nil
For i=1 To #Number
Debug ExpandString(#B,ArrComp(i)) +" <– " + ArrVals(i) + " –> " + ArrComp(i)
Next i
