Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 01.07.2012, 15:27   #1 (permalink)
lena_stud
Новичок
 
Регистрация: 21.06.2012
Сообщений: 6
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Pascal, помогите дописать программу

Здраствуйте, не могу доделать программу (строит код хаффмана). В процедуре return (действия процедуры должны изменять массив b) есть ошибка (фозможно в описаниии формальных параметров), какая именно понять не могу. Также в основном теле программы нужно вставить textcolor(10)-чтобы выделял зеленым цветом числа, полученные в результате сложения, и textcolor(15)-для всех остальных чисел. Уже всю голову сломала, пытаясь вставить в нужном месте, но либо все числа были зеленые, либо все белые. Вот сам код:
Код:
program xaffmen;
 uses CRT;
 const n=5;
 type matrix1=array[1..n,1..n] of real;
 type matrix2=array[1..n,1..n] of string;
 type mas1=array [1..n] of byte;
 const dano: array [1..n] of real=(0.53, 0.23, 0.13, 0.06, 0.05);
 var a:matrix1; b:matrix2; k,m,i,j,l:byte; num: mas1; sum: real;



 procedure insert (n,k:byte; x:real; col:byte; var a:matrix1; var num: mas1);
  var i1:byte;
  begin
   for i1:=1 to n-col do a[i1,col]:=a[i1,col-1];
   a[n-col+1,col]:=x;
   i1:=n-col;
   while (i1>=1) and (x>a[i1,col]) do begin 
                                                 a[i1+1,col]:=a[i1,col];  
                                                 a[i1,col]:=x; 
                                                 i1:=i1-1;
                                                 end;
   num[col]:=i1+1;
  end;

 procedure return (n,k,col,numr:byte; var b:matrix2);
  var i1,j1:byte; s:string;
  begin
  for i1:=1 to n-col do b[i1,col]:=b[i1,col+1];
  s:=b[numr,col];
  for i1:=numr to n-col do b[i1,col]:=b[i1+1,col];
  b[n-col,col]:=s+'0';  
  b[n-col+1,col]:=s+'1';
  end;

 begin
  {vvod veroiatnostei}
   clrscr;
   k:=n;
    for i:=1 to k do
    for j:=1 to k do
     if j<>1 then a[i,j]:=0
               else a[i,j]:=dano[i];

 {vstavka chisla}
 for j:=1 to k-1 do
  begin
  i:=n+1-j;
  sum:=a[i,j]+a[i-1,j];

  insert (n,k,sum,j+1,a,num);
  end;

  {raspredelenie kodov}
  b[1,k]:='0';
  b[2,k]:='1';
  for j:=k-1 downto 1 do return (n,k,j,num[j+1], b);
 
 {vivod kodov elementov}
  clrscr;
  for i:=1 to n do begin
                       for j:=1 to k do 
                        if a[i,j]>0 then begin textcolor(10);write(a[i,j]:6:2);end
                                     else textcolor (15); 
                      gotoxy(k*6+1,i);
                      for j:=1 to k do write(b[i,j]:6);
                      writeln;
                      end;
  writeln ;

 readkey;
 end.
Должно получаться примерно так (рис слева)
а получается пока так (рис справа)
Миниатюры
ris.png   ris1.png  
lena_stud вне форума   Ответить с цитированием

Старый 01.07.2012, 15:27
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Участники форума когда то создавали аналогичные темы

Помогите написать программу в Delphi Pascal
Помогите пожалуйста написать программу "гусеница" на Turbo Pascal 7.0
Написать программу в Pascal ABC
Дописать две строчки в Pascal
Пожалуйста, помогите написать программу Pascal Free
Помогите, пожалуйста, дописать программу

Старый 01.07.2012, 20:03   #2 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,343
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lena_stud Посмотреть сообщение
есть ошибка (фозможно в описаниии формальных параметров), какая именно понять не могу
Да, фозможно, даже скорее фсего.
К сожалению, я насчет кода Хаффмана не в курсе, но вот чего не пойму: в качестве формального параметра процедур insert и return фигурирует k, однако я не вижу, чтобы он использовался в теле этих процедур. Нет ли здесь ошибки?

P.S. Вообще-то я мог бы попробовать отладить Вашу программу, даже интересно, это не максимальные значения массивов искать, но только если Вы подробно на словах распишете свой алгоритм. Восстанавливать из неотлаженной программы - дело IMHO дохлое.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 02.07.2012, 18:17   #3 (permalink)
lena_stud
Новичок
 
Регистрация: 21.06.2012
Сообщений: 6
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

насчет параметра k- да, он там не нужен (я проверила)

алгоритм программы

(ввод вероятностей)
в ходе этого куска программы присваиваются значения a[1,1]:=0,53; a[2,1]:=0,23; a[3,1]:=0,13; a[4,1]:=0,06; a[5,1]:=0,05 (т.е первый столбик готов)

(вставка числа)
здесь находим сумму(sum) двух последних чисел ( в процедуре insert это будет x ), далее идет insert: здесь в итоге будет a[1,2]:=0,53; a[2,2]:=0,23; a[3,2]:=0,13; a[4,2]:=0,11(это сумма последних двух чисел в первом столбике), условие while делает так, что числа идут в порядке убывания; анологично 3,4,5 столбцы : a[1,3]:=0,53; a[2,3]:=0,24 (0,13+0,11); a[3,3]:=0,23; a[4,1]:=0,53; a[4,2]:=0,47( 0,23+0,24); a[5,1]:=1,00

(распределение кодов- здесс массив из символьных данных)
b[1,5]:='0' b[2,5]:='1' (на эту еденичку внимания не обращаем, нас интересует нолик)

Суть кода хаффмана(примерная):
этому b[1,5] соответствует a[5,1], то есть 1,00 ставится в соответствие символ '0', дальше смотрим 4 столбец матрицы а: так как 1,00 это сумма 0,53 и 0,47 то у обоих уже будет по нолику и дополнительно приписываем '0' к '0' у числа 0,53( т.к оно больше чем 0,47) и '1' к '0' у 0,47 , т.е в итоге числу 0,53 будет соответ. '00' ; числу 0,47 будет соответ.'01'.
смотрим 3 столбец матрицы а: 0,53 известно- '00' ; числу 0,24 будет соот. '010' ; числу 0,23 - '011' (т.к 0,24 и 0,23 в сумме дали 0,47, а его соответствие известно, это '01' , тогда для 0,24 приписывается еще '0' (т.к оно > 0,23) и получится '010' ( '01'+'0' ) и для 0,23 приписывается '1' и получится '011' ( '01'+'1') ( '0' и '1' это символы, а не числа)
2 и 1 столбцы матрицы a анологично.

Так вот процедура retutn примерно это и делает. И в итоге в первом столбце массива b (в этом варианте программы) будет окончательное представление чисел 0,53; 0,23; 0,13; 0,06; 0,05 в виде кода хаффмана. Т.е b[1,1]:='00' b[2,1]:='011'; b[3,1]:='0100' b[4,1]:='01010' b[5,1]:='01011'

(вывод кодов элементов)
ну а здесь уже выводятся на экран эти массивы a и b

надеюсь объяснила понятно
lena_stud вне форума   Ответить с цитированием
Старый 02.07.2012, 18:53   #4 (permalink)
lena_stud
Новичок
 
Регистрация: 21.06.2012
Сообщений: 6
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

часть кода ( raspredelenie kodov) пошагово (на всякий случай):

b[1,5]:='0'
b[2,5]:='1'
j=4 do i1=1 do b[1,4]:=b[1,5] (='0')
s:=b[1,4] ( '0')
i1=1 do b[1,4]:=b[2,4]
b[1,4]:='00' ( s+'0')
b[2,4]:='01' (s+'1')
j=3 do i1=1 do b[1,3]:=b[1,4] ('00')
i1=2 do b[2,3]:=b[2,4] ('01')
s:=b[2,3] ( '01')
i1=2 do b[2,3]:=b[3,3]
b[2,3]:='010' ( s+'0')
b[3,3]:='011' (s+'1')
j=2 do i1=1 do b[1,2]:=b[1,3] ('00')
i1=2 do b[2,2]:=b[2,3] ('010')
i1=3 do b[3,2]:=b[3,3] ('011')
s:=b[2,2] (010)
i1=2 do b[2,2]:=b[3,2]
i1=3 do b[3,2]:=b[4,2]
b[3,2]:= '0100'
b[4,2]:= '0101'
j=1 do i1=1 do b[1,1]:=b[1,2] ('00')
i1=2 do b[2,1]:=b[2,2] ('011)
i1=3 do b[3,1]:=b[3,2] ('0100')
i1=4 do b[4,1]:=b[4,2] ('0101')
s:=b[4,1] ('0101')
i1=4 do b[4,1]:=b[5,1]
b[4,1]:= '01010'
b[5,1]:= '01011'
lena_stud вне форума   Ответить с цитированием
Старый 02.07.2012, 20:06   #5 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,343
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lena_stud Посмотреть сообщение
надеюсь объяснила понятно
Вообще-то не очень, но попробую разобраться. Скоро не обещаю. И даже успеха в этом мероприятии тоже. Но честно попытаюсь - самому интересно.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 03.07.2012, 12:49   #6 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,343
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Ну так, не знаю, устроит ли, но могу предложить свой вариант программы, представляющий собой существенную переработку Вашей в плане, как мне представляется, упрощения. В частности, как-то особой надобности в процедурах я там не узрел, ну и еще кое-что по мелочи.
Код:
uses CRT;
const
 n=5;
 dano: array [1..n] of real=(0.53, 0.23, 0.13, 0.06, 0.05);
type
 matrix1=array[1..n,1..n] of real;
 matrix2=array[1..n,1..n] of string;
 matrix3=array[1..n,1..n] of byte;
var
 a:matrix1;
 b:matrix2;
 k,i,j,cl:byte;
 sum: real;
 clr:matrix3;
 s:string;

Begin
 {vvod veroiatnostei}
 clrscr;
 for i:=1 to n do a[i,1]:=dano[i];
 {vvod cveta}
 for i:=1 to n do
  for j:=1 to n-i+1 do
   if (i=n-j+1) and (i<n) then clr[i,j]:=10 else clr[i,j]:=15;
 {formirovanie matrici a bez uporjadochenija}
 for j:=2 to n do
  begin
   for i:=1 to n-j+1 do a[i,j]:=a[i,j-1];
   a[n-j+1,j]:=a[n-j+2,j-1]+a[n-j+1,j-1];
  end;
 {formirovanie matrici b bez uporjadochenija}
 b[1,n]:='0';
 for j:=n-1 downto 1 do
  begin
   for i:=1 to n-j-1 do b[i,j]:=b[i,j+1];
   if a[n-j,j]>a[n-j+1,j] then
    begin
     b[n-j,j]:=b[n-j,j+1]+'0';
     b[n-j+1,j]:=b[n-j,j+1]+'1';
    end else
    begin
     b[n-j,j]:=b[n-j,j+1]+'1';
     b[n-j+1,j]:=b[n-j,j+1]+'0';
    end;
  end;
 {uporjadochenije}
 for j:=1 to n-1 do
  for k:=1 to n-j do
   for i:=1 to n-k do
    if a[i+1,j]>a[i,j] then
     begin
      sum:=a[i,j];
      a[i,j]:=a[i+1,j];
      a[i+1,j]:=sum;
      cl:=clr[i,j];
      clr[i,j]:=clr[i+1,j];
      clr[i+1,j]:=cl;
      s:=b[i,j];
      b[i,j]:=b[i+1,j];
      b[i+1,j]:=s;
     end;
 {vyvod rezultatov}
 for i:=1 to n do
  begin
   for j:=1 to n-i+1 do
    begin
     textcolor(clr[i,j]);
     write(a[i,j]:6:2);
    end;
   for k:=1 to i do write('      ');
   for j:=n downto 1 do
    begin
     textcolor(clr[i,j]);
     write(b[i,j]:6);
    end;
   writeln;
  end;
 ReadKey;
 NormVideo;
End.
Миниатюры
haffm01.jpg  
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 04.07.2012, 00:21   #7 (permalink)
lena_stud
Новичок
 
Регистрация: 21.06.2012
Сообщений: 6
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Vladimir S, я воспользовалась вашей идеей о введении переменной clr и доделала свой вариант программы (добавила там 3 цикла for (два из них с участием clr) и немного изменила выведение кодов элементов), но без вашего варианта программы я бы ни за что не догадалась. Спасибо вам за помощь.
lena_stud вне форума   Ответить с цитированием
Старый 04.07.2012, 09:31   #8 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,343
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от lena_stud Посмотреть сообщение
Vladimir S, я воспользовалась вашей идеей о введении переменной clr и доделала свой вариант программы (добавила там 3 цикла for (два из них с участием clr) и немного изменила выведение кодов элементов), но без вашего варианта программы я бы ни за что не догадалась. Спасибо вам за помощь.
Заработало? Ну и славно.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 04:57.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.