Task: LZW compression







Python: def compress(uncompressed):
    

    
    dict_size = 256
    dictionary = dict((chr(i), i) for i in range(dict_size))
    

    w = ""
    result = []
    for c in uncompressed:
        wc = w + c
        if wc in dictionary:
            w = wc
        else:
            result.append(dictionary[w])
            
            dictionary[wc] = dict_size
            dict_size += 1
            w = c

    
    if w:
        result.append(dictionary[w])
    return result


def decompress(compressed):
    
    from io import StringIO

    
    dict_size = 256
    dictionary = dict((i, chr(i)) for i in range(dict_size))
    

    
    
    result = StringIO()
    w = chr(compressed.pop(0))
    result.write(w)
    for k in compressed:
        if k in dictionary:
            entry = dictionary[k]
        elif k == dict_size:
            entry = w + w[0]
        else:
            raise ValueError('Bad compressed k: %s' % k)
        result.write(entry)

        
        dictionary[dict_size] = w + entry[0]
        dict_size += 1

        w = entry
    return result.getvalue()



compressed = compress('TOBEORNOTTOBEORTOBEORNOT')
print (compressed)
decompressed = decompress(compressed)
print (decompressed)




Fortran: 









      MODULE LZW_SHARED_PARAMETERS
      IMPLICIT NONE



      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



      INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE)  ::  concatenatedsymbols
      INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE)  ::  prefixcodes
      INTEGER  ::  the_status = 0


 
      END MODULE LZW_SHARED_PARAMETERS










      MODULE CODECIO
      USE LZW_SHARED_PARAMETERS
      IMPLICIT NONE

      CONTAINS
      SUBROUTINE SETOUTPUTCODE(Code)
      IMPLICIT NONE



      INTEGER  ::  Code
      INTENT (IN) Code



      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)

         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



      INTEGER  ::  Symbol
      INTENT (IN) Symbol

 
      CALL FPUTC(FILEOUT , ACHAR(Symbol))
      END SUBROUTINE SETRAWBYTE
 
 
      FUNCTION GETRAWBYTE()
      IMPLICIT NONE



      INTEGER  ::  GETRAWBYTE



      CHARACTER  ::  bufferedbyte

      CALL FGETC(FILEIN , bufferedbyte , THE_status)
      GETRAWBYTE = IACHAR(bufferedbyte)
      END FUNCTION GETRAWBYTE
 
      FUNCTION GETINPUTCODE()
      IMPLICIT NONE



      INTEGER  ::  GETINPUTCODE



      INTEGER  ::  inputbitbuffer = 0
      INTEGER  ::  inputbitcounter = 0
      INTEGER  ::  integerinputbuff
      INTEGER  ::  returnn
      INTEGER  ::  shiftedbit

      DO WHILE( inputbitcounter <= MISSING_BITS )

         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









      MODULE LZW_ENCODER
      USE LZW_SHARED_PARAMETERS
      USE CODECIO
      IMPLICIT NONE



      INTEGER , PARAMETER  ::  HASH_SHIFT = BITS - SYMBOL_SIZE



      INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE)  ::  symbolvalues
      CONTAINS
      SUBROUTINE COMPRESS()
      IMPLICIT NONE



      INTEGER  ::  codedsymbol
      INTEGER  ::  my_index
      INTEGER  ::  nextsymbol
      INTEGER  ::  symbol
      CHARACTER  ::  bufferedbyte

      nextsymbol = COMPILER_INTEGER_SIZE*SYMBOL_SIZE
      SYMbolvalues(:) = -1
 

      CALL FGETC(FILEIN , bufferedbyte , THE_status)
      codedsymbol = IACHAR(bufferedbyte)

      DO WHILE(THE_status == 0)

          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









      MODULE LZW_DECODER
      USE LZW_SHARED_PARAMETERS
      USE CODECIO
      IMPLICIT NONE



      TYPE :: DECODE_BUFFER_STACK
         INTEGER , DIMENSION(0:MAX_DICTIONARY_SIZE)  ::  DECODERSTACK
         INTEGER  ::  TOP
      END TYPE DECODE_BUFFER_STACK



      TYPE(DECODE_BUFFER_STACK)  ::  stack
      CONTAINS


      SUBROUTINE DECOMPRESS()
      IMPLICIT NONE



      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



      INTEGER  ::  Code
      INTEGER , DIMENSION(:)  ::  Buffer
      INTENT (IN) Code
      INTENT (INOUT) Buffer



      INTEGER  ::  i
      INTEGER  ::  j
      INTEGER  ::  symbol

      j = 0
      symbol = Code
      STAck%TOP = 0
      DO WHILE ( symbol>=COMPILER_INTEGER_SIZE*SYMBOL_SIZE )
 
 
         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









 
      MODULE LZW
      USE LZW_SHARED_PARAMETERS
      USE LZW_ENCODER
      USE LZW_DECODER
      IMPLICIT NONE
      CONTAINS
      SUBROUTINE INIT(Input , Output , Operation , Filename)
      IMPLICIT NONE



      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



      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