Task: LZW compression


C++: #include <string>
#include <map>




template <typename Iterator>
Iterator compress(const std::string &uncompressed, Iterator result) {
  
  int dictSize = 256;
  std::map<std::string,int> dictionary;
  for (int i = 0; i < 256; i++)
    dictionary[std::string(1, i)] = i;
  
  std::string w;
  for (std::string::const_iterator it = uncompressed.begin();
       it != uncompressed.end(); ++it) {
    char c = *it;
    std::string wc = w + c;
    if (dictionary.count(wc))
      w = wc;
    else {
      *result++ = dictionary[w];
      
      dictionary[wc] = dictSize++;
      w = std::string(1, c);
    }
  }
  
  
  if (!w.empty())
    *result++ = dictionary[w];
  return result;
}



template <typename Iterator>
std::string decompress(Iterator begin, Iterator end) {
  
  int dictSize = 256;
  std::map<int,std::string> dictionary;
  for (int i = 0; i < 256; i++)
    dictionary[i] = std::string(1, i);
  
  std::string w(1, *begin++);
  std::string result = w;
  std::string entry;
  for ( ; begin != end; begin++) {
    int k = *begin;
    if (dictionary.count(k))
      entry = dictionary[k];
    else if (k == dictSize)
      entry = w + w[0];
    else
      throw "Bad compressed k";
    
    result += entry;
    
    
    dictionary[dictSize++] = w + entry[0];
    
    w = entry;
  }
  return result;
}

#include <iostream>
#include <iterator>
#include <vector>

int main() {
  std::vector<int> compressed;
  compress("TOBEORNOTTOBEORTOBEORNOT", std::back_inserter(compressed));
  copy(compressed.begin(), compressed.end(), std::ostream_iterator<int>(std::cout, ", "));
  std::cout << std::endl;
  std::string decompressed = decompress(compressed.begin(), compressed.end());
  std::cout << decompressed << std::endl;
  
  return 0;
}









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