IPB
ЛогинПароль:

> 

Начальные контакты ТОЛЬКО через личку!!

> переписать готовую программу с использованием процедур, нужно переписать готовый код, условие и код в теме
Nuts
сообщение 30.05.2010 18:46
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской

Репутация: -  0  +


Нужно переписать готовый код программы с использованием процедур. Программа выполняет следуюшие задание: дан двумерный массив размером m на n.Найти сумму его полож. элем.Из первых четырех строк сформ.4новых вектора и в каждом из них удалить элем.Принадлеж.Отрез.[а;в] и сохраняет полученный результаты в файл. Код:
uses crt;
 const n=10;
 var  ms1,ms2,ms3,ms4: array[1..n] of integer; i,j,k1,k2,k3,k4: byte;
      mas: array[1..n,1..n] of integer; a,b: integer; sum: longint; f: text;
 begin
  randomize;
  clrscr;
  writeln('исходный массив: ');    {заполнение и вывод элементов массива}
  for i:=1 to n do
   begin
    for j:=1 to n do
     begin
      mas[i,j]:=random(19);
      mas[i,j]:=mas[i,j]-9;
      write(mas[i,j]:3);
     end;
    writeln;
   end;
  writeln;
 
  for i:=1 to n do    {вычисление суммы и её вывод}
   for j:=1 to n do
    if mas[i,j]>0 then sum:=sum+mas[i,j];
  writeln('сумма положительных элементов матрицы = ',sum,^j);
 
  for j:=1 to n do    {формирование 4-х одномерных массивов}
   begin
    ms1[j]:=mas[1,j];
    ms2[j]:=mas[2,j];
    ms3[j]:=mas[3,j];
    ms4[j]:=mas[4,j];
   end;
 
  writeln('вектора, сформированные из элементов первых 4-х строк матрицы: ');  {вывод векторов}
  write('1) ');
  for j:=1 to n do
   write(ms1[j]:3);
  writeln;
  write('2) ');
  for j:=1 to n do
   write(ms2[j]:3);
  writeln;
  write('3) ');
  for j:=1 to n do
   write(ms3[j]:3);
  writeln;
  write('4) ');
  for j:=1 to n do
   write(ms4[j]:3);
  writeln(^j);
 
  write('введите длину отрезка [a;b]: ');
  readln(a,b);
 
  writeln;
  if a>b then   {в случае если a>b, то меняем их значение местами}
   begin
    a:=a+b;
    b:=a-b;
    b:=a-b;
   end;
 
  for j:=n downto 1 do   {проверка векторов на наличие элементов, попадающих в отрезок [a;b]}
   begin
    if (ms1[j]>=a) and (ms1[j]<=b) then
     begin
      inc(k1);
      for i:=j to n-k1 do
       ms1[i]:=ms1[i+1];
      ms1[n-k1+1]:=0;
     end;
    if (ms2[j]>=a) and (ms2[j]<=b) then
     begin
      inc(k2);
      for i:=j to n-k2 do
       ms2[i]:=ms2[i+1];
      ms2[n-k2+1]:=0;
     end;
    if (ms3[j]>=a) and (ms3[j]<=b) then
     begin
      inc(k3);
      for i:=j to n-k3 do
       ms3[i]:=ms3[i+1];
      ms3[n-k3+1]:=0;
     end;
    if (ms4[j]>=a) and (ms4[j]<=b) then
     begin
      inc(k4);
      for i:=j to n-k4 do
       ms4[i]:=ms4[i+1];
      ms4[n-k4+1]:=0;
     end;
   end;
 
  writeln('результирующие массивы: ');
  {вывод векторов (в случае, если все элементы вектора попадают в пределы отрезка, то массив не выводится)}
  write('1) ');
  for i:=1 to n-k1 do
   write(ms1[i]:3);
  writeln;
  write('2) ');
  for i:=1 to n-k2 do
   write(ms2[i]:3);
  writeln;
  write('3) ');
  for i:=1 to n-k3 do
   write(ms3[i]:3);
  writeln;
  write('4) ');
  for i:=1 to n-k4 do
   write(ms4[i]:3);
 
  assign(f,'file.doc');   {запись в файл}
  rewrite(f);
  writeln(f,'ishodn. massiv: ');
  for i:=1 to n do
   begin
    for j:=1 to n do
     write(f,mas[i,j]:3);
    writeln(f);
   end;
  writeln(f,'summa = ',sum);
  writeln(f,'result. massivi: ');
  for i:=1 to n-k1 do
   write(f,ms1[i]:3);
  writeln(f);
  for i:=1 to n-k2 do
   write(f,ms2[i]:3);
  writeln(f);
  for i:=1 to n-k3 do
   write(f,ms3[i]:3);
  writeln(f);
  for i:=1 to n-k4 do
   write(f,ms4[i]:3);
  writeln(f);
  close(f);
 end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 1.08.2025 17:02
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"