program WordDictionaryCompression;
{$mode objfpc}{$H+}
{$modeswitch generics}
{$modeswitch advancedrecords}
{$inline on} // Encourages FPC to inline subroutines marked as inline
// Optional: If you want to suppress harmless inline notes specifically:
{$warn 6018 off} // Turns off "Call to subroutine marked as inline is not inlined"
{
=====================================================================
High‑Performance Reversible Text Compression Using a Word Dictionary
---------------------------------------------------------------------
This program compresses text by replacing repeated words with tokens
like @0, @1, @2... and stores each unique word in a dictionary.
The compressed text is fully reversible.
WHY THIS VERSION IS FAST (Free Pascal):
---------------------------------------
• Uses Generics.Collections.TDictionary for O(1) average lookup.
• Uses TStringList for compact dictionary storage.
• Clean, idiomatic, modern Free Pascal design.
OUTPUT EXAMPLE:
Original: this is is a test test compression string string test
Compressed: @0 @1 @1 @2 @3 @3 @4 @5 @5 @3
Decompressed: this is is a test test compression string string test
=====================================================================
}
uses
SysUtils, Classes, Generics.Collections;
type
TIntDictionary = specialize TDictionary<string, Integer>;
// ---------------------------------------------------------------------
// Dictionary structure: vector + hash table
// ---------------------------------------------------------------------
TDictionary = record
Words: TStringList; // index → word
IndexMap: TIntDictionary; // word → index
end;
// Helper procedure to safely construct internal structures of record
procedure InitDictionary(var Dict: TDictionary);
begin
Dict.Words := TStringList.Create;
Dict.IndexMap := TIntDictionary.Create;
end;
// Helper procedure to clean up heap objects owned by record
procedure FreeDictionary(var Dict: TDictionary);
begin
Dict.Words.Free;
Dict.IndexMap.Free;
end;
// ---------------------------------------------------------------------
// Find or add a word to the dictionary (O(1) average)
// ---------------------------------------------------------------------
function FindOrAdd(var Dict: TDictionary; const Word: string): Integer;
begin
if Dict.IndexMap.TryGetValue(Word, Result) then
Exit; // Found
// Not found → add new word
Result := Dict.Words.Count;
Dict.Words.Add(Word);
Dict.IndexMap.Add(Word, Result);
end;
// ---------------------------------------------------------------------
// Compress text into @ID tokens
// ---------------------------------------------------------------------
function Compress(const InputStr: string; var Dict: TDictionary): string;
var
i, start: Integer;
Word: string;
ID: Integer;
begin
Result := '';
// Reserve internal capacity if needed via SetLength optimization
SetLength(Result, 0);
i := 1;
while i <= Length(InputStr) do
begin
// Pass punctuation/spaces directly
if not (InputStr[i] in ['A'..'Z', 'a'..'z', '0'..'9']) then
begin
Result += InputStr[i];
Inc(i);
Continue;
end;
// Extract word
start := i;
while (i <= Length(InputStr)) and (InputStr[i] in ['A'..'Z', 'a'..'z', '0'..'9']) do
Inc(i);
Word := Copy(InputStr, start, i - start);
// Get dictionary index
ID := FindOrAdd(Dict, Word);
// Write token
Result += '@' + IntToStr(ID);
end;
end;
// ---------------------------------------------------------------------
// Decompress @ID tokens back into original text
// ---------------------------------------------------------------------
function Decompress(const Compressed: string; const Dict: TDictionary): string;
var
i: Integer;
ID: Integer;
begin
Result := '';
i := 1;
while i <= Length(Compressed) do
begin
// Token?
if Compressed[i] = '@' then
begin
Inc(i);
ID := 0;
while (i <= Length(Compressed)) and (Compressed[i] in ['0'..'9']) do
begin
ID := ID * 10 + (Ord(Compressed[i]) - Ord('0'));
Inc(i);
end;
if (ID >= 0) and (ID < Dict.Words.Count) then
begin
Result += Dict.Words[ID];
end;
end
else
begin
// Pass punctuation/spaces
Result += Compressed[i];
Inc(i);
end;
end;
end;
// ---------------------------------------------------------------------
// Main
// ---------------------------------------------------------------------
var
Original, CompressedStr, DecompressedStr: string;
Dict: TDictionary;
i: Integer;
begin
Original :=
'this is is a test test compression string string test ' +
'this is a test compression';
InitDictionary(Dict);
CompressedStr := Compress(Original, Dict);
DecompressedStr := Decompress(CompressedStr, Dict);
WriteLn('Original: "', Original, '"');
WriteLn('Compressed: "', CompressedStr, '"');
WriteLn('Decompressed: "', DecompressedStr, '"');
WriteLn;
WriteLn('Dictionary:');
for i := 0 to Dict.Words.Count - 1 do
WriteLn(' @', i, ' => ', Dict.Words[i]);
FreeDictionary(Dict);
end.
{
run:
Original: "this is is a test test compression string string test this is a test compression"
Compressed: "@0 @1 @1 @2 @3 @3 @4 @5 @5 @3 @0 @1 @2 @3 @4"
Decompressed: "this is is a test test compression string string test this is a test compression"
Dictionary:
@0 => this
@1 => is
@2 => a
@3 => test
@4 => compression
@5 => string
}
