Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Май 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.943 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed
Статус: Профессионал
Рейтинг: 2656
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 2357
∙ повысить рейтинг » 		star9491
Статус: Практикант
Рейтинг: 1959
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Pascal (Паскаль)

Номер выпуска:1087
Дата выхода:23.05.2010, 15:00
Администратор рассылки:Boriss, Академик
Подписчиков / экспертов:228 / 182
Вопросов / ответов:1 / 1

Вопрос № 178449: Здравствуйте. В среде турбо паскаль нужно написать программу-распаковщик текста по лагоритму LZW c использованием динамического стека. Структура программы: модуль работы со словарем, модуль распаковщик, вызывающая их программа. Программа должна счит...

Вопрос № 178449:

Здравствуйте. В среде турбо паскаль нужно написать программу-распаковщик текста по лагоритму LZW c использованием динамического стека. Структура программы: модуль работы со словарем, модуль распаковщик, вызывающая их программа. Программа должна считать закодированный файл, вывести на экран полученный текст и создать выходной файл.Заранее спасибо.

Отправлен: 17.05.2010, 19:38
Вопрос задал: Федоров Иван , Посетитель
Всего ответов: 1
Страница вопроса »

Отвечает amnick, Студент :
Здравствуйте, Федоров Иван .

Ниже приведен код модуля LZW-распаковщика (простейший неадаптивный вариант), а код программы распаковки, использующей этот модуль — в приложении.

LZW_UNP.PAS
Код:
{**********************************************************
 Модуль распаковки
файла, сжатого алгоритмом LZW.
 Перевод на Паскаль:
 LZW data compression/expansion demonstration program.
 Mark R. Nelson
 From Dr.Dobb's Journal (Oct, 1989) by MacSoft
**********************************************************}

unit LZW_UNP;

interface

type { процедура для информирования вызывающей программы о процессе распаковки }
 userInfoProc = procedure( n: longint ); { n - число "распакованных" байт }

 
{ Процедура распаковки файла, сжатого алгоритмом LZW }
procedure expand( var input, output: file; userInfo: userInfoProc );

implementation

{ Задаем размер кода в битах.
  Это значение (12..14) влияет на некоторые константы.
}
{$define BITS12}

const
 BITS = 12;
 MAX_VALUE = (1 shl BITS)-1;
 MAX_CODE = MAX_VALUE-1;

{ Размер таблицы строк должен быть простым числом несколько больше 2**BITS }

{$ifdef BITS14}
 TABLE_SIZE = 18041;
{$endif}
{$ifdef
BITS13}
 TABLE_SIZE = 9029;
{$endif}
{$ifdef BITS12}
 TABLE_SIZE = 5021;
{$endif}

{$R-} { отключаем проверку индексов }
{$I-} { отключаем проверку ошибок ввода/вывода }

type
 a_word = array[0..0] of word;
 a_byte = array[0..0] of byte;
 PByte = ^a_byte;

var
 prefix_code      : ^a_word;  { указатель на массив для префиксных кодов  }
 append_character : ^a_byte;  { указатель на массив для добавляемых символов }
 dec
 ode_stack     : PByte;  { указатель на массив для декодированной строки }
 stack_size       : word;

const
 EOF = $FFFF; { признак конца файла }

{ Вспомогательная функция: чтение одного символа из файла.
  Возвращает прочитанный символ в младшем байте слова или
  EOF при достижении конца файла или ошибке.
 }
function getc( var f: file ) : word;
var b: byte;
 nRead : word;
begin
 BlockRead( f, b, 1, nRead );
 if nRead = 0 then getc := EOF
 else getc := b;
end;

{
Вспомогательная процедура: запись одного байта в файл.
  Контроля на ошибки нет.
}
procedure putc( b: byte; var f: file );
var nWritten : word;
begin
 BlockWrite( f, b, 1, nWritten );
end;


const
 input_bit_count : integer = 0; { число битов во входном буфере }
 input_bit_buffer : longint = 0; { буфер для считанных из запакованного файла битов }

{ нам нужно будет извлекать биты посредством битового сдвига вправо,

  но в Turbo Pascal нет беззнаковых длинных целых, поэтому используем
 absolute для доступа к старшему слову input_bit_buffer как
 input_bit_array[1]
}
var input_bit_array : array[0..1] of word absolute input_bit_buffer;


{------------------------------------------------------------------
 Функция возвращает очередной битовый код из запакованного файла.
 ------------------------------------------------------------------}
function input_code( var input: file ): word;
begin
 {
пока в буфере есть место для очередного байта...}
 while input_bit_count <= 24 do begin
  {...помещаем следующий байт из файла справа от ранее прочитанных битов }
  input_bit_buffer := input_bit_buffer or
   ( longint(getc(input)) shl (24-input_bit_count) );

  inc( input_bit_count, 8 ); { счетчик битов в буфере }
 end;

 { Возвращаемое значение (очередной код) - старшие BITS битов из буфера.
   Этот код должен быть возвращен в младших 
 битах результата,
   поэтому сдвигаем его вправо:
  input_code := input_bit_buffer shr (32-BITS);
   Но так делать нельзя, поскол
ьку при сдвиге вправо идет заполнение
   знаковым битом, поэтому берем эти BITS битов из старшего слова }
 input_code := input_bit_array[1] shr (16-BITS);

 { удаляем прочитанный код из буфера }
 input_bit_buffer := input_bit_buffer shl BITS;

 { корректируем счетчик битов }
 dec( input_bit_count, BITS );
end;


{------------------------------------------------------------------
  Эта функция просто декодирует строку по переданному коду,
  сохраняя ее в стеке. Затем
стек выводится в обратном порядке
  процедурой распаковки (expand).
  Возвращает указатель на вершину стека (первый символ строки).
 ------------------------------------------------------------------}
function decode_string( stack_top: integer; code: word ): integer;
var p : PByte;
begin
 while code > 255 do begin
  { помещаем очередной символ на вершину стека }
  decode_stack^[stack_top] := append_character^[code];
  inc( stack_top ); { пр
 одвигаем указатель стека }

  code := prefix_code^[code];
  { проверим, есть ли место в стеке для очередного символа }
  if stack_top >= stack_size then begin
   getmem( p, stack_size+1024 );
   move( decode_stack^, p^, stack_size );
   freemem( decode_stack, stack_size );
   decode_stack := p;
   inc( stack_size, 1024 );
  end;
 end;
 decode_stack^[stack_top] := code;
 decode_string := stack_top;
end;

{ Процедура распаковки файла, сжатого алгоритмом LZW }
procedure
expand( var input, output: file; userInfo: userInfoProc );
var
 next_code, new_code, old_code: word;
 character : byte;
 counter   : longint;
 stack_top : integer; { индекс вершины стека; должен быть знаковым }
begin
 { инициализируем распаковщик }
 getmem( prefix_code, TABLE_SIZE*sizeof(word) );
 getmem( append_character, TABLE_SIZE*sizeof(byte));
 stack_size := 1024;
 getmem( decode_stack, 1024 );

 next_code := 256; {
  первый доступный код }
 counter := 0;       { счетчик для показа процесса распаковки }
 userinfo( 0 );  { информируем вызывающую программу о начале распаковки }

 old_code := input_code( input ); { первый код  }
 character := old_code;              { это всегда первый символ исходного файла }
 putc( old_code, output );           { записываем его в файл }
 inc( counter );

 new_code := input_code(input);  { читаем очередной код из файла }
 while new_code <> MAX_VALUE do begin
{ пока не распаковали все ... }
  { Следующий код проверяет специальный случай
    STRING+CHARACTER+STRING+CHARACTER+STRING
    при котором генерируется неизвестный код. }
  if new_code >= next_code then begin
   decode_stack^[0] := character;
   stack_top := decode_string( 1, old_code );
  end
  { иначе мы просто декодируем очередной код }
  else
   stack_top := decode_string( 0, new_code );

  { Выводим декодированную строку из
  стека в файл. }
  character := decode_stack^[stack_top];
  while stack_top >= 0 do begin
   { записываем символ с вершины стека в файл }
   putc( decode_stack^[stack_top], output );
   inc( counter );
   if (counter and $FFF) = 0 then { каждые 4 килобайта }
    userInfo( counter );  { информируем вызывающую программу }

   { выкидываем символ с вершины посредством продвижения указателя вниз }
   dec( stack_top );
  end;

  { заполняем таблицы, пока есть место - аналогично
LZW-компрессору }
  if next_code <= MAX_CODE then begin
   prefix_code^[next_code] := old_code;
   append_character^[next_code] := character;
   inc( next_code );
  end;
  old_code := new_code;
  new_code := input_code(input); { читаем очередной код из файла }
 end;

 { закончили, освобождаем память }
 freemem( prefix_code, TABLE_SIZE*sizeof(word) );
 freemem( append_character, TABLE_SIZE*sizeof(byte));
 freemem( decode_sta
 ck, stack_size );
end;

BEGIN
END.


В Turbo Pascal нельзя индексировать указатели, поэтому для обхода этого ограничения отключается контроль индексов, объявляются типы

a_word = array[0..0] of word
a_byte = array[0..0] of byte;

и используются указатели, например:

var append_character : ^a_byte;

После этого можно индексировать: append_character^[i]. (Здесь индексируется не указатель, а массив из одного элемента, на который он указывает. Благодаря отключенной проверке индексов мы получаем то, что требуется.)
Этот метод позволяет избежать статического объявления довольно больших (для реального режима процессора) массивов и эффективнее использовать память.

В программе практически нет контроля ошибок.

В задании требуется сделать отдельно модуль работы со словарем и модуль распаковщик. Если приведенного модуля недостаточно и его требуется разбить на два, то обращайтесь в минифорум.

Отлажено и протестировано в Borland Pascal 7.0
Успехов!

Приложение:

Ответ отправил: amnick, Студент
Ответ отправлен: 21.05.2010, 16:05
Номер ответа: 261550

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 261550 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.15 от 18.05.2010
    В избранное