Сжатие строК!

[Карась]

Вообщем суть проста:
1. В двумерный массив заносим все комбинации двузначного числа + пробел. Это в первый столбец. Во второй столбец одиночный символ.
Как несложно подсчитать все возможные комбинации двузначного числа составят 11 * 11 = 121. И как раз однозначных символов у нас немного больше... по моим грубым подсчётам 140 - 150....

2. Берём из строки по два символа и ищем в первом столбце. Как только нашли, добавляем в текстполе одиночный символ из второго столбца.
Ну вот и получается 2:1.

Еслиже строка нечётна то последний символ тупо припллюсовываем.

[Alar]

метод Фано

Отличается чрезвычайной простотой конструкции и заключается в следующем - упорядоченный в порядке убывания вероятностей список букв делится на две последовательные части так, чтобы суммы вероятностей входящих в них букв как можно меньше отличались друг от друга. Всем буквам из первой части приписывается символ 0, а буквам из второй символ 1. Далее также поступаем с каждой из полученных двух частей, если они содержат по крайней мере две буквы. Продолжать до тех пор, пока весь список не разобьется на части содержащие по 1 букве.

Каждой букве ставится последовательность символов приписанных в результате данного процесса букве (в вашем случае битов, например)

В результате, самые встречающиеся буквы будут иметь наименьшую длину в битах.

На форуме есть курсовик на эту тему от zetrix.

[Alar]

Пример из сети

Рассмотрим алгоритм вычисления кодов Шеннона-Фано (для наглядности возьмём в качестве примера последовательность 'aa bbb cccc ddddd'). Для вычисления кодов, необходимо создать таблицу уникальных символов сообщения c(i) и их вероятностей p(c(i)), и отсортировать её в порядке невозрастания вероятности символов.

c(i)	              p(c(i))              
d	              5 / 17
c	              4 / 17
space	              3 / 17
b	              3 / 17
a	              2 / 17

Далее, таблица символов делится на две группы таким образом, чтобы каждая из групп имела приблизительно одинаковую частоту по сумме символов. Первой группе устанавливается начало кода в '0', второй в '1'. Для вычисления следующих бит кодов символов, данная процедура повторяется рекурсивно для каждой группы, в которой больше одного символа. Таким образом для нашего случая получаем следующие коды символов:

символ	              код
d	              00
c	              01
space	              10
b	              110
a	              111

Длина кода s(i) в полученной таблице равна int(-lg p(c(i))), если сиволы удалость разделить на группы с одинаковой частотой, в противном случае, длина кода равна int(-lg p(c(i))) + 1.
int(-lg p(c(i))) <= s(i) <= int(-lg p(c(i))) + 1


Успользуя полученную таблицу кодов, кодируем входной поток - заменяем каждый символ соответствующим кодом. Естественно для расжатия полученной последовательности, данную таблицу необходимо сохранять вместе со сжатым потоком, что является одним из недостатков данного метода. В сжатом виде, наша последовательность принимает вид:

111111101101101101001010101100000000000

длиной в 39 бит. Учитывая, что оргинал имел длину равную 136 бит, получаем коэффициент сжатия ~28% - не так уж и плохо.
Глядя на полученную последовательность, возникает вопрос: "А как же теперь это расжать ?". Мы не можем, как в случае кодирования, заменять каждые 8 бит входного потока, кодом переменной длины. При расжатии нам необходимо всё сделать наоборот - заменить код переменной длины символом длиной 8 бит. В данном случае, лучше всего будет использовать бинарное дерево, листьями которого будут являтся символы (аналог дерева Хаффмана).

Кодирование Шеннона-Фано является достаточно старым методом сжатия , и на сегодняшний день оно не представляет особого практического интереса (разве что как упражнение по курсу структур данных). В большинстве случаев, длина сжатой последовательности, по данному методу, равна длине сжатой последовательности с использованием кодирования Хаффмана. Но на некоторых последовательностях всё же формируются не оптимальные коды Шеннона-Фано, поэтому сжатие методом Хаффмана принято считать более эффективным. Для примера, рассмотрим последовательность с таким содержанием символов: 'a' - 14, 'b' - 7, 'c' - 5, 'd' - 5, 'e' - 4. Метод Хаффмана сжимает её до 77 бит, а вот Шеннона-Фано до 79 бит.

символ	              код Хаффмана	              код Шеннона-Фано
a	              	              0	             	               00
b	              	              111	              	              01
c	              	              101	              	              10
d	              	              110	              	              110
e	              	              100	              	              111

Кстати, в одном источнике (не буду указывать каком), эту последовательность сжали методом Шеннона-Фано до 84 бит, а методом Хаффмана до тех же 77. Такие отличаи в степени сжатия возникают из-за нестрогого определения способа деления символов на группы.
Как же мы делили на группы ? Достаточно просто:
вероятноть первой группы (p1) и второй (p2) равна нулю;
p1 <= p2 ?
да: добавить в первую группу символ с начала таблицы;
нет: добавить во вторую группу символ с конца таблицы;
если все символы разделены на группы, то завершить алгоритм, иначе перейти к шагу 2.


Из-за такой неопределённости у некоторых людей возникают даже такие мысли: "... программа иногда назначает некоторым символам ..." и так далее - рассуждения о длине кодов. Если вы не пишете AI, то такое понятие, как "программа иногда" что-то делает, звучит смешно. Правильно реализованный алгоритм - работает строго опеределённо.

[prizrak1390]

СПАСИБО ВСЕМ КТО ПОПЫТАЛСЯ ПОМОЧЬ!!!! Я РЕШИЛ ПРОБЛЕМУ ИСПОЛЬЗОВАВ МЕТОД СЖАТИЯ BASE91. Очень неплохая система сжатия данных(особенно двоичных). И со строками тож не плохо справляется, но недостаток системы сжатия в том, что при обработке файлов малого объёма, программа лишь увеличивает объём :D так например файл ~10Kb после сжатия будет ~12kb. А вот простой файл Flash(*.swf) 2,43Mb после сжатия ~1,4mb. Всё же хоть,что-то)

[Alar]

prizrak1390, можно привести в пример делфи код? в этой теме.

[prizrak1390]

Вот листинг главной форму Base91

unit MainForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
ButtonEncode: TButton;
ButtonDecode: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
InputFileName: TEdit;
OutputFileName: TEdit;
ButtonExit: TButton;
Label1: TLabel;
Label2: TLabel;
ButtonSelectInputFile: TButton;
ButtonSelectOutputFile: TButton;
Label3: TLabel;
procedure ButtonSelectInputFileClick(Sender: TObject);
procedure ButtonSelectOutputFileClick(Sender: TObject);
procedure ButtonDecodeEncodeClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
private
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses
basE91;

procedure TForm1.ButtonDecodeEncodeClick(Send er: TObject);
var
basE91: TBasE91;
fin, fout: TFileStream;
Buf: array[0..1024] of byte;
c: integer;
written: integer;
begin
written := 0;
fin := TFileStream.Create(InputFileName.Te xt, fmOpenRead);
fout := TFileStream.Create(OutputFileName.T ext, fmCreate);
if (TComponent(Sender).Name = 'ButtonEncode') then
base91 := TBase91Encoder.Create(fout);
if (TComponent(Sender).Name = 'ButtonDecode') then
base91 := TBase91Decoder.Create(fout);
if not assigned(basE91) then
begin
Beep;
exit;
end;
while ((fin.Position + SizeOf(Buf)) < fin.Size) do
begin
fin.Read(Buf, SizeOf(Buf));
c := base91.Update(@Buf, 0, SizeOf(Buf));
Inc(written, c);
end;
c := fin.Size - fin.Position;
fin.Read(Buf, c);
c := base91.Update(@Buf, 0, c);
Inc(written, c);
c := base91.Finalize();
Inc(written, c);
base91.Free;
fin.Free;
fout.Free;
ShowMessageFmt('Total bytes written: %d', [written]);
end;


procedure TForm1.ButtonExitClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.ButtonSelectInputFileClick(S ender: TObject);
begin
OpenDialog1.FileName := InputFileName.Text;
if (OpenDialog1.Execute) then
InputFileName.Text := OpenDialog1.FileName;
end;

procedure TForm1.ButtonSelectOutputFileClick( Sender: TObject);
begin
SaveDialog1.FileName := OutputFileName.Text;
if (SaveDialog1.Execute) then
OutputFileName.Text := SaveDialog1.FileName;
end;

end.

[prizrak1390]

А это листинг самого модуля Base91
unit basE91;

interface

uses
SysUtils, Windows, Classes;

type
// Abstract base class for encoding or decoding
TBasE91 = class
protected
FOutputStream: TStream;
public
constructor Create(OutputStream: TStream);
// Returns the number of bytes written to OutputStream
function Update(InputData: PByte; Offset: integer; Length: integer): integer;
virtual; abstract;
// Returns the number of bytes written to OutputStream
function Finalize(): integer; virtual; abstract;
procedure reset(); virtual; abstract;
end;

TBasE91Encoder = class(TBasE91)
private
ebq, en: integer;
protected
public
function Update(InputData: PByte; Offset: integer; Length: integer): integer;
override;
function Finalize(): integer; override;
procedure reset(); override;
end;

TBasE91Decoder = class(TBasE91)
private
dbq, dn, dv: integer;
protected
public
function Update(InputData: PByte; Offset: integer; Length: integer): integer;
override;
function Finalize(): integer; override;
procedure reset(); override;
end;

implementation

const
EncodingTable: array[0..90] of byte = (
Ord('A'), Ord('B'), Ord('C'), Ord('D'), Ord('E'), Ord('F'), Ord('G'), Ord('H'),
Ord('I'), Ord('J'), Ord('K'), Ord('L'), Ord('M'), Ord('N'), Ord('O'), Ord('P'),
Ord('Q'), Ord('R'), Ord('S'), Ord('T'), Ord('U'), Ord('V'), Ord('W'), Ord('X'),
Ord('Y'), Ord('Z'), Ord('a'), Ord('b'), Ord('c'), Ord('d'), Ord('e'), Ord('f'),
Ord('g'), Ord('h'), Ord('i'), Ord('j'), Ord('k'), Ord('l'), Ord('m'), Ord('n'),
Ord('o'), Ord('p'), Ord('q'), Ord('r'), Ord('s'), Ord('t'), Ord('u'), Ord('v'),
Ord('w'), Ord('x'), Ord('y'), Ord('z'), Ord('0'), Ord('1'), Ord('2'), Ord('3'),
Ord('4'), Ord('5'), Ord('6'), Ord('7'), Ord('8'), Ord('9'), Ord('!'), Ord('#'),
Ord('$'), Ord('%'), Ord('&'), Ord('('), Ord(')'), Ord('*'), Ord('+'), Ord(','),
Ord('.'), Ord('/'), Ord(':'), Ord(';'), Ord('<'), Ord('='), Ord('>'), Ord('?'),
Ord('@'), Ord('['), Ord(']'), Ord('^'), Ord('_'), Ord('`'), Ord('{'), Ord('|'),
Ord('}'), Ord('~'), Ord('"'));

var
DecodingTable: array[0..255] of byte;

constructor TBasE91.Create(OutputStream: TStream);
begin
FOutputStream := OutputStream;
Reset();
end;

procedure TBasE91Encoder.Reset();
begin
ebq := 0;
en := 0;
end;

function TBasE91Encoder.Update(InputData: PByte; Offset: integer;
Length: integer): integer;
var
WriteBuf: array[0..1] of byte;
i, ev: integer;
begin
Result := 0;
Inc(InputData, Offset);
for i := 1 to Length do
begin
ebq := ebq or ((InputData^) shl en);
Inc(InputData);
Inc(en, 8);
if (en > 13) then
begin
ev := ebq and 8191;
if (ev > 88) then
begin
ebq := ebq shr 13;
Dec(en, 13);
end
else
begin
ev := ebq and 16383;
ebq := ebq shr 14;
Dec(en, 14);
end;
WriteBuf[0] := EncodingTable[ev mod 91];
WriteBuf[1] := EncodingTable[ev div 91];
FOutputStream.Write(WriteBuf, 2);
Inc(Result, 2);
end;
end;
end;

function TBasE91Encoder.Finalize(): integer;
begin
Result := 0;
if (en > 0) then
begin
FOutPutStream.Write(EncodingTable[ebq mod 91], 1);
Inc(Result);
if ((en > 7) or (ebq > 90)) then
begin
FOutPutStream.Write(EncodingTable[ebq div 91], 1);
Inc(Result);
end;
end;
Reset();
end;

procedure TBasE91Decoder.Reset();
begin
dbq := 0;
dn := 0;
dv := -1;
end;

function TBasE91Decoder.Update(InputData: PByte; Offset: integer;
Length: integer): integer;
var
i: integer;
inputByte: byte;
begin
Result := 0;
Inc(InputData, Offset);
for i := 1 to Length do
begin
inputByte := InputData^;
Inc(InputData);
if (DecodingTable[inputByte] = byte(-1)) then
Continue;
if (dv = -1) then
dv := DecodingTable[inputByte]
else
begin
Inc(dv, DecodingTable[InputByte] * 91);
dbq := dbq or (dv shl dn);
if ((dv and 8191) > 88) then
Inc(dn, 13)
else
Inc(dn, 14);
repeat
FOutputStream.Write(byte(dbq), 1);
Inc(Result);
dbq := dbq shr 8;
Dec(dn, 8);
until (dn <= 7);
dv := -1;
end;
end;
end;

function TBasE91Decoder.Finalize(): integer;
var
OutputByte: byte;
begin
Result := 0;
if (dv <> -1) then
begin
OutputByte := dbq or dv shl dn;
FOutputStream.Write(OutputByte, 1);
end;
Reset();
end;


procedure PrepareDecodingTable();
var
i: integer;
begin
for i := 0 to 255 do
DecodingTable[i] := byte(-1);
for i := 0 to 90 do
DecodingTable[EncodingTable[i]] := i;
end;

begin
PrepareDecodingTable();
end.