Программирование

Давайте здесь устроим поле для обсуждения неясных моментов программирования на Паскале

В разных ЯП по разному,

В разных ЯП по разному, Оксана.
В ТП, например, простейшую библиотеку можно создать как обычную папку, в которую нужные заготовки программного текста (т.е. то, что мы называем макроопределением) записываются как текстовые файлы. Включить копию любого такого файла в некоторую точку своей программы можно, например, с помощью директивы компилятора
{$I <имя включаемого pas-файла>} .
Возможны также и более сложные директивы управления макросами (в том числе, условные). Специальные библиотеки исходников можно организовать и через среду программирования ТП. Это целый пласт, можете посмотреть в Инете и в книжках по ТП (см. директивы компиляции).

мммм...спасибо))но я не все поняла...

на лекции вы нам это расскажете или на самостоятельное изучение?))))

Хорошо, Оксана.

1. По существу. Вот конкретный пример, Вы можете проверить его в Delphi.
Пишем программку:

  1. var x,y,t:Integer;
  2. begin
  3.   readln(x,y);
  4.   {$I swapXY.pas} //здесь включаем файл макроса
  5.   writeln(x:3,y:3);
  6.   {$I swapXY.pas} // ... и  здесь
  7.   writeln(x:3,y:3);
  8.   readln
  9. end.

В ту же папку, что и проект, помещаете файл swapXY.pas со следующим текстом ( макрос, реализующий обмен значений X и Y):
  1. t:=x;
  2. x:=y;
  3. y:=t

Запускаете и убеждаетесь, что макрос прекрасно дважды сработал.

2. Ничего дополнительного учить или искать не требуется. Этого представления о макросах в базовом курсе достаточно. Попробуйте всё практически и Вы по этой теме готовы! Конечно, если есть желание, освойте ещё и то, что я указал.

огромное спасибо))

теперь все получилось и я поняла как это все творить))))))

Задача по ДМ

Задан некоторый входной тест длины не боле 255 символов. Написан строчными латинскими буквами и по мимо букв содержит '.', ',' и ' '. необходимо обработать текст следующим образом:
1)выявить множество всех встретившихся в тексте гласных букв(e,i,y,a,o,u);
2)множество согласных( т.е. остальных);
3)знаков препинания
4)узнать число элементов в каждом множестве.

  1. program Text;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.   SysUtils;
  5. const
  6. glas=['e','i','y','o','a','u'];
  7. sogl=['a'..'z']-glas;
  8. prep=['.',',',' '];
  9. type
  10.   baza=set of char;
  11. var glas1,sogl1,prep1:baza;
  12.     s:string;
  13.     c:char;
  14.     i,kgl,ksogl,kprep:integer;
  15. begin
  16. glas1:=[];
  17. sogl1:=[];
  18. prep1:=[];
  19. kgl:=0;
  20. ksogl:=0;
  21. kprep:=0;
  22. read(s);
  23. for i:=1 to length(s) do
  24. begin
  25.   if s[i] in glas then glas1:=glas1+[s[i]];
  26.   if s[i] in sogl then sogl1:=sogl1+[s[i]];
  27.   if s[i] in prep then prep1:=prep1+[s[i]];
  28. end;
  29. writeln;
  30.  
  31. writeln('Множество встретившихся гласных');
  32. for c:='a' to 'z' do
  33. begin
  34.   if c in glas1 then
  35.   begin
  36.     inc(kgl);
  37.     write(c,' ');
  38.   end;
  39. end;
  40. writeln('количество:',kgl);
  41.  
  42. writeln('Множество встретившихся согласных');
  43. for c:='a' to 'z' do
  44. begin
  45.   if c in sogl1 then
  46.   begin
  47.     inc(ksogl);
  48.     write(c,' ');
  49.   end;
  50. end;
  51. writeln('Количество:',ksogl);
  52.  
  53.  
  54. writeln('Множество встретившихся знаков препинаяния');
  55.  
  56. if ',' in prep1 then
  57. begin
  58.   write(',',' ');
  59.   inc(kprep);
  60. end;
  61.  
  62. if '.' in prep1 then
  63. begin
  64.   write('.',' ');
  65.   inc(kprep);
  66. end;
  67.  
  68. if ' ' in prep1 then
  69. begin
  70.   write('| |',' ');
  71.   inc(kprep);
  72. end;
  73.  
  74. writeln('Количество:',kprep);
  75. end.

Верно, Сергей.

Верно, Сергей.
Но немного не в срок. Не теряйте больше паролей.

хорошо:)спасибо:)

хорошо:)спасибо:)

помогите кто-нибудь разобраться с задачкой

Задано натуральное число,нужно найти стринг состоящий из цифр этого числа
уже 2 дня думаю над этим и вот что надумала
c - введенное натуральное число
p - результат
p:=(с div 1000)*((c mod 1000)div 100)*((c mod 100)div 10)*(c mod 10);
в правильном ли я направлении размышляю,может кто-нибудь подскажет?

Начнём с того, Мария, что

Начнём с того, Мария, что формулировка задачи иная: дано натуральное число, найти стринг, представляющий десятичную его запись. Например, по 257 мы должны получить '257'.
У Вас, конечно, не решение. Никакого стринга не формируется, да и разрядность исходного числа не должна быть фиксированной.

Марии

  1. program Project2;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.   SysUtils;
  5. var
  6.   a:integer;
  7.   s:string;
  8. begin
  9.   readln(a);
  10.   s:=inttostr(a);
  11.   writeln(s);
  12. end.

Функция inttostr(a) осуществляет перевод из целого типа в строковый. Существует и обратная из строкового в целый strtoint(s).

а что означает 10 строка?

эм...нам надо без стандартных функций это осуществить...такая функция мне не знакома

Спасибо Сергей,буду теперь

Спасибо Сергей,буду теперь знать о существовании такой функции,может пригодиться в дальнейшем

Не то, Сергей ...

В том задании было ограничение - использовать только рассмотренные нами операции над стрингами. К тому же, inttostr - это функция Делфи.

другая реализация

Тогда мне в голову пришла вот такая реализация:

  1. program Project2;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.   SysUtils;
  5.   var
  6.   i,k,a:integer;
  7.   s1:array [1..10]of char;
  8.   p:array[1..100]of char;
  9.   s:string;
  10.   c:char;
  11. begin
  12.   readln(a);
  13.   i:=1;
  14.   for c:='0' to '9' do
  15.   begin
  16.   s1[i]:=c;
  17.   inc(i);
  18.   end;
  19.  
  20.   s:='';
  21.   k:=0;
  22.   while a<>0 do
  23.   begin
  24.   for i:=0 to 9 do
  25.     if((a mod 10)=i) then
  26.     begin
  27.     inc(k);
  28.     p[k]:=s1[i+1];
  29.     break;
  30.     end;
  31.     a:=a div 10;
  32.   end;
  33.  
  34.   for i:=k downto 1 do s:=s+p[i];
  35.  
  36.   writeln(s);
  37. end.

Последний код явно неудачен.

Цикл 22-32 вкупе с массивами поистине устрашают ...
Я бы эту задачу решил так:

  1. program Nat2Str;
  2. var s:String; c: Char;
  3.       n, k:Word;
  4. Begin
  5.    Readln(n);  s:='';
  6.    While n<>0 do Begin
  7.       k:=n mod 10;  n:=n div 10;
  8.       c:=chr(ord('0')+k); //цифра, на n позиций правее цифры '0' в ASCII
  9.       s:=c+s;
  10.    End;
  11.    Writeln(s)
  12. End;

Да так проще....забыл про

Да так проще....забыл про ord:(

Впрочем, Сергей,

Впрочем, Сергей, если ближе к Вашей идее (без ord и chr, но со своей таблицей соответствия десятичных цифр их числовым значениям), то, например, так :

  1. program Nat2Str_2;
  2. var s:String;
  3.       a: array[0..9] of Char;
  4.       n, k:Word;
  5. Begin
  6.    Readln(n);  s:=''; a[0]:='0';
  7.    For k:=1 to 9 do begin // заполняем таблицу перекодировки чисел в цифры
  8.        a[k]:=succ(a[k-1]); // следующий за символом a[k-1]
  9.    End;
  10.  
  11.    While n<>0 do Begin
  12.       k:=n mod 10;  n:=n div 10;
  13.       s:=a[k]+s;
  14.    End;
  15.    Writeln(s)
  16. End;

Да что-то я

Да что-то я перемудрил....решение то лёгкое...и вполне понятное:(

Третью задачу оставляю, пока???:)

1. Вводимая информация переводится в список смежности;
2. Преобразование списка смежности в матрицу
3. Из матрицы преобразовать в список

  1. uses  SysUtils;
  2.  
  3. const lim=10;
  4.  
  5.   var
  6.     n:1..lim;
  7.     a:array[1..lim*lim]of 0..lim;
  8.     b:array[1..lim]of 0..lim;
  9.     s:array[1..lim,1..lim]of 0..lim;
  10.     i,j,k,r:integer;
  11.  
  12. begin
  13.   writeln('Введите количество вершин графа');
  14.   readln(n);
  15.  
  16.   k:=0;
  17.   b[1]:=1;
  18.  
  19.   for i:=1 to n do
  20.   begin
  21.     inc(k);
  22.     read(a[k]);
  23.     if a[k]=0 then
  24.     begin
  25.        b[i+1]:=b[i];
  26.        b[i]:=0;
  27.        dec(k)
  28.     end
  29.     else
  30.       begin
  31.         repeat
  32.         inc(k);
  33.         read(a[k]);
  34.         until(a[k]=0);
  35.         b[i+1]:=k;
  36.         dec(k);
  37.       end;
  38.   end;
  39.  
  40.   writeln;
  41.   writeln('Список смежности');
  42.   writeln(' A     B');
  43.   if n+1>=k then
  44.   begin
  45.     for i:=1 to n+1 do
  46.     if i<=k then writeln(' ',a[i],'     ', b[i]) else writeln('          ',b[i]);
  47.   end
  48.   else
  49.   begin
  50.     for i:=1 to k do
  51.     if i<=n then writeln(' ',a[i],'     ', b[i]) else writeln(' ',a[i]);
  52.   end;
  53.  
  54.    writeln('Преобразование списка смежностей в матрицу');
  55.   for i:=1 to n do
  56.   for j:=1 to n do s[i,j]:=0;
  57.  
  58.   for i:=1 to n do
  59.   begin
  60.     if b[i]<>0 then
  61.     begin
  62.       r:=i+1;
  63.       while b[r]=0 do inc(r);
  64.       for j:=b[i] to b[r]-1 do s[i,a[j]]:=1
  65.     end;
  66.   end;
  67.  
  68.   write('  ');
  69.   for i:=1 to n do write(i:2);
  70.   writeln;
  71.   writeln;
  72.   for i:=1 to n do begin write(i,' ');
  73.   for j:=1 to n do write(s[i,j]:2);
  74.   writeln;
  75.   end;
  76.  
  77.   read(n);
  78. end.

Третья задача

Сергей любезно оставил простейшее нам. =) Странно, что я так поздно написал, но успел. =))))

  1. program matrspisok;
  2.  
  3. {$APPTYPE CONSOLE}
  4.    const lim=50;
  5.    type mas=array[1..lim,1..lim] of byte;
  6.    var a:mas; n,i,j:byte;
  7. begin
  8.    readln(n);
  9.    for i:=1 to n do
  10.       for j := 1 to n do readln(a[i,j]);
  11.    for i:=1 to n do begin
  12.       for j := 1 to n do if a[i,j]=1 then write(j);
  13.       write('0')
  14.    end;
  15.    readln
  16. end.

и правда просто,че то я не над тем задумалась))

помогите понять что не так?писала юнит:
1.процедура ввода матрицы
2.процедура вывода матрицы
3.вывести эл-ты главной диагонали матрицы
4.найти максимальный эл-нт матрицы
5.найти номер строки минимального эл-та матрицы
6.поменять местами столбцы с номерами k и l

  1. unit matrx;
  2. interface
  3.    const lim=150;
  4.    type matric=array[1..lim,1..lim] of integer;
  5.     var a:matric;
  6.           k,l,n,i,j,c,maxi,mini:integer;
  7.     procedure vvod(var a:matric);
  8.     procedure vivod(a:matric);
  9.     procedure diogonal(a:matric);
  10.     function max(a:matric):integer;
  11.     function min(a:matric):integer;
  12.     procedure stolb(var a:matric;k,l:integer;);
  13. implementation
  14.         procedure vvod(var a:matric);
  15.           begin
  16.           for i:=1 to n do
  17.            for j:=1 to n do
  18.             readln(a[i,j])
  19.         end;
  20.         procedure vivod(a:matric);
  21.           begin
  22.               for i:=1 to n do begin writeln;
  23.                  for j:=1 to n do write(a[i,j])
  24.               end
  25.           end;
  26.         procedure diogonal(a:matric);
  27.          begin
  28.             for i:=1 to n do
  29.               writeln(a[i,i],'   ,')
  30.         end;
  31.         function max(a:matric):integer;
  32.         begin
  33.           maxi:=a[1,1];
  34.           for i:=1 to n do
  35.             for j:=1 to n do
  36.               if a[i,j]>maxi then maxi:=a[i,j];
  37.               max:=maxi
  38.         end;
  39.         function min(a:matric):integer;
  40.         begin
  41.            mini:=a[1,1];
  42.           for i:=1 to n do
  43.             for j:=1 to n do
  44.               if a[i,j]<mini then min:=a[i,j];
  45.               min:=i
  46.         end;
  47.        procedure stolb(var a:matric;k,l:integer);
  48.        begin
  49.          for i:=1 to n do begin
  50.              c:=a[i,k];
  51.              a[i,k]:=a[i,l];
  52.              a[i,l]:=c
  53.          end;
  54.          for i:=1 to n do  begin
  55.                for j:=1 to n do
  56.                write(a[i,j]);
  57.                writeln
  58.            end
  59.         end;
  60. begin
  61.     writeln('vvedite razmernost matrici');
  62.     readln(n);
  63.     writeln('vvedite nomera nuzhnih stolbcov');
  64.     readln(k,l)
  65. end.

что-то здесь не так,а что не понимаю...

Реализация задачи про печать вершин при обходе

  1. program graf;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils,
  7.   grafy in 'grafy.pas';
  8.    const lim=50;
  9.    type versh=set of byte;
  10.         mas=array[1..lim,1..lim] of 0..1;
  11.    var m:array[1..lim] of 0..1; i,n,j,k,s:integer; kolvo:versh; a:mas; z:string;
  12. begin
  13.    readln(n);
  14.    for i:=1 to n do begin
  15.       m[i]:=0;
  16.       for j := 1 to n do readln(a[i,j])
  17.    end;
  18.    ini;
  19.    z:='';
  20.    readln(k);
  21.    push(k);
  22.    kolvo:=[];
  23.    for j:=1 to n do if a[k,j]=1 then kolvo:=kolvo+[j];
  24.    writeln('Sleduyuschie vershiny dostizhimy iz vershiny ',k,' :');
  25.    while not emp do begin
  26.       i:=pop;
  27.       z:=z+inttostr(i)+', ';
  28.       for s := 1 to n do begin
  29.          if s in kolvo then begin
  30.             if m[s]=0 then begin
  31.                push(s);
  32.                m[s]:=1
  33.             end;
  34.          end;
  35.       end;
  36.    end;
  37.    delete(z,1,3);
  38.    if length(z)<3 then write('nikakie');
  39.    delete(z,length(z)-1,1);
  40.    writeln(z,'.');
  41.    readln
  42. end.

Вроде бы всё работает правильно. =) Юнит для использования стека применял тот, который мы записывали на паре.

вопрос,саш))

вот в 23 строчке что значит "+[j]"?

вопрос о том что означают

вопрос о том что означают квадратные скобки в данном случае

Все Сашка мне объяснил))

на всякий случай(если кто-нибудь как я потеряется)процитирую его объяснение:
"плюсуется некое множество и множество из 1ого элемента j.квадратные,чтобы превратить отдельный элемент во множество с одним элементом"
вот))теперь разобралась))

Ошибка

данная программа даёт ошибочные значения например на тесте
10001
01000
00000
10100
00001
Результат 1,3.
а должен быть 1,3,5. То есть он показывает только смежные вершины, а не на которые можно попасть.
Ошибка заключается в формировании множества kolvo. Оно формируется только для данной вершины...А по моему оно должно формироваться для каждой вершины из стека.

Попробую предоставить свой вариант решения

Правда он не принципиально отличается от Сашиного, но вроде работает корректно.

  1. const lim=15;
  2.   var
  3.      stk:array[1..lim]of integer;
  4.      m:array[1..lim]of 0..1;
  5.      ma:array[1..lim,1..lim]of 0..1;
  6.      p,v,top:0..lim;
  7.      n,i,j:integer;
  8.   procedure Ini;
  9.   begin
  10.     top:=0;
  11.   end;
  12.   procedure push(x:integer);
  13.   begin
  14.     inc(top);
  15.     stk[top]:=x;
  16.   end;
  17.   function Pop:integer;
  18.   begin
  19.     pop:=stk[top];
  20.     dec(top);
  21.   end;
  22.   function Emp:boolean;
  23.   begin
  24.     emp:=(top=0);
  25.   end;
  26. begin
  27.   readln(n);
  28.   for i:=1 to n do
  29.   for j:=1 to n do readln(ma[i,j]);
  30.   for i:=1 to n do m[i]:=0;
  31.   ini;
  32.   readln(v);
  33.   push(v);
  34.   m[v]:=1;
  35.   while not emp do
  36.   begin
  37.     i:=pop;
  38.     if(i=v)and(ma[i,i]=1)then write(i,' ');
  39.     if(i<>v)then write(i,' ');
  40.     for p:=1 to n do
  41.     begin
  42.         if (ma[i,p]=1)and(m[p]=0) then
  43.           begin
  44.           m[p]:=1;
  45.           push(p);
  46.           end;
  47.     end;
  48.   end;
  49.   read(p);
  50. end.

..

да, что-то я перемудрил с решением. всё гениальное - просто.

Небольшая задача про реверс

Была задана простенькая задача в своё время, о которой я недавно вспомнил, копаясь в конспектах. Вводятся целые числа, список которых заканчивается нулём. Вывести сначала отрицательные в обратном порядке, а затем положительные в обратном. Т.к. её никто не сделал, то выложу решение.
Сама программа:

  1. program stek_revers;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.    SysUtils,
  7.    uni_stk in 'uni_stk.pas';
  8.    var x,n:integer;
  9. begin
  10.    ini;
  11.    repeat
  12.       readln(x);
  13.       push(x)
  14.    until x=0;
  15.    x:=pop2;
  16.    while not emp1 do writeln(pop1);
  17.    while not emp2 do writeln(pop2);
  18.    readln
  19. end.

Юнит:

  1. unit uni_stk;
  2.  
  3. interface
  4.     procedure ini;
  5.     procedure push(x:integer);
  6.     function pop1:integer;
  7.     function pop2:integer;
  8.     function emp1:boolean;
  9.     function emp2:boolean;
  10. implementation
  11.    const lim=100;
  12.       var a,b:array[0..lim] of integer;
  13.          top1,top2:0..lim;
  14.       procedure ini;
  15.       begin
  16.          top1:=0; top2:=0
  17.       end;
  18.       procedure push(x:integer);
  19.       begin
  20.          if x<0 then begin
  21.             inc(top1);
  22.             a[top1]:=x
  23.          end
  24.             else begin
  25.                inc(top2);
  26.                b[top2]:=x
  27.             end;
  28.       end;
  29.       function pop1:integer;
  30.       begin
  31.          pop1:=a[top1];
  32.          dec(top1)
  33.       end;
  34.       function pop2:integer;
  35.       begin
  36.          pop2:=b[top2];
  37.          dec(top2)
  38.       end;
  39.       function emp1:boolean;
  40.       begin
  41.          emp1:=(top1=0)
  42.       end;
  43.       function emp2:boolean;
  44.       begin
  45.          emp2:=(top2=0)
  46.       end;
  47.    begin
  48.       ini
  49. end.

Свои бонусы и при том серьёзные, вы заслужили!

Я говорю о тех троих, чьи симпатичные фотки и внятные тексты не дали затухнуть этому форуму.
(ПМ1 рулит!). Каюсь, я и сам потерял к нему интерес из-за почти нулевой активности студентов, на которых он и рассчитан. Но зайдя после долгого перерыва, был приятно удивлён. Обещаю в самый короткий срок откомментировать ваши материалы.

К постам Саши и Оксаны ...

Пт, 01/04/2011 - 16:16 — Зиновьев Александр
Да Саша, здесь действительно всё просто и правильно, хотя, я бы печатал в несколько более естественной для конечного пользователя форме:

  1. Г(1): 2,4,7
  2. Г(2): 3,1,9
  3. и т.д.

Втр, 05/04/2011 - 19:35 — Малхожева Оксана
Сначала пара общих замечаний к юниту.
1. Не следует интерфейс засорять ненужной пользователю информацией. В частности, там совершенно не уместны переменные (пусть пользователь использует свои, какие он хочет). Тем более, странно там держать по существу локальные для подпрограмм переменные (т.е. носящие внутри этих подпрограмм чисто технический характер). Зачем, например, пользователю юнита знать имя переменной c?
2. Вместо объявления переменной n (размерности матриц) как глобальной, во все подпрограммы необходимо было ввести её как дополнительный параметр.
3. Зачем внутри stolb печатать результирующую матрицу в отдельном цикле, если в юните предусмотрена процедура vivod, которой пользователь при желании всегда может воспользоваться?

А теперь ошибки.
1. Непонятно, что же возлагается на главную программу, если Вы пытаетесь ввод выполнять в юните. Инициализационная часть в вашем случае не нужна вовсе!
2. Функции нахождения максимума и минимума содержат одну и ту же ошибку. Найдите её сами.

Важное замечание! Невозможно проверять и комментировать решения задач, условия которых тут же не приведены в явной форме (если даже когда-то, где-то на занятиях эти задачи и формулировались). Нужны точные формулировки того, что вы пытаетесь сделать и хотя бы ключевые комментарии в самом тексте решения.
По этой причине, не могу оценить труд Саши и Сергея связанный с обходом графа (кстати, и контрпример Сергея я не понял).

О программе stek_revers Саши Зиновьева.

1. Это очень плохое (хотя и правильное) решение. Оно демонстрирует как не нужно программировать юниты и составляющие их подпрограммы. Юнит - это универсальный модуль, кот корый должен быть предельно понятен в функциональном отношении и пригоден для включения во многие проекты. Экзотические операции (да ещё и с общепринятыми обозначениями!) здесь недопустимы. Странно, например, что push(x), настолько "умный", что умеет работать с двумя стеками и берёт на себя смелость самостоятельно решать, в какой стек что поместить. Подстать ему и другие подпрограммы этого провоцирующего ошибки юнита.
Здесь нужно было поступить одним из двух способов:
a) Чётко разделить два стека, использовав разные наборы имён операций (push1,push2,ini1,ini2 и т.п.);
б) Взять один набор имён операций, добавив к этим операциям дополнительный параметр - имя используемого стека (например, push(x,'stk2') и т.п.).
Что же касается ЛОГИКИ использования стеков, то она должна полностью определяться реализующей собственно саму решаемую задачу программой.
2. Если в программе необходимо использовать два однотипных последовательно распределённых стека, то оптимальным в смысле использования памяти является следующее решение. Резервируется ОДИН массив и оба стека размещаются в нём (слева и справа в массиве) так, чтобы они росли навстречу друг другу. Тогда исключается ситуация, при которой один из стеков переполнен, в то время как во втором ещё есть место.

Решил на Ваш суд вынести свою реализацию юнита

Юнит предназначен для создания и работы с несколькими стеками. Для этого я решил реализовать их динамически...Вот что у меня вышло:

  1. unit stk;
  2. interface
  3.   type PEL=^EL;
  4.        EL=record
  5.             inf:integer;
  6.             l:PEL;
  7.        end;
  8.   procedure INI(var st:pel);
  9.   function EMP(st:pel):boolean;
  10.   function POP(var st:pel):integer;
  11.   procedure Drop(var st:pel);
  12.   procedure Push(var st:PEL;x:integer);
  13.   procedure Output(st:Pel);
  14. implementation
  15. procedure INI(var st:pel);
  16. begin
  17. st:=nil;
  18. end;
  19. function EMP(st:pel):boolean;
  20. begin
  21. emp:=(st=nil);
  22. end;
  23. function POP(var st:pel):integer;
  24. var v:pel;
  25. begin
  26. if emp(st) then
  27.   begin
  28.    write('Stack pust, kol-vo elementov = ');
  29.    pop:=0;
  30.    end else
  31. begin
  32.   v:=st;
  33.   st:=st^.l;
  34.   pop:=v^.inf;
  35.   dispose(v);
  36. end;
  37. end;
  38. procedure Drop(var st:pel);
  39. var p:pel;
  40. begin
  41.   while st<>nil do
  42.   begin
  43.   p:=st^.l;
  44.   dispose(st);
  45.   st:=p;
  46.   end;
  47.   dispose(p);
  48. end;
  49. procedure Push(var st:PEL;x:integer);
  50. var p:PEL;
  51. begin
  52.   p:=st;
  53.   new(st);
  54.   st^.l:=p;
  55.   st^.inf:=x;
  56. end;
  57. procedure Output(st:Pel);
  58. var p,v:pel;
  59. begin
  60. if emp(st) then  writeln('Stack pust')else
  61. begin
  62.   p:=st;
  63.   while p<>nil do
  64.   begin
  65.     writeln(p^.inf);
  66.     v:=p^.l;
  67.     p:=v;
  68.   end;
  69. end;
  70. end;
  71. begin
  72. end

формулировка задачи с обходом графа.

граф задаётся матрицей смежности.Нам даётся вершина. Задача заключается в выводе списка вершин относящихся к тому же классу эквивалентности, что и введённая. То есть выявить компоненту связности в которую входит данная вершина. В приведении моего контрпримера я пытался показать что программа Александра выводила не все вершины удовлетворяющие данному условию...

Нашёл ошибку

Втр, 05/04/2011 - 19:35 — Малхожева Оксана
в функции нахождения номера строки минимального эл-та матрицы нашёл ошибку. Она содержится в 44 строке. Функции можно присваивать значение только один раз! её имя нельзя использовать в вычислениях. Ей присваивается конечный результат. Попробую исправить:

  1. function min(a:matric):integer;
  2. var s:integer;
  3. begin
  4.   mini:=a[1,1];
  5.   s:=1;
  6.   for i:=1 to n do
  7.   for j:=1 to n do
  8.   if a[i,j]<mini then
  9.   begin
  10.       mini:=a[i,j];
  11.       s:=i;
  12.   end;
  13.   min:=s
  14. end;

А вот в функции нахождения максимума ошибки не вижу.

Да, Сергей, в последней задаче так

Да, Сергей, в последней задаче так. Только вот mini нужно бы описать как локальную. А в решениях Оксаны проблема со скобками (и ещё кое-что).

По задаче об обходе графа

У Саши решение неверное:
1-й элемент попадая в стек не помечается; вне главного цикла while формируется множество вершин (не количество, как неявно подсказывает выбранное обозначение kolvo !), смежных только с начальной вершиной и в дальнейшем в цикле идёт работа только с этим уже никогда не обновляемым множеством; не ясно зачем формировать строку (да и множество тоже), а не печатать сразу, как это мы делали на лекции; не понятна логика строк 37-40 и т.п.

Из Серёжиного контрпримера (я так понимаю, это матрица смежности?), ну никак не выводится 1,3,5.
Представленное же им решение правильное, но при этом: можно бы упростить строку 38; непонятна роль строки 49; не следует явно расписывать стек (когда у нас уже есть реализующий его юнит).

в 44строчке опечатка))

Если честно сама найти ошибки не смогла и поэтому выложила проблему на сайте,ответа долго не было и я написала программу заново,она работает ))но то что не могу находить ошибки у себя- моя главная проблема,почему то легче найти ошибки у других чем у себя..не знаю что с этим делать

А опечатка в том что a[i,j]

А опечатка в том что a[i,j] присваивается mini,a не min))

Оксана, там ещё ошибка!

Оксана, там ещё ошибки! Хоть я это уже и упоминал, никто так и не обратил внимание на отсутствие ОПЕРАТОРНЫХ СКОБОК как в min (в той же 44-й!), так и в max.

Задача на решения выражения

Т.к. в классе не доделал задачу - доделал ее дома, однако из-за проблем с интернетом, только сейчас получилось представить ее, но лучше поздно, чем никогда. Так же сделал как можно больше комментариев для основных операций, для тех кто не делал задачу или не смог.
Условия задачи:
По введенной строке, представляющей математическое выражение, получить ответ и вывести его в качестве целого числа.
БНФ-описание выражения:

  1. <Выражение> ::= (<цифра>) | (<Выражение> <Операция> <Выражение>)
  2. <цифра> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
  3. <Операция> ::= * | + | -

Программа:
  1. program Expression;
  2. uses SysUtils,unit1; //подключаем заранее подготовленый юнит, описанный ниже
  3. var s:string;
  4. function expr(s:string):integer;
  5.   var  s1,s2:string; c:char;
  6.   begin
  7.     if length(s)=3 then expr:=ord(s[2])-ord('0') //если длина выражения равна 3, то оно имеет условленный вид (?), где на месте ? какая-либо цифра
  8.     else begin
  9.       subexpr(s,s1,s2,c);
  10.       case c of    //если в выражении содержалась операция, которую мы находим с помощью процедуры и присваиваем ее C, то мы в зависимости от значения C мы выбираем соответствующий ход действий, за счет которых появляеться процедура
  11.         '+':expr:=expr(s1)+expr(s2);
  12.         '-':expr:=expr(s1)-expr(s2);
  13.         '*':expr:=expr(s1)*expr(s2)
  14.       end
  15.     end
  16.   end;
  17. begin
  18.   readln(s);
  19.   writeln(expr(s));
  20. end.

Юнит:
  1.  unit Unit1;
  2. interface
  3.   procedure subexpr(s:string; var s1,s2:string; var c:Char);
  4. implementation
  5.   procedure subexpr(s:string; var s1,s2:string; var c:Char);
  6.   var i,k:integer;
  7.   begin
  8.     s1:='';
  9.     s2:='';
  10.     k:=1; //счетчик скобок, который мы в начале увеличиваем, т.к. первый элемент - открывающяя скобка, по условию
  11.     delete(s,1,1);
  12.     delete(s,length(s),1); //удаляем первый и последний элемент, так как по условию они являются открывающей и закрывающей скобками
  13.     for i:=2 to length(s) do begin
  14.         if k=0 then begin //если счетчик превратился в 0, значит мы дошли до операции, которая должна выполняться на данном шаге и мы выделяем левую часть и правую часть, над которыми выполняеться операция, а так же саму операцию
  15.           s1:=copy(s,1,i-1);
  16.           s2:=copy(s,i+1,length(s));
  17.           c:=s[i];
  18.           break
  19.         end;
  20.       if s[i]='(' then Inc(k);
  21.       if s[i]=')' then Dec(k) //меняем значение счетчика, в зависимости от скобок, соответственно
  22.     end
  23.   end;
  24. end.

P.S.:Валерий Шахамболетович, почему у меня если в 23 строке в Юните не поставить ; то паскаль выдает ошибку?

Да, Евгений, у Вас всё правильно.

Да, Евгений, у Вас всё правильно. Я дам Вам бонус за это решение.
На вопрос о ";" я не имею ответа. Впрочем, можно поискать в сети точное описание синтаксиса модулей - может быть это "законная" особенность.

Решение Сергея тоже правильное.

Решение Сергея с мультистековым модулем тоже правильное.
Другим способом достижения этой же (и дальше большей) степени общности реализации является объектный подход. Но об этом позже.

Сортировка файла

Задача: Реализовать алгоритм пузырьковой сортировки на файле

  1.  var f:file of char;
  2.      i,j:integer;
  3.      v,vj1,vj:char;
  4.      n:integer;//количество записей в файле
  5.  begin
  6.  clrscr;
  7.  assign(f,'my.txt');
  8.  reset(f);
  9.  n:=FileSize(f)-1;
  10.  for i:=0 to n-1 do
  11.   for j:=0 to n-1 do
  12.     begin
  13.     seek(f,j);
  14.     read(f,vj);
  15.     read(f,vj1);
  16.     if vj>vj1 then
  17.     begin
  18.     v:=vj1;
  19.     seek(f,j);
  20.     write(f,vj1);
  21.     write(f,vj);
  22.     end;
  23.    end;
  24.  close(f);
  25.  end.

Зачем 18-я строка?

Зачем 18-я строка?

Сам не знаю:)Она лишняя:)

Сам не знаю:)Она лишняя:)

Архивация по алгоритму Лемпела-Зива

  1. uses crt;
  2.  
  3. var codeD:array[1..255]of string;
  4.     codeN:array[1..255]of byte;
  5.     dicPh:array[1..255]of string;
  6.     s:string;
  7.     kDic,kCode:byte;
  8.     i,l,n:byte;
  9. begin
  10. clrscr;
  11. writeln('Введите строку для кодирования');
  12. readln(s);
  13. writeln;
  14.  
  15. kDic:=0;
  16. kCode:=0;
  17.  
  18. while length(s)<>0 do begin
  19. l:=1;
  20. n:=0;
  21. for i:=1 to kDic do
  22. begin
  23.      if copy(s,1,l)=dicPh[i] then begin
  24.      n:=i;
  25.      inc(l);
  26.      end;
  27. end;
  28. inc(kDic);
  29. inc(kCode);
  30. dicPh[kDic]:=copy(s,1,l);
  31. codeN[kCode]:=n;
  32. codeD[kCode]:=copy(s,l-1,1);
  33. delete(s,1,l);
  34. end;
  35.  
  36. writeln(' Code           Dic');
  37. writeln(' N | D         N | Ph   ');
  38. for i:=1 to kCode do begin
  39.     write(' ',codeN[i],' | ',codeD[i]);
  40.     writeln;
  41. end;
  42.  
  43. gotoxy(15,wherey-kCode);
  44. write(' 0 |');
  45.    
  46. for i:=1 to kDic do begin
  47. gotoxy(15,wherey+1);
  48. write(' ',i,' | ',dicPh[i]);
  49. end;
  50.  
  51. end.

Малхожева Оксана

я на счёт той презентации по Паскалю для чайников))), сможешь мне её тоже на флешку кинуть??

Балов Нурали

найди завтра по расписанию 2ПМ и принеси флешку))конечно скину,желание учиться это хорошо)))и еще всем первокурсникам-не забрасывайте сайт,активно учавствуйте,читайте статьи,он вам РЕАЛЬНО поможет,удачи всем;)

< pre> <Паскаль-программа>

< pre>
<Паскаль-программа> ::= <заголовок_программы>; <блок> <точка>
<точка> ::= .
< /pre>