fork download
copy 
  1. {$MODE DELPHI} // Режим совместимости для работы с классами
  2. program HuffmanFPC;
  3.  
  4. uses
  5.   SysUtils, Classes; // Classes содержит классический TList
  6.  
  7. type
  8.   // Узел дерева
  9.   PHuffmanNode = ^THuffmanNode; // Определяем тип-указатель
  10.   THuffmanNode = record
  11.     Ch: Char;
  12.     Freq: Integer;
  13.     Left, Right: PHuffmanNode;
  14.   end;
  15.  
  16. // Функция создания нового узла
  17. function NewNode(ACh: Char; AFreq: Integer; ALeft: PHuffmanNode = nil; ARight: PHuffmanNode = nil): PHuffmanNode;
  18. var
  19.   Node: PHuffmanNode;
  20. begin
  21.   New(Node); // Выделяем память вручную
  22.   Node^.Ch := ACh;
  23.   Node^.Freq := AFreq;
  24.   Node^.Left := ALeft;
  25.   Node^.Right := ARight;
  26.   Result := Node;
  27. end;
  28.  
  29. // Сравнение узлов для сортировки (по возрастанию частоты)
  30. function CompareNodes(Item1, Item2: Pointer): Integer;
  31. begin
  32.   Result := PHuffmanNode(Item1)^.Freq - PHuffmanNode(Item2)^.Freq;
  33. end;
  34.  
  35. // Рекурсивный обход для вывода кодов
  36. procedure PrintCodes(Node: PHuffmanNode; CurrentCode: string);
  37. begin
  38.   if Node = nil then Exit;
  39.  
  40.   // Если это лист (символ)
  41.   if (Node^.Left = nil) and (Node^.Right = nil) then
  42.     Writeln('"', Node^.Ch, '": ', CurrentCode);
  43.  
  44.   PrintCodes(Node^.Left, CurrentCode + '0');
  45.   PrintCodes(Node^.Right, CurrentCode + '1');
  46. end;
  47.  
  48. var
  49.   TextStr: string;
  50.   Freq: array[0..255] of Integer; // Массив для частот (проще словаря)
  51.   NodeList: TList;                // Классический список указателей
  52.   i: Integer;
  53.   Left, Right, Parent: PHuffmanNode;
  54.  
  55. begin
  56.   TextStr := 'huffman linux fpc';
  57.   Writeln('Input: ', TextStr);
  58.  
  59.   // 1. Считаем частоты через массив ASCII
  60.   FillChar(Freq, SizeOf(Freq), 0);
  61.   for i := 1 to Length(TextStr) do
  62.     Inc(Freq[Ord(TextStr[i])]);
  63.  
  64.   // 2. Создаем список начальных узлов
  65.   NodeList := TList.Create;
  66.   for i := 0 to 255 do
  67.     if Freq[i] > 0 then
  68.       NodeList.Add(NewNode(Char(i), Freq[i]));
  69.  
  70.   // 3. Строим дерево
  71.   while NodeList.Count > 1 do
  72.   begin
  73.     // Сортируем список по частоте
  74.     NodeList.Sort(@CompareNodes);
  75.  
  76.     // Берем два самых маленьких (первые два после сортировки)
  77.     Left := PHuffmanNode(NodeList[0]);
  78.     Right := PHuffmanNode(NodeList[1]);
  79.  
  80.     // Создаем родителя
  81.     Parent := NewNode(#0, Left^.Freq + Right^.Freq, Left, Right);
  82.  
  83.     // Удаляем детей из списка и добавляем родителя
  84.     NodeList.Delete(0);
  85.     NodeList.Delete(0);
  86.     NodeList.Add(Parent);
  87.   end;
  88.  
  89.   // 4. Выводим коды
  90.   Writeln('Codes:');
  91.   if NodeList.Count > 0 then
  92.     PrintCodes(PHuffmanNode(NodeList[0]), '');
  93.  
  94.   // Очистка (в идеале нужно рекурсивно удалить всё дерево, но для теста хватит и этого)
  95.   NodeList.Free;
  96.   Writeln('Done. Press Enter.');
  97.   Readln;
  98. end.
Success #stdin #stdout 0.01s 5316KB
comments (?)
stdin
copy 
7 21
1 2 547152
1 3 509157
1 4 539282
1 5 541645         
1 6 458433
1 7 385173

2 3 131528
2 4 92735
2 5 150511
2 6 94440
2 7 194542
3 4 216600
3 5 272401
3 6 157176
3 7 124077
4 5 57785
4 6 97323
4 7 242232
5 6 136663
5 7 283862
6 7 147426
stdout
copy 
Input: huffman linux fpc
Codes:
"l": 0000
"i": 0001
"x": 0010
"p": 0011
"c": 0100
"a": 0101
"u": 011
" ": 100
"m": 1010
"h": 1011
"n": 110
"f": 111
Done. Press Enter.
https://ideone.com/mTi7RV
language:
Pascal (fpc 3.0.4)
created:
1 day ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!