Помощь - Поиск - Пользователи - Календарь
Полная версия: Матрица
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
ghost
:help: Помогите пожалуйста сделать задачу :help:
Дана матрица А(6,6). Создать новую матрицу В(6,6), где
а) В(I,J)=A(I,J), если A(I,J)>0
б) B(I,J) не равно 0, если A(I,J)<=0
Вывести исходную матрицу А, а под ней полученную матрицу В.
В программе должна быть "защита от дурака"
volvo
ghost
Цитата
B(I,J) не равно 0, если A(I,J)<=0

А чему равно B(I, J) при A(I,J)<=0 ? Любое ненулевое число?
ghost
Как я понял в б) в итоге должно быть так
Цитата
Матрица А                Матрица В
1 -5 2                  1    0    2
0    4 7                  0    4    7
3 -2  -8                  3    0    0


Отрицательные числа заменяются на 0.
Для сохранения форматирования - пользуемся тегами [ quote][ /quote]
АнтонП
Простите, что вмешался...

возможно в натуре условие не точно

Код


Var a,b:array[1..6]of integer;
I,j:intger;
begin
randomize;

for i:= 1 to 6 do
for j:= 1 to 6 do
a[I,j]:= random(99)-(random(99));

И отрицательные -  random(99)-(random(99))


for i:= 1 to 6 do
for j:= 1 to 6 do
if a[i,j]>0 then b[i,j]:=a[i,j]
else b[i,j]:= Любое ненулевое число (random(99)); или 0

А если и отрицательные, то random(99)-(random(99))

Вывод в таблицу:

For i:= 1 to 6 do
Begin
    For j:= 1 to 6 do
    Write(a[I,J]);
  WRITELN;
End;


For i:= 1 to 6 do
Begin
    For j:= 1 to 6 do
    Write(b[I,J]);
  WRITELN;
End;

End.


volvo
АнтонП
Автор вопроса уже уточнил -
Цитата
Отрицательные числа заменяются на 0.
mithquessir
Код

const
    n = 6;
var
  a,b:array[1..n,1..n] of integer;
  i,j:integer;
begin
    randomize;
    for i := 1 to n do
    for j := 1 to n do
    if (i mod 2 = 0) and (j mod 2 = 0) then a[i,j] := -1 else
    a[i,j] := random(100);
    for i := 1 to n do
    for j := 1 to n do
    begin
         if a[i,j] > 0 then b[i,j] := a[i,j]
         else
         b[i,j] := 0;
    end;
    for i := 1 to n do
    begin
         writeln;
         for j := 1 to n do
         Write(a[i,j]:3);
    end;
    for i := 1 to n do
    begin
         WriteLn;
         for j := 1 to n do
         Write(b[i,j]:3);
    end;
end.
volvo
mithquessir
Что это?
Код

for i := 1 to n do
   for j := 1 to n do
   if (i mod 2 = 0) and (j mod 2 = 0) then a[i,j] := -1 else
   a[i,j] := random(100);
Jahnerus
volvo
Цитата
mithquessir
Что это?
Код 
for i := 1 to n do
   for j := 1 to n do
   if (i mod 2 = 0) and (j mod 2 = 0) then a[i,j] := -1 else
   a[i,j] := random(100);

Кажется это исскуственное засовывание отрицательных чисел, в данном случае (-1) в матрицу, в данном случае на все чётные позиции i и j!
Сам Я первый раз ТАКОЕ вижу... довольно странно.
АнтонП
Цитата
И отрицательные -  random(99)-(random(99))

Интересный способ задания отрицательных чисел <_<
Может так понятнее...
Код
a:=random(101)-50

числа [-50,50].
volvo
Цитата
исскуственное засовывание отрицательных чисел, в данном случае (-1) в матрицу, в данном случае на все чётные позиции i и j!

Это ясно, но ЗАЧЕМ?

mithquessir
Все, что требовалось - занести в матрицу случайные числа (скажем, по методу Jahnerus ), а уж потом - их анализировать. То есть вот это:
Код
if (i mod 2 = 0) and (j mod 2 = 0) then a[i,j] := -1 else
абсолютно лишнее...
АнтонП
Я сруктуру рандома не изучал, но инстнктивно кажется, что так будет случайнее smile.gif

Кто-нить конец задачи читал, вообще,

Ручной ввод нужен, а то какие "дураки", если комп все делает?

"защита от дурака" 0.01 beta версия

Если вводить напрямую read(a[i,j]),
то защиту поставить трудно, вроде можно исключительную ситуацию обработать, но в паскале я не знаю как,

лучше вводить элементы матрицы в строку
Код

var s:string;
var y:1..2; r:0..9;
a,b:array[1..6,1..6]of integer;
i,j,k,l:integer;
begin

........****................цикл

read(S);
i:=1;j:=1; a[i,j]:=0;
y:=1;
if s[1]='-' then y:=2;

for k:= y to length(s) do
if s[k] in ['0'..'9'] then
begin
      val(s[k],r,l);
      a[i,j]:= a[i,j]+r*round(exp((length(s)-k)*ln(10)));

end
else
begin
      writeln('Ошибка!');
      readln;
      readln;
      Exit;
End;

If s[1]='-' then a[I,J]:= a[I,J]*(-1);

…………*****…………….


writeln(a[i,j]);
readln;
readln;
end.

--Какая-то лажа, вроде должна работать, но…(От нас защиты нет!(шутка))

Или по-«Крутому» 0.02 beta

Код

var a:integer;
begin
{$i-}
readln(a);
if IoResult<>0  then writeln('Errrror')
else writeln(a);
{$i+}

readln;
readln;
end.
mithquessir
volvo
Извиняюсь, не дочитал условия
Цитата
В программе должна быть "защита от дурака"

а
Цитата
if (i mod 2 = 0) and (j mod 2 = 0) then a[i,j] := -1 else

просто как бы псевдосупергипермегаслучайное заполнение отрицательными эл-ми. smile.gif
volvo
Цитата
лучше вводить элементы матрицы в строку

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

Цитата
--Какая-то лажа, вроде должна работать, но…

А вот это напрасно... Если уже Вы видите, что метод слишком сложный и запутанный - зачем его вообще постить?
Jahnerus
volvo
Цитата
Это ясно, но ЗАЧЕМ?

Наверно человек писавший это переживал что это a:=random(101)-50 за 36 проходов (А(6,6)) может по непонятным причинам не сгенерировать отрицательного числа и решил сделать наверняка!... толи по его мнению так проверять легче :D .
Вощем от бетта версии 0.01 защиты от дурака я ваще в шоке lol.gif
может попробовать так :
Код
Readln(s);
val(s,a[i,j],er);
if er<>0 then writeln('Error');
volvo
Jahnerus
Я бы добавил еще кое-что:
Код

var
 x: longint;
...
Readln(s);
val(s, x, er);
if (er<>0) or (er < -maxint) or (er > maxint)
 then writeln('Error');


Просто твой код пропускает в Integer значения типа 60000 (но изменяет их до неузнаваемости)... Этого тоже допустить нельзя.
Jahnerus
mithquessir
Цитата
просто как бы псевдосупергипермегаслучайное заполнение отрицательными эл-ми

Да просто случайность прям на каждом втором шаге встречается ... это уже называется линейная зависимость, а не псевдосупергипермегаслучайное заполнение . ;)
АнтонП
Цитата
if s[k] in ['0'..'9'] then

Не удивительно что не работает ... а если дробные числа вводить, а там ещё и "." и буква "e" есть! например: 2.324e-03
Jahnerus
volvo
Цитата
Просто твой код пропускает в Integer значения типа 60000 (но изменяет их до неузнаваемости)... Этого тоже допустить нельзя.

Полностью с тобой согласен ... забыл ... он их потом как бы по кругу гонять начинает и может даже оказаться что вводил а положительное а получилось отрицательное ! :D
Но раз уж на то пошло а как быть с дробными ... их тогда ваще гиморно проверять ... единственный выход кажется это посимвольный прогон... и трудоёмкий анализ! sad.gif
volvo
Jahnerus
Вот с дробными как раз проблемы нет... Там ошибиться можно только набрав букву вместо цифры, но Val это ловит... (а интервал возможных значений очень велик)
mithquessir
А почему нельзя так?
Код

    for i := 1 to n do
    for j := 1 to n do
    begin
         repeat
         begin
              {$I-}read(m);{$I+}
              if IOResult <> 0 then
              WriteLn('vvedite eshe raz')
              else
              begin
                   a[i,j] := m;
                   f := TRUE;
              end;
         end;
         until f;
    end;
blink.gif
volvo
mithquessir
А попробуй ввести 60000 - узнаешь...
Jahnerus
mithquessir
Тогда хотябы так
Код
var a:longint;
----------
{$I-}
repeat
 writeln('Vvedite chislo A');
 readln(a);
until IOResult=0;
{$I+}
Jahnerus
volvo
Цитата
Jahnerus
Я бы добавил еще кое-что:

var
x: longint;
...
Readln(s);
val(s, x, er);
if (er<>0) or (er < -maxint) or (er > maxint)
then writeln('Error');

Хе ! только щас увидел один нюанс ! smile.gif
Насколько я знаю процедура val возвращает код ошибки следующим образом,
код ошибки -
Цитата
позиция в которой произошла ошибка при преобразовании, или нуль, если ошибки не было.

а тогда встаёт вопрос нафига нужны два последних условия er < -maxint и er > maxint
первое так ваще не понятно, потому что позиция по определению не может быть отрецательной, а второе (это что защита от запаршей клавиши или от дурака набирающего число длиной больше 32767 символов blink.gif ) - кажется в строку и так больше 128 символов не введёшь с клавиатуры.
поэтому на мой взгляд оптимальный вариант это:
Код
var
x: longint;
...
Readln(s);
val(s, x, er);
if er<>0 then writeln('Error');
volvo
Jahnerus
Ошибка, конечно... Зачем er сравнивать с maxInt? Вот, что я имел в виду...
Код

var
x: longint;
...
Readln(s);
val(s, x, er);
if (er<>0) or (x < -maxint) or (x > maxint)
then writeln('Error');


Просто если задана матрица Integer-ов, то я бы и оставил integer (а для этого надо проверить, не выходит ли введенное пользователем число из допустимого диапазона...)
Jahnerus
Теперь всё встало на свои места ;)
Да и простите меня за мелочность:
Integer -32768..32767
следовательно не (x < -maxint), а (x < (-maxint-1)).
ghost
Что-то не могу понять что за "er" такое, в идентификаторах его нет.
А как-бы в этой проге сделать так, чтобы можно было вводить матрицу А такого размера, какого захочет пользователь (в разумных пределах), а не только 6х6.
volvo
ghost
По-моему, так...
Код

const
   max_n = 30;
var
 a,b:array[1..max_n,1..max_n] of integer;
 i,j,n1,n2:integer;
 s: string; x: longint; er: integer;
 bn: boolean;
begin
   repeat
     write('matrix width = '); readln(n1);
   until (n1 <= max_n);
   repeat
     write('matrix height = '); readln(n2);
   until (n2 <= max_n);

   for i := 1 to n1 do
   for j := 1 to n2 do
     begin
       repeat
         write('a[', i, ',', j, '] = '); Readln(s);
         val(s, x, er);
         bn := (er<>0) or (x < -Pred(maxint)) or (x > maxint);
         if bn then writeln('Error');
       until not bn;
       a[i,j] := x;
     end;

   for i := 1 to n1 do
   for j := 1 to n2 do
   begin
        if a[i,j] > 0 then b[i,j] := a[i,j]
        else
        b[i,j] := 0;
   end;
   for i := 1 to n1 do
   begin
        writeln;
        for j := 1 to n2 do
        Write(a[i,j]:3);
   end;
   for i := 1 to n1 do
   begin
        WriteLn;
        for j := 1 to n2 do
        Write(b[i,j]:3);
   end;
end.
ghost
А можно сделать так чтобы число строк не обязательно было равно числу стобцов. И ещё, при выводе матриц происходит что-то не понятное, их не видно. Выводится лишь часть матрицы А, а в В тоже выводится часть, но если нажать enter, то остальные строки будут выводится по одной.
volvo
ghost
Исправлено...
ghost
Как будет выглядет б/с к этой немного переделанной проге
Код

uses crt;
const
  max_n = 9;
var
a,b:array[1..max_n,1..max_n] of integer;
i,j,n1,n2,error:integer;
s: string; x: longint; er: integer;
bn: boolean;
label e1;
begin
clrscr;
gotoxy  (3,10);
  writeln ('Данная программа задаёт матрицу А. После чего создаёт');
   gotoxy  (57,10);
  writeln ('новую матрицу B, где ');
   gotoxy  (12,11);
  writeln ('а) B(i,j) = A(i,j), если A(i,j) > 0');
   gotoxy  (12,12);
  writeln ('б) B(i,j) не равно 0, если A(i,j) <= 0');
   gotoxy  (7,14);
  writeln ('Элементами матрицы могут быть только целые числа от -32768 до 32767,');
   gotoxy  (18,15);
  writeln ('максимальный размер матрицы 9х9!');
   gotoxy  (12,17);
  writeln ('текст');
   gotoxy  (27,18);
  writeln ('текст');
   gotoxy  (18,20);
  writeln ('Нажмите любую клавишу для продолжения');
   readkey;
e1:
clrscr;
  repeat
    write('Введите кол-во строк = ');
{$I-} readln(n1);
error:=ioresult;{$I+}
IF (n1<2) or (n1>max_n) or (error<>0)
then  writeln ('Кол-во строк от 2 до 9!');
  until (n1 >= 2) and (n1<=max_n) and (error=0);

  repeat
    write('Введите кол-во столбцов = ');
    {$I-} readln(n2);
    error:=ioresult;{$I+}
    IF (n2<2) or (n2>max_n) or (error<>0)
    then writeln ('Кол-во столбцов от 2 до 9!');
  until (n2 >= 2) and (n2<=max_n) and (error=0);


  for i := 1 to n1 do
  for j := 1 to n2 do
    begin
      repeat
        write('a[', i, ',', j, '] = '); Readln(s);
        val(s, x, er);
        bn := (er<>0) or (x < -Pred(maxint)) or (x > maxint);
        if bn then writeln('Введённый вами символ вне диапозона от -32768 до 32767');
      until not bn;
      a[i,j] := x;
    end;

  for i := 1 to n1 do
  for j := 1 to n2 do
  begin
       if a[i,j] > 0 then b[i,j] := a[i,j]
       else
       b[i,j] := 0;
  end;
  clrscr;
  write('matrix A');
  for i := 1 to n1 do
  begin
       writeln;
       for j := 1 to n2 do
       Write(a[i,j]:7);
  end;

  writeln;
  write('matrix B');
  for i := 1 to n1 do
  begin
       writeln;
       for j := 1 to n2 do
       Write(b[i,j]:7);
       end;
       writeln ('');
       write('Вы хотите сделать ещё одну матрицу? y/n');
       case readkey of
   #89: goto  e1;
   #121: goto e1;
   #78: exit;
   #110: exit;
  end;
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.