LZW compression: Difference between revisions
Content added Content deleted
m (→{{header|Raku}}: updated raku programming solution ; add unicode support) |
(Added a Fortran implementation of lzw) |
||
Line 1,757: | Line 1,757: | ||
out out-size @ decompress cr |
out out-size @ decompress cr |
||
\ TOBEORNOTTOBEORTOBEORNOT</lang> |
\ TOBEORNOTTOBEORTOBEORNOT</lang> |
||
=={{header|Fortran}}== |
|||
<lang Fortran> |
|||
! |
|||
! lzw_shared_parameters.f90 |
|||
! |
|||
! LZW Common Variables Used by Coder and Decoder |
|||
! |
|||
! Author: Pedro Garcia Freitas <sawp@sawp.com.br> |
|||
! May, 2011 |
|||
! |
|||
! License: Creative Commons http://creativecommons.org/licenses/by-nc-nd/3.0/ |
|||
! |
|||
MODULE LZW_SHARED_PARAMETERS |
|||
IMPLICIT NONE |
|||
! |
|||
! PARAMETER definitions |
|||
! |
|||
INTEGER , PARAMETER :: COMPILER_INTEGER_SIZE = 32 , BITS = 12 , FILEIN = 66 , & |
|||
& FILEOUT = 99 , MAX_VALUE = (2**BITS) - 1 , & |
|||
& MAX_CODE = MAX_VALUE - 1 , MAX_DICTIONARY_SIZE = 5021 , & |
|||
& SYMBOL_SIZE = 8 , MISSING_BITS = COMPILER_INTEGER_SIZE - & |
|||
& SYMBOL_SIZE |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE) :: concatenatedsymbols |
|||
INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE) :: prefixcodes |
|||
INTEGER :: the_status = 0 |
|||
! change this if compiler dont use 32 bits for integer |
|||
END MODULE LZW_SHARED_PARAMETERS |
|||
! |
|||
! codecIO.f90 |
|||
! |
|||
! bit IO routines for coder and encoder. |
|||
! |
|||
! Author: Pedro Garcia Freitas <sawp@sawp.com.br> |
|||
! May, 2011 |
|||
! |
|||
! License: Creative Commons http://creativecommons.org/licenses/by-nc-nd/3.0/ |
|||
! |
|||
MODULE CODECIO |
|||
USE LZW_SHARED_PARAMETERS |
|||
IMPLICIT NONE |
|||
! |
|||
CONTAINS |
|||
SUBROUTINE SETOUTPUTCODE(Code) |
|||
IMPLICIT NONE |
|||
! |
|||
! Dummy arguments |
|||
! |
|||
INTEGER :: Code |
|||
INTENT (IN) Code |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER :: buffer |
|||
INTEGER :: outputbitbuffer = 0 |
|||
INTEGER :: outputbitcount = 0 |
|||
INTEGER :: shift |
|||
INTEGER :: shiftedsymbol |
|||
! |
|||
shift = COMPILER_INTEGER_SIZE - BITS - outputbitcount |
|||
shiftedsymbol = ISHFT(Code , shift) |
|||
outputbitbuffer = IOR(outputbitbuffer , shiftedsymbol) |
|||
outputbitcount = outputbitcount + BITS |
|||
DO WHILE(outputbitcount >= SYMBOL_SIZE) |
|||
! IF( outputbitcount<SYMBOL_SIZE )EXIT |
|||
buffer = ISHFT(outputbitbuffer , -MISSING_BITS) |
|||
CALL SETRAWBYTE(buffer) |
|||
outputbitbuffer = ISHFT(outputbitbuffer , SYMBOL_SIZE) |
|||
outputbitcount = outputbitcount - SYMBOL_SIZE |
|||
END DO |
|||
RETURN |
|||
END SUBROUTINE SETOUTPUTCODE |
|||
SUBROUTINE SETRAWBYTE(Symbol) |
|||
IMPLICIT NONE |
|||
! |
|||
! Dummy arguments |
|||
! |
|||
INTEGER :: Symbol |
|||
INTENT (IN) Symbol |
|||
! |
|||
CALL FPUTC(FILEOUT , ACHAR(Symbol)) |
|||
END SUBROUTINE SETRAWBYTE |
|||
FUNCTION GETRAWBYTE() |
|||
IMPLICIT NONE |
|||
! |
|||
! Dummy arguments |
|||
! |
|||
INTEGER :: GETRAWBYTE |
|||
! |
|||
! Local variables |
|||
! |
|||
CHARACTER :: bufferedbyte |
|||
! |
|||
CALL FGETC(FILEIN , bufferedbyte , THE_status) |
|||
GETRAWBYTE = IACHAR(bufferedbyte) |
|||
END FUNCTION GETRAWBYTE |
|||
FUNCTION GETINPUTCODE() |
|||
IMPLICIT NONE |
|||
! |
|||
! Dummy arguments |
|||
! |
|||
INTEGER :: GETINPUTCODE |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER :: inputbitbuffer = 0 |
|||
INTEGER :: inputbitcounter = 0 |
|||
INTEGER :: integerinputbuff |
|||
INTEGER :: returnn |
|||
INTEGER :: shiftedbit |
|||
! |
|||
DO WHILE( inputbitcounter <= MISSING_BITS ) |
|||
! IF( inputbitcounter>MISSING_BITS )EXIT |
|||
integerinputbuff = GETRAWBYTE() |
|||
shiftedbit = ISHFT(integerinputbuff , MISSING_BITS - inputbitcounter) |
|||
inputbitbuffer = IOR(inputbitbuffer , shiftedbit) |
|||
inputbitcounter = inputbitcounter + SYMBOL_SIZE |
|||
END DO |
|||
returnn = ISHFT(inputbitbuffer , BITS - COMPILER_INTEGER_SIZE) |
|||
inputbitbuffer = ISHFT(inputbitbuffer , BITS) |
|||
inputbitcounter = inputbitcounter - BITS |
|||
GETINPUTCODE = returnn |
|||
RETURN |
|||
END FUNCTION GETINPUTCODE |
|||
end module codecIO |
|||
! lzw_encoder.f90 |
|||
! |
|||
! LZW Coder (Compressor) |
|||
! |
|||
! Author: Pedro Garcia Freitas <sawp@sawp.com.br> |
|||
! May, 2011 |
|||
! |
|||
! License: Creative Commons http://creativecommons.org/licenses/by-nc-nd/3.0/ |
|||
! |
|||
MODULE LZW_ENCODER |
|||
USE LZW_SHARED_PARAMETERS |
|||
USE CODECIO |
|||
IMPLICIT NONE |
|||
! |
|||
! PARAMETER definitions |
|||
! |
|||
INTEGER , PARAMETER :: HASH_SHIFT = BITS - SYMBOL_SIZE |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE) :: symbolvalues |
|||
CONTAINS |
|||
SUBROUTINE COMPRESS() |
|||
IMPLICIT NONE |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER :: codedsymbol |
|||
INTEGER :: my_index |
|||
INTEGER :: nextsymbol |
|||
INTEGER :: symbol |
|||
CHARACTER :: bufferedbyte |
|||
! |
|||
nextsymbol = COMPILER_INTEGER_SIZE*SYMBOL_SIZE |
|||
SYMbolvalues(:) = -1 |
|||
! codedsymbol = GETRAWBYTE() |
|||
CALL FGETC(FILEIN , bufferedbyte , THE_status) |
|||
codedsymbol = IACHAR(bufferedbyte) |
|||
!Can be hand optimized - optimization |
|||
DO WHILE(THE_status == 0) |
|||
! symbol = GETRAWBYTE() ! Manual inline of function |
|||
CALL FGETC(FILEIN , bufferedbyte , THE_status) |
|||
symbol = IACHAR(bufferedbyte) |
|||
IF( THE_status/=0 )CYCLE |
|||
my_index = GETPOSITIONONDICTIONARY(codedsymbol , symbol) |
|||
IF( SYMbolvalues(my_index)/= - 1 )THEN |
|||
codedsymbol = SYMbolvalues(my_index) |
|||
ELSE |
|||
IF( nextsymbol<=MAX_CODE )THEN |
|||
SYMbolvalues(my_index) = nextsymbol |
|||
nextsymbol = nextsymbol + 1 |
|||
PREfixcodes(my_index) = codedsymbol |
|||
CONcatenatedsymbols(my_index) = symbol |
|||
END IF |
|||
CALL SETOUTPUTCODE(codedsymbol) |
|||
codedsymbol = symbol |
|||
END IF |
|||
END DO |
|||
CALL SETOUTPUTCODE(codedsymbol) |
|||
CALL SETOUTPUTCODE(MAX_VALUE) |
|||
CALL SETOUTPUTCODE(0) |
|||
END SUBROUTINE COMPRESS |
|||
function getPositionOnDictionary(hashPrefix, hashSymbol) |
|||
integer, intent(in) :: hashPrefix |
|||
integer, intent(in) :: hashSymbol |
|||
integer :: getPositionOnDictionary |
|||
integer :: index |
|||
integer :: offset |
|||
index = ishft(hashSymbol, HASH_SHIFT) |
|||
index = ieor(index, hashPrefix) |
|||
if (index == 0) then |
|||
offset = 1 |
|||
else |
|||
offset = MAX_DICTIONARY_SIZE - index |
|||
endif |
|||
do |
|||
if (symbolValues(index) == -1) then |
|||
getPositionOnDictionary = index |
|||
exit |
|||
endif |
|||
if (prefixCodes(index) == hashPrefix .and. & |
|||
& concatenatedSymbols(index) == hashSymbol) then |
|||
getPositionOnDictionary = index |
|||
exit |
|||
endif |
|||
index = index - offset |
|||
if (index < 0) then |
|||
index = index + MAX_DICTIONARY_SIZE |
|||
endif |
|||
end do |
|||
return |
|||
end function |
|||
end module LZW_Encoder |
|||
! lzw_decoder.f90 |
|||
! |
|||
! LZW Decoder (Expanssor) |
|||
! |
|||
! Author: Pedro Garcia Freitas <sawp@sawp.com.br> |
|||
! May, 2011 |
|||
! |
|||
! License: Creative Commons http://creativecommons.org/licenses/by-nc-nd/3.0/ |
|||
! |
|||
MODULE LZW_DECODER |
|||
USE LZW_SHARED_PARAMETERS |
|||
USE CODECIO |
|||
IMPLICIT NONE |
|||
! |
|||
! Derived Type definitions |
|||
! |
|||
TYPE :: DECODE_BUFFER_STACK |
|||
INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE) :: DECODERSTACK |
|||
INTEGER :: TOP |
|||
END TYPE DECODE_BUFFER_STACK |
|||
! |
|||
! Local variables |
|||
! |
|||
TYPE(DECODE_BUFFER_STACK) :: stack |
|||
CONTAINS |
|||
! |
|||
! Can be hand optimized - optimization |
|||
SUBROUTINE DECOMPRESS() |
|||
IMPLICIT NONE |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER :: newsymbol |
|||
INTEGER :: nextsymbol |
|||
INTEGER :: oldsymbol |
|||
INTEGER :: popedsymbol |
|||
INTEGER :: symbol |
|||
! |
|||
nextsymbol = COMPILER_INTEGER_SIZE*SYMBOL_SIZE |
|||
oldsymbol = GETINPUTCODE() |
|||
symbol = oldsymbol |
|||
CALL SETRAWBYTE(oldsymbol) |
|||
DO |
|||
newsymbol = GETINPUTCODE() |
|||
IF( newsymbol==MAX_VALUE )RETURN |
|||
IF( newsymbol>=nextsymbol )THEN |
|||
STAck%DECODERSTACK(0) = symbol |
|||
CALL DECODESYMBOL(STAck%DECODERSTACK(1:) , oldsymbol) |
|||
ELSE |
|||
CALL DECODESYMBOL(STAck%DECODERSTACK(:) , newsymbol) |
|||
END IF |
|||
symbol = STAck%DECODERSTACK(STAck%TOP) |
|||
DO WHILE ( STAck%TOP>=0 ) |
|||
popedsymbol = STAck%DECODERSTACK(STAck%TOP) |
|||
CALL SETRAWBYTE(popedsymbol) |
|||
STAck%TOP = STAck%TOP - 1 |
|||
END DO |
|||
IF( nextsymbol<=MAX_CODE )THEN |
|||
PREfixcodes(nextsymbol) = oldsymbol |
|||
CONcatenatedsymbols(nextsymbol) = symbol |
|||
nextsymbol = nextsymbol + 1 |
|||
END IF |
|||
oldsymbol = newsymbol |
|||
END DO |
|||
RETURN |
|||
END SUBROUTINE DECOMPRESS |
|||
SUBROUTINE DECODESYMBOL(Buffer , Code) |
|||
IMPLICIT NONE |
|||
! |
|||
! Dummy arguments |
|||
! |
|||
INTEGER :: Code |
|||
INTEGER , DIMENSION(:) :: Buffer |
|||
INTENT (IN) Code |
|||
INTENT (INOUT) Buffer |
|||
! |
|||
! Local variables |
|||
! |
|||
INTEGER :: i |
|||
INTEGER :: j |
|||
INTEGER :: symbol |
|||
! |
|||
j = 0 |
|||
symbol = Code |
|||
STAck%TOP = 0 |
|||
DO WHILE ( symbol>=COMPILER_INTEGER_SIZE*SYMBOL_SIZE ) |
|||
! IF( symbol<COMPILER_INTEGER_SIZE*SYMBOL_SIZE )EXIT |
|||
IF( j>=MAX_CODE )THEN |
|||
PRINT * , "Decoding error" |
|||
STOP |
|||
END IF |
|||
i = STAck%TOP + 1 |
|||
Buffer(i) = CONcatenatedsymbols(symbol) |
|||
symbol = PREfixcodes(symbol) |
|||
STAck%TOP = STAck%TOP + 1 |
|||
j = j + 1 |
|||
END DO |
|||
i = j + 1 |
|||
Buffer(i) = symbol |
|||
END SUBROUTINE DECODESYMBOL |
|||
end module LZW_Decoder |
|||
! lzw.f90 |
|||
! |
|||
! LZW Coder and Decoder |
|||
! |
|||
! Author: Pedro Garcia Freitas <sawp@sawp.com.br> |
|||
! May, 2011 |
|||
! |
|||
! License: Creative Commons http://creativecommons.org/licenses/by-nc-nd/3.0/ |
|||
! |
|||
MODULE LZW |
|||
USE LZW_SHARED_PARAMETERS |
|||
USE LZW_ENCODER |
|||
USE LZW_DECODER |
|||
IMPLICIT NONE |
|||
CONTAINS |
|||
SUBROUTINE INIT(Input , Output , Operation , Filename) |
|||
IMPLICIT NONE |
|||
! |
|||
! Dummy arguments |
|||
! |
|||
CHARACTER(100) :: Filename |
|||
CHARACTER(100) :: Input |
|||
CHARACTER(1) :: Operation |
|||
CHARACTER(100) :: Output |
|||
INTENT (IN) Filename , Input , Operation , Output |
|||
! |
|||
IF( Operation/='d' .AND. Operation/='e' )THEN |
|||
PRINT * , "Usage: " // TRIM(Filename) // " <operation> input output" |
|||
PRINT * , "Possible operations: " |
|||
PRINT * , " e -> encode (compress)" |
|||
PRINT * , " d -> decode (inflate)" |
|||
STOP |
|||
END IF |
|||
OPEN(UNIT = FILEIN , FILE = Input , ACTION = "read" , STATUS = "old" , & |
|||
&ACCESS = 'stream' , FORM = "formatted") |
|||
OPEN(UNIT = FILEOUT , FILE = Output , ACTION = "write" , STATUS = "replace" , & |
|||
& ACCESS = 'stream' , FORM = "formatted") |
|||
IF( Operation=='d' )THEN |
|||
PRINT * , "Decoding..." |
|||
CALL DECOMPRESS() |
|||
ELSE |
|||
PRINT * , "Encoding..." |
|||
CALL COMPRESS() |
|||
END IF |
|||
CLOSE(UNIT = FILEIN) |
|||
CLOSE(UNIT = FILEOUT) |
|||
END SUBROUTINE INIT |
|||
end module LZW |
|||
! |
|||
PROGRAM MAIN |
|||
USE LZW |
|||
IMPLICIT NONE |
|||
! |
|||
! Local variables |
|||
! |
|||
CHARACTER(100) :: filename |
|||
REAL :: finish |
|||
CHARACTER(100) :: input |
|||
CHARACTER(1) :: operation |
|||
CHARACTER(100) :: output |
|||
REAL :: start |
|||
! |
|||
CALL GETARG(0 , filename) |
|||
CALL GETARG(1 , operation) |
|||
CALL GETARG(2 , input) |
|||
CALL GETARG(3 , output) |
|||
CALL CPU_TIME(start) |
|||
CALL INIT(input , output , operation , filename) |
|||
CALL CPU_TIME(finish) |
|||
PRINT '("Time = ",f6.3," seconds.")' , finish - start |
|||
END PROGRAM MAIN |
|||
=={{header|FreeBASIC}}== |
=={{header|FreeBASIC}}== |