Автор Тема: Проверьте программу на Pascal  (Прочитано 8383 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн razorkam

  • Новичок
  • *
  • Сообщений: 13
    • Просмотр профиля
Проверьте программу на Pascal
« : 28 Января 2012, 17:52:48 »
задача: вывести координаты всех седловых точек матрицы размером 10х15.седловая точка-элемент матрицы,являющийся минимальным в своей строке и максимальным в своем столбце.
решил,однако что-то не то,а что именно не могу понять.
вообщем проверьте,пожалуйста.

Program sedl;
const nn=100;
Type matr=Array[1..nn,1..nn] of Byte;
Var j,i,stmin,h,nmax:Byte;
    a:matr;
BEGIN
Randomize;
For i:= 1 to 10 do
 For j:= 1 to 15 do
 a[i,j]:=Random(50);
For i:= 1 to 10 do begin
 For j:= 1 to 15 do
 Write(a[i,j]:5);
WriteLn;
end;
WriteLn;
For i:= 1 to 10 do begin
stmin:=1;
 For j:= 1 to 15 do
  If a[i,j]<a[i,stmin] then stmin:=j;
 nmax:=1;
For h:= 1 to 10 do
If a[h,stmin]>a[nmax,stmin] then nmax:=h;
If nmax=i then writeln(nmax,' ',stmin);
end;
end.

Оффлайн Selyd

  • Старожил
  • ****
  • Сообщений: 408
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #1 : 28 Января 2012, 21:11:18 »
Привет!
Программу не смотрю. Думаю, что надо так.
а) Матрицу задать самому с гарантией, что есть седловые точки.
Матрицу наполнил своими данными с очевидными седловыми точками - будешь знать ответы.
б) Просматривать по строкам (минимумы).
в) Искать максимум в том же столбце - седловая точка при совпадании строчного номера.
в) Печатать i=j и элемент.
г) Номер максимума в столбце не совпал с номером строки, на б).
Потом можна через генератор. Удачи.

Оффлайн Hellko

  • Старожил
  • ****
  • Сообщений: 363
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #2 : 29 Января 2012, 02:29:28 »
зачем объявлять массив 100х100 когда по заданию надо 10х15?

Оффлайн sp

  • Пользователь
  • **
  • Сообщений: 51
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #3 : 29 Января 2012, 06:42:50 »
А вопрос можно? (Задавать вопросы проще, чем на них отвечать :D.) Как напряжением мысли (без моделирования) доказать: существуют многоседельные матрицы или нет? Достаточно одну двухседельную привести, тогда и многоседельные появятся. Равноседельные не считаются :(.

Оффлайн Hellko

  • Старожил
  • ****
  • Сообщений: 363
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #4 : 29 Января 2012, 09:48:10 »
А вопрос можно? (Задавать вопросы проще, чем на них отвечать :D.) Как напряжением мысли (без моделирования) доказать: существуют многоседельные матрицы или нет? Достаточно одну двухседельную привести, тогда и многоседельные появятся. Равноседельные не считаются :(.
вроде не бывает многоседельных.
например возьмем строку 2 2 1
минимальный элемент 1.
он же должен являтся максимальным в своем столибке.
возьмем столбик 1 0 0.
т.е. в других строках чтобы существовала седловая точка, нужно чтобы элемент был меньше 0, но был максимальным в столбике. который должен быть больше 2. - противоречие.
2 2 1
х х 0
х х 0
« Последнее редактирование: 29 Января 2012, 09:51:36 от Hellko »

Оффлайн Selyd

  • Старожил
  • ****
  • Сообщений: 408
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #5 : 30 Января 2012, 23:41:12 »
На маленькой матрице многоседельность не проявляется.
Просто мы отражаем малый диапазон даных.

Оффлайн Hellko

  • Старожил
  • ****
  • Сообщений: 363
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #6 : 31 Января 2012, 22:13:07 »
пожалуй да
2 2 1 2 2 1 2 2
2 2 0 2 2 0 2 2
2 2 0 2 2 0 2 2
2 2 1 2 2 1 2 2

Оффлайн wital1984

  • Постоялец
  • ***
  • Сообщений: 189
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #7 : 31 Января 2012, 22:54:21 »
Смотря, что считать максимальным и минимальным элементом: элемент, который больше всех остальных или больше либо равен всем остальным.
Возьмем произвольную матрицу a размерности n*m  седловой точкой. Пускай седловая точка a[k;r].  Это значит, что элемент a[k;r] максимальный в своем столбце и минимальный в строке.  Допустим, есть еще одна седловая точка: a[s;t].
Тогда по свойству седловых точек: a[s;t]>a[k;t]>a[k;r]>a[s;r]>a[s;t]. Получили: a[s;t]>a[s;t]. А этого не может быть.
Если рассматривать нестрогие неравенства: >=, <=. То наличие нескольких седловых точек возможно, но тогда они все будут равны между собой: a[s;t]>=a[k;t]>=a[k;r]>=a[s;r]>=a[s;t] возможно только при a[s;t]=a[k;t]=a[k;r]=a[s;r]=a[s;t]

Оффлайн sp

  • Пользователь
  • **
  • Сообщений: 51
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #8 : 01 Февраля 2012, 05:25:26 »
Равноседельные многоседельными не считаются! >:(.
Берём по строке синус. Горный хребет. Там таких сёдел не счесть. Нет, равные не интересно...

Оффлайн Selyd

  • Старожил
  • ****
  • Сообщений: 408
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #9 : 01 Февраля 2012, 17:03:21 »
Пусть матрица mхn. Пусть одинаковых в строке нет и в столбце тоже нет.
Пусть хоть немножко отличаются.

f:=0;   Флаг о наличии седловых точек
For i:= 1 to m do    цикл по строкам
begin
smin:= a[i,1]; ni:=1  Претендент на минимум в строке
 For j:= 1 to n do
  If a[i,j]<smin then
     begin
       ni:=j; smin:= a[i,j]  Замена претендента и фиксация номера столбца
     end;
cmax:= smin   Может он и максимум в столбце
For k:= 1 to m do
If a[k,j]>cmax then go to ex;  Если что-то больше желаемого максимума, то прочь
if f=0 then writeln('Седловая точка'); За первым заходом печать
f:=1; writeln(cmax,' ',i,j);  смена флага и печать седла
ex:   обход без седла
end;
if f=0 then writeln('Седловые точки отсутствуют'); Если флаг не менялся

Пока писал, дошло что такая проверка на случай одного седла в комбинации строка-столбец. В противном случае седло надо проверять иначе – провал в строке и бугор здесь же в столбце, т.е. проверять три точки и три точки. Это на случай многоседельности. От кромок матрицы, естественно, отступаем.

Оффлайн sp

  • Пользователь
  • **
  • Сообщений: 51
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #10 : 02 Февраля 2012, 05:55:03 »
Во первых, отличное док-во об односедельности матриц.
Во вторых, об отбрасывании краёв. Действительно, что-то с краями надо делать. Не важно что, но надо делать.
Только, не догнал, раз мы нашли седло, зачем дальше чего-то искать. Установили флаг и вышли из циклов. А там спросили, что с флагом. Есть он, тогда печать что-то типа "Обнаружено седло в строке i=..., в столбце j=...". Иначе что-то типа "Седло не обнаружено". Или я ошибаюсь? ???
Паскаль знаю относительно и противоречиво, в эту кухню не лезу. Си'шник я. ::)

Оффлайн Hellko

  • Старожил
  • ****
  • Сообщений: 363
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #11 : 02 Февраля 2012, 10:55:00 »
goto - жесть. давайте будем по нормальному писать ок?

Оффлайн Selyd

  • Старожил
  • ****
  • Сообщений: 408
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #12 : 02 Февраля 2012, 17:11:11 »
Седло может быть не одно, в разных строках.
Края отрезать так -
For i:= 2 to m-1 do    цикл по строкам
Алгоритм - один язык, исходник - другой (по возможностям Pascal'я,C++'а). Одно другому - не помеха.

Оффлайн sp

  • Пользователь
  • **
  • Сообщений: 51
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #13 : 02 Февраля 2012, 17:30:02 »
Стало быть, goto заменяем на break. Если  при проверке т.н. "седло" находится на краешке, пишем warning: " Точка находится на границе матрицы строка i=..., столбец j=...".
ЗЫ. Куда пропал топикстартёр? Мы за всё отдуваться должны?
Согласен с доказательством, что седло м.б. только одно (в строгом смысле). Сам к этому выводу пришёл. А там уж "кто первый встал, того и сапоги" :). Или писать что-то типа: "Первое седло ...". Только генератор текста понадобится, типа "тысяча шестьсот сорок пятое", а это другая задача.
« Последнее редактирование: 02 Февраля 2012, 17:41:37 от sp »

Оффлайн wital1984

  • Постоялец
  • ***
  • Сообщений: 189
    • Просмотр профиля
Re: Проверьте программу на Pascal
« Ответ #14 : 02 Февраля 2012, 19:02:26 »
Вот мой вариант, классический без меток и брейков:
PROGRAM sedlo;
uses crt;
const n=3; m=3;
 Var a: array[1..10, 1..15] of byte;
  f, i, j, x, strmin, r, k : byte;
BEGIN
clrscr;
{******WWOD************}
For i:=1 to n do
  for j:=1 to m do
  begin
    writeln('wwedy a[',i,';',j,']');
    readln(a[i,j]);
  end;
{******WYWOD************}
For i:=1 to n do
BEGIN
  for j:=1 to m do
  write(a[i,j],'  ');
  writeln;
End;
i:=1;
f:=0; {net sedlowyh}
while (i<=n)and(f=0) do
begin
  strmin:=a[i,1]; {minimum w stroke }
  j:=2; x:=1;
  while (j<=m)and(f=0) do
  begin
    if a[i,j]<strmin then begin strmin:=a[i,j]; x:=j; end;
    inc(j);
  end;
  r:=0; k:=1;
  while (k<=n)and(r=0) do begin
    if a[k,x]>strmin then r:=1;
    inc(k);
  end;
  if r=0 then begin writeln ('seldowaja tochta: a[',i,';',x,']=',strmin); f:=1; end;
  inc(i);
end;

if f=0 then writeln('sedlowyh tochek net!');
readln
END.

 

проверьте правильность - Паскаль

Автор Livanessa

Ответов: 4
Просмотров: 5235
Последний ответ 07 Декабря 2009, 16:22:56
от Данила
Массив VBA - проверьте пожалуйста

Автор Nataly1992

Ответов: 7
Просмотров: 4629
Последний ответ 13 Января 2010, 22:34:58
от Nataly1992
Помогите в составлении программы на Turbo Pascal,плиз!срочно!

Автор Ymni4ka

Ответов: 1
Просмотров: 6008
Последний ответ 03 Ноября 2010, 09:27:22
от testtest
Помогите составить блок-схему и программы на языке Pascal

Автор tasha1991

Ответов: 0
Просмотров: 6615
Последний ответ 09 Января 2011, 16:33:00
от tasha1991
Pascal. Вычислить значения  du/dx, пользуясь конечно-разностным соотношением

Автор Shurara

Ответов: 0
Просмотров: 6462
Последний ответ 09 Февраля 2011, 17:54:21
от Shurara