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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 14.06.2009, 16:28   #1
cave
Новичок
Джуниор
 
Регистрация: 14.06.2009
Сообщений: 2
По умолчанию Delphi, помогите исправить задачу

Задача такова: Сформировать два одномерных массива из четных и нечетных элементов матрицы (RND)

Чтобы выводилось в ввиде:
Исходная матрица
1 2 3
4 5 6
7 8 9

Четный массив
2 4 6 8
Нечетный массив
1 3 5 7 9

Код:
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var

i,j,k,l,n,m,c,d: integer;
a:array [1..10,1..10] of real;
chet:array[1..10] of real;
nechet:array[1..10] of real;
begin

  randomize;
  Writeln('BBedite razmernost');
  readln(n,m);
  writeln('BBedite predeli');
  readln(d,c);
  for i:=1 to n do
  begin
  for j:=1 to m do
  a[i,j]:=(c-d)*random+d;
  end;
  for i:=1 to n do
  begin
  for j:=1 to m do
  write(a[i,j]:8:0);
  writeln;
end;
k:=1;
l:=1;
for i:=1 to n do  begin
for j:=1 to n do
if (frac(a[i,j]/2)=0) then begin
chet[k]:=a[i,j];
k:=k+1;
end
else begin
nechet[l]:=a[i,j];
l:=l+1;
end;
writeln;
writeln('chetnyy massiv:');
for i:=1 to k-1 do
write(chet[i]:8:0);
writeln;
writeln('nechetnyy massiv:');
for i:=1 to l-1 do
write(nechet[i]:8:0);
writeln;
readln;
 end;
end.
заранее спасибо
cave вне форума Ответить с цитированием
Старый 15.06.2009, 01:55   #2
VadEr
Форумчанин
 
Аватар для VadEr
 
Регистрация: 24.03.2009
Сообщений: 375
По умолчанию

Код:
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  fl1,fl2,fl3, i,j,n,m,c,d: integer;
  a:array of array of real;
  chet:array of real;
  nechet:array of real;
begin
  fl3:=0; fl1:=0; fl2:=0; // счетчики
  randomize;
  Writeln('BBedite razmernost');
  readln(n,m);
  SetLength(a, n,m);
  writeln('BBedite predeli');
  readln(d,c);
  for i:=0 to n-1 do
  begin
    for j:=0 to m-1 do
    begin
      a[i,j]:=(c-d)*random+d;
      write(a[i,j]:8:5);
      Inc(fl3);
      if fl3 mod 2 = 0 then
        begin
          Inc(fl1);
          SetLength(chet, fl1);
          chet[fl1-1] := a[i,j];
        end
      else
        begin
          Inc(fl2);
          SetLength(nechet, fl2);
          nechet[fl2-1] := a[i,j];
        end;
    end;
    writeln;
  end;

writeln;
writeln('chetnyy massiv:');
for i:=0 to fl1-1 do
    write(chet[i]:8:5);
writeln;
writeln('nechetnyy massiv:');
for i:=0 to fl2-1 do
    write(nechet[i]:8:5);
readln;
end.

Последний раз редактировалось VadEr; 15.06.2009 в 12:38.
VadEr вне форума Ответить с цитированием
Старый 16.06.2009, 19:51   #3
cave
Новичок
Джуниор
 
Регистрация: 14.06.2009
Сообщений: 2
По умолчанию

будут еще варианты? чтобы было похоже на мой вариант, а то не примут такое (
cave вне форума Ответить с цитированием
Старый 17.06.2009, 09:56   #4
Charmer
 
Регистрация: 26.01.2009
Сообщений: 2
По умолчанию

program Project1;

{$APPTYPE CONSOLE}

uses
SysUtils;

var
i,j,k,l,n,m,c,d,h: integer;
a:array [1..10,1..10] of real;
s:array[1..20]of real;
chet:array[1..10] of real;
nechet:array[1..10] of real;
begin
randomize;
Writeln('BBedite razmernost');
readln(n,m);
writeln('BBedite predeli');
readln(d,c);
for i:=1 to n do
begin
for j:=1 to m do
a[i,j]:=(c-d)*random+d;
end;
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:8:0);
writeln;
end;
h:=1;
for i:=1 to n do
begin
for j:=1 to m do
begin
s[h]:=a[i,j];
h:=h+1;
end;
end;
h:=h-1;
l:=1;
k:=1;
for i:=1 to h do
begin
if (i mod 2=0) then
begin
chet[k]:=s[i];
k:=k+1;
end
else
begin
nechet[l]:=s[i];
l:=l+1;
end;
end;
writeln;
writeln('chetnyy massiv:');
for i:=1 to k-1 do
write(chet[i]:8:0);
writeln;
writeln('nechetnyy massiv:');
for i:=1 to l-1 do
write(nechet[i]:8:0);
writeln;
readln;
end.
Charmer вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите исправить задачу. Liver Паскаль, Turbo Pascal, PascalABC.NET 1 19.12.2008 09:56
Помогите Исправить задачу по C++ Many man Помощь студентам 2 14.12.2008 12:20
помогите пожалуйста исправить задачу kardan Помощь студентам 2 12.04.2008 10:16
Помогите,пожалуйста,исправить задачу... Загадка Паскаль, Turbo Pascal, PascalABC.NET 1 21.12.2006 00:42