Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.05.2012, 11:11   #1
Iren1993
 
Регистрация: 30.10.2011
Сообщений: 8
По умолчанию Реализация Алгоритма Хаффмана

Здравствуйте.
Прошу помочь, есть программа на ABC паскале, но необходимо чтобы было написано в Turbo паскале. Нужно ее исправить.
Если возможно, сделать проще и понятнее.
Ниже прикреплена программа.
И так же фотография как это все должно выводится на экране.
Код:
uses crt;
var
st:string;
m:array[#0..#255] of integer;
i,p,j:integer;
s:real;
h:array [1..255] of real;
ch:char;
sum: array[1..255] of real;
v: array[1..255] of string;
z: array[1..255] of string;
kod: array[1..255] of string;
i_min,j_min,x:integer;
min1,min2:real;


begin
Writeln('Введите алфавит',st);
readln(st);

{вычисляем вероятности символов}
For i:=1 to length(st) do
begin
inc(m[st[i]]);
end;

 i:=1;
 for ch:=#0 to #255 do  begin
 if m[ch]>0 then
 {writeln(ch,' ',m[ch]);}
 if m[ch]>0 then  begin
  h[i]:=1/length(st)* m[ch];
  {writeln(h[i]:2:3,' ');}
  i:=i+1;
 end;
 end;

 s:=0;
 p := i-1;
  
 {Кодирование}
 
 begin
    i:=1;
    begin
     for ch:=#0 to #255 do
     if m[ch]>0 then begin v[i]:=ch;i:=i+1; end;
    end;
     writeln; write('алфавит:        ');
     for i:=1 to p do
     write(v[i],'      ');
     
     for i:=1 to p do
     z[i]:=v[i];                  {создаём неизменяемую строку алфавита}
     

    begin
     for i:=1 to p do
    sum[i]:=h[i];
    writeln; Write('вероятности: ');
     for i:=1 to p do
    write(Sum[i]:2:3,' ');
    end;

   repeat
    i_min:=1;
    sum[i_min]:=sum[1];
   for i:=2 to p do
     if sum[i]< sum[i_min] then begin
     i_min:=i;
     sum[i_min]:=sum[i];
     end;

     writeln;
     write('min1=',sum[i_min]:2:2);
     min1:=sum[i_min];     {Убираем первый минимум}
     sum[i_min]:=1;
     
     j_min:=1;
    sum[j_min]:=sum[1];
   for i:=2 to p do
     if sum[i]< sum[j_min] then begin
     j_min:=i;
     sum[j_min]:=sum[i];
     end;
     
     writeln;
     write('min2=',sum[j_min]:2:2);
     sum[i_min]:=min1;  {возвращаем значение первого минимума}
     
     if (i_min > j_min) then begin x:=i_min;
                                   i_min:=j_min;
                                   j_min:=x;

      end;

     sum[i_min]:=sum[i_min]+sum[j_min];
     sum[j_min]:=2;
         writeln;
     for i:=1 to p do
    write(sum[i]:2:2,'  ');
    
    
         {if length(v[i_min])>1 then begin }
     for i:=1 to p do begin
      for j:=1 to length(v[i_min]) do
      if (z[i]=copy(v[i_min],j,1))
      then begin kod[i]:='0' + kod[i];
                   i:=i+1;
      end;
      end;

    
    
            {if length(v[j_min])>1 then begin}
     for i:=1 to p do begin
      for j:=1 to length(v[j_min]) do
      if (z[i]=copy(v[j_min],j,1))
      then begin kod[i]:='1' + kod[i];
                   i:=i+1;
      end;
      end;

    v[i_min]:=v[i_min]+v[j_min];
     v[j_min]:='_';
         writeln;
     for i:=1 to p do
    write(v[i],'  ');
    writeln;
    for i:=1 to p do
    write(kod[i],'  ');
     
    until length(v[i_min])=p;
    end;
    end.
Изображения
Тип файла: jpg DSC00338.jpg (127.1 Кб, 163 просмотров)
Iren1993 вне форума Ответить с цитированием
Старый 22.05.2012, 21:26   #2
Iren1993
 
Регистрация: 30.10.2011
Сообщений: 8
По умолчанию

Помогите пожалуйста!!!
Очень нужно!
Iren1993 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Реализация цикличного алгоритма С++ zpMirtzp Помощь студентам 3 12.05.2011 13:34
Реализация кодирования методом Хаффмана на Pascal Azarat Помощь студентам 3 06.12.2010 09:34
Дерево для алгоритма Хаффмана 0479 Помощь студентам 0 18.10.2010 07:17
реализация метода Хаффмана ShturmBan Помощь студентам 2 13.01.2010 15:46
Реализация метода Хаффмана Minton87 Помощь студентам 0 27.12.2009 20:30