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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 17.11.2016, 15:36   #1
Smile189
Пользователь
 
Регистрация: 01.10.2016
Сообщений: 25
По умолчанию Как сделать проверку в реализации алгоритма Хаффмана - при кодировании строки "kkkkkkk" выдавать ошибку о том, что дерево не может быть создано

Алгоритм Хаффмана . При при кодировании, если ввожу такую строку "kkkkkkk", то по идее должно выдавать ошибку о том, что дерево не может быть создано. Подскажите, пожалуйста, как сделать проверку на такой случай, когда мы вводим только одну букву несколько раз?




Код:

Procedure shifr();
 var i, n:integer;
 begin
  writeln('Введите текст: ');
  readln(s);
  for i := 0 to 255 do  //Инициализация  массива(счетчика)
    mass[i] := 0;
  for i := 1 to length(s) do //подсчет числа символов
    inc(mass[ord(s[i])]);//выдает код i-того символа
  n := 0;
  for i := 0 to 255 do
    if mass[i] <> 0 then begin//Формируем листья дерева
      inc(n);
      new(TMass[n]);
      TMass[n]^.N := Mass[i];
      TMass[n]^.symbol := chr(i);
      TMass[n]^.Left := nil;
      TMass[n]^.Right := nil;
    end;      
  Sort(TMass, N);
  
  //Формируем само дерево
  while n > 1 do 
  begin
    new(p);
    p^.n := TMass[n]^.N + TMass[n - 1]^.N;
    p^.left := TMass[n - 1];
    p^.right := TMass[n];
    TMass[n - 1] := p;
    Dec(n); //Уменьшает значение n на 1
    Sort(TMass, N);
  end;
  
  //Подсчитываем число бит для закодированного текста
  n:=0;
  for i:=0 to 255 do
    if mass[i]<>0 then
      n:=n+mass[i]*length(GetCode(p, chr(i), ''));
  Writeln('Число бит закодированного текста: ',n);    
  
  g := '';  //Кодируем строку
  for i := 1 to length(s) do
  begin
  g:=g+GetCode(p, s[i], '');  
  end; 
Writeln('Закодированный текст: ', g);
end;
Код:
function GetCode(T: PTree; C: char; path: string): string;// Возвращает код Хоффманa
begin
  if (T^.Left=nil) and (T^.Right=nil) and (T^.symbol=C) then
    result:=path
  else
    begin
      result:='';
      if T^.left <> nil then 
        result := GetCode(t^.left, C, path + '0');
      if (result='') and (T^.right <> nil) then
        result := GetCode(t^.right, C, path + '1');
    end;
end;
В этой строке выдется ошибка
Код:
if (T^.Left=nil) and (T^.Right=nil) and (T^.symbol=C) then
Smile189 вне форума Ответить с цитированием
Старый 17.11.2016, 16:53   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

во-первых,
отсюда - ТЫЦ

Цитата:
Сообщение от Pisoletka
Здравствуйте, я сейчас пишу программу по алгоритму Хаффмана и столкнулась с проблемой: при кодировании, если ввожу такую строку "kkkkkkk", то по идее должно выдавать ошибку о том, что дерево не может быть создано. Подскажите, пожалуйста, как сделать проверку на такой случай, когда мы вводим только одну букву несколько раз?
Вот моя процедура кодирования:
.......
Цитата(OCTAGRAM @ 7.11.2016 6:21)
Цитата:
Сообщение от OCTAGRAM
По логике алгоритма, если на входе лист (Left и Right не присвоены), а символ в листе отличается от символа в аргументе, надо выходить с пустым результатом, а вместо этого исполнение заходит в else

Цитата(Pistoletka 8.11.2016 0:24)
Сообщение #6
Цитата:
Сообщение от Pistoletka
Спасибо за ответ, но я уже справилась со своей проблемой!
Так проблема уже решена или нет?

а во-вторых,
вы привели не весь код, а только обрывок кода.
Вам есть, что скрывать?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 17.11.2016, 16:57   #3
Smile189
Пользователь
 
Регистрация: 01.10.2016
Сообщений: 25
По умолчанию

нет, не решена
и нет , мне нечего скрывать
Smile189 вне форума Ответить с цитированием
Старый 17.11.2016, 17:23   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Smile189 Посмотреть сообщение
нет, не решена
понятно.
а зачем Вы сказали, что проблема решена на том форуме?
чтобы от Вас отвязались?


Цитата:
Сообщение от Smile189 Посмотреть сообщение
и нет , мне нечего скрывать
тогда где полный код программы?

ну и ещё.
я, конечно, не специалист в кодировании деревом Хаффмана, но с чего Вы решили, что для одного символа дерево построить невозможно?
в теории это дерево, которое состоит из одного листа, расположенного в корне.
т.е. код "0" сразу, без развилок приводит к нужному символу, и ваша строчка
kkkkkkk кодируется 7-ю нулевыми битами.
Если я не ошибаюсь, конечно...
Serge_Bliznykov вне форума Ответить с цитированием
Старый 17.11.2016, 21:21   #5
Smile189
Пользователь
 
Регистрация: 01.10.2016
Сообщений: 25
По умолчанию

Вот код. Поможете исправить?

Код:

program laba6;

type
  PTree = ^TTree;
  TTree = record
    symbol: char;
    N: integer;
    Left, Right: PTree;
  end;
  TreeMass = array[1..256] of PTree;

var
  s, g, z: string;
  doing:char;
  mass: array [0..255] of integer;
  TMass: TreeMass;
 // i, j, n: integer;
  P, Q: PTree;

procedure Sort(var mass: Treemass; n: integer);//Сортируем элементы массива по убыванию
var
  p: PTree;
  i, j: integer;
begin
  for i := 1 to n - 1 do
    for j := i + 1 to n do
      if mass[i]^.N < mass[j]^.N then 
      begin
        p := mass[i];
        mass[i] := mass[j];
        mass[j] := p;
      end; 
end;

function GetCode(T: PTree; C: char; path: string): string;// Возвращает код Хоффманa
begin
  if (T^.Left=nil) and (T^.Right=nil) and (T^.symbol=C) then
    result:=path
  else
    begin
      result:='';
      if T^.left <> nil then 
        result := GetCode(t^.left, C, path + '0');
      if (result='') and (T^.right <> nil) then
        result := GetCode(t^.right, C, path + '1');
    end;
end;

 Procedure shifr();
 var i, n:integer;
 begin
  writeln('Введите текст: ');
  readln(s);
  for i := 0 to 255 do  //Инициализация  массива(счетчика)
    mass[i] := 0;
  for i := 1 to length(s) do //подсчет числа символов
    inc(mass[ord(s[i])]);//выдает код i-того символа
  n := 0;
  for i := 0 to 255 do
    if mass[i] <> 0 then begin//Формируем листья дерева
      inc(n);
      new(TMass[n]);
      TMass[n]^.N := Mass[i];
      TMass[n]^.symbol := chr(i);
      TMass[n]^.Left := nil;
      TMass[n]^.Right := nil;
    end;      
  Sort(TMass, N);
  
  //Формируем само дерево
  while n > 1 do 
  begin
    new(p);
    p^.n := TMass[n]^.N + TMass[n - 1]^.N;
    p^.left := TMass[n - 1];
    p^.right := TMass[n];
    TMass[n - 1] := p;
    Dec(n); //Уменьшает значение n на 1
    Sort(TMass, N);
  end;
  
  //Подсчитываем число бит для закодированного текста
  n:=0;
  for i:=0 to 255 do
    if mass[i]<>0 then
      n:=n+mass[i]*length(GetCode(p, chr(i), ''));
  Writeln('Число бит закодированного текста: ',n);    
  
  g := '';  //Кодируем строку
  for i := 1 to length(s) do
  begin
  g:=g+GetCode(p, s[i], '');  
  end; 
Writeln('Закодированный текст: ', g);
end;
Procedure rasshifr(); //Декодируем строку
 var i:integer; 
 begin
writeln('Введите код: ');
readln(z);
s:='';
Q:=P;
for i:=1 to length(z) do
  begin
    if z[i]='0' then
      Q:=Q^.Left
    else 
      Q:=Q^.Right;
    if (Q^.Left=nil) and (Q^.Right=nil) then
      begin
      s:=s+Q^.symbol;
      Q:=P;
    end;
  end;
  
Writeln('Раскодированный текст: ', s); 
end; 
begin
 repeat
  writeln('Для кодирования введите 1');
  writeln('Для раскодирования введите 2');
  writeln('Чтобы выйти введите 3');
  readln(doing);
  case doing of
  '1':shifr();
  '2':rasshifr();
  end;
  until doing = '3'     
end.
Smile189 вне форума Ответить с цитированием
Старый 17.11.2016, 22:17   #6
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

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

Код:
  //Формируем само дерево
  if n=1 then begin
    new(p);
    p^.n := TMass[n]^.N;
    p^.left := TMass[n];
    p^.right := nil;
  end;
  while n > 1 do 
  begin
    new(p);
    p^.n := TMass[n]^.N + TMass[n - 1]^.N;
    p^.left := TMass[n - 1];
    p^.right := TMass[n];
    TMass[n - 1] := p;
    Dec(n); //Уменьшает значение n на 1
    Sort(TMass, N);
  end;
Serge_Bliznykov вне форума Ответить с цитированием
Старый 17.11.2016, 22:24   #7
Smile189
Пользователь
 
Регистрация: 01.10.2016
Сообщений: 25
По умолчанию

спасибо, все работает
Smile189 вне форума Ответить с цитированием
Старый 17.11.2016, 22:25   #8
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

не за что! Успехов!
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Может быть можно что-то сделать с видеокартой в ноуте Qaliti Компьютерное железо 6 05.06.2014 01:07
Может быть я допустил ошибку при отправке файла? TUberwer Общие вопросы Delphi 1 11.07.2013 21:47
Должно быть 3 потока. А диспетчер задач показывает, что потока создано 2 BEL9ILLI Общие вопросы Delphi 3 06.12.2011 20:26
Дерево для алгоритма Хаффмана 0479 Помощь студентам 0 18.10.2010 07:17
Может быть так, что в мамку может попасть вирус и не загружать жесткий диск Berzhan Операционные системы общие вопросы 6 27.07.2009 21:40