Программа на Паскале. Массивы

newkami · 14.01.2011, 15:06

Помогите, пожалуйста, сделать программу:

В квадратной матрице nxn (n принадлежит промежутку от 5 до 15) необходимо:
1. ввести размерность массива через клавиатуру с контролем вводимых значений.
2. Заполнить массив случайными числами от -100 да +100 и вывести полученную матрицу на экран.
3 Поменять местами, указанные области в массиве и вывести преобразованную матрицу на экран.
4. Пройтись по указанной траектории, и вывести полученные результаты в виде матрицы строки.
5.Полученную матрицу строку сортировать по возрастанию и убыванию.
6.В матрице, кроме выделенных областей, найти максимальный и минимальный элементы.

Вот мои наработки:

program kyrs;
uses crt;
type mas=array[1..15,1..15] of integer;
var i,j,n:integer;
A:mas;
procedure vvod;
begin
write('vvedite razmernost massiva ot 5 do 15');
write('n=');
readln(n);
if (5<=n)and(n<=15) then
begin
for i:=1 to n do
for j:=1 to n do
A[i,j]:=-100+random(201);
end
else
write('n ne sootvetstvuet promeutku [5,15]');
end;
procedure vivod;
begin
for i:=1 to n do
begin
for j:=1 to n do
write(A[i,j]:5);
writeln;
end;
end;
begin
clrscr;
randomize;
textbackground(9);
textcolor(13);
vvod;
vivod;
readln;
end.

Первые два пункта сделал, но как делать дальше совсем не представляю.

Vladimir_S · 14.01.2011, 15:40

Ну что же, за исключением нескольких "шероховатостей" программа первой части написана грамотно. Вот только:
1. В Паскале, в отличие от Бэйсика, строки не нумеруются, и любой транслятор выдаст сообщение об ошибке.
2. Если Вы хотите проконтролировать попадание размерности матрицы в нужный диапазон, то эту часть программы лучше "зациклить".
3. Не очень понятно, зачем тут нужны процедуры. Они (равно как и введение пользовательского типа mas) тут явно просто "для мебели". Но, конечно, можно и так.
В итоге я хочу предложить чуть подправленный вариант:

Код:

program kyrs;
uses crt;
type
 mas=array[1..15,1..15] of integer;
var
 i,j,n:integer;
 A:mas;
procedure vvod;
 begin
  repeat
   clrscr;
   write('vvedite razmernost massiva ot 5 do 15: ');
   readln(n);
  until (n>=5) and (n<=15);
  for i:=1 to n do
   for j:=1 to n do
    A[i,j]:=-100+random(201);
 end;
procedure vivod;
 begin
  for i:=1 to n do
   begin
    for j:=1 to n do
     write(A[i,j]:5);
    writeln;
   end;
 end;
begin
 clrscr;
 randomize;
 textbackground(9);
 textcolor(13);
 vvod;
 vivod;
 readln;
end.

Что касается последующих пунктов, то они сформулированы уж очень "мутно". Прежде всего - кто должен "выделять области" и "указывать траекторию"? И как это будет происходить? Непонятно...

newkami · 15.01.2011, 00:46

Ах да, совсем забыл, простите меня, рисунок который предлагается к работе. вот он.

newkami · 15.01.2011, 10:11

Код:

Procedure traekt;
 begin
 writeln('traektoriya:');
 for j:=1 to n do
 write(A[n,j]:5);
 end;

Вот процедура которая выводит массив строку по заданной траектории.

Не представляю пока как поменять местами выделенные области массива...

Vladimir_S · 15.01.2011, 11:02

Цитата:

Сообщение от newkami

Код:

Procedure traekt;
 begin
 writeln('traektoriya:');
 for j:=1 to n do
 write(A[n,j]:5);
 end;

Вот процедура которая выводит массив строку по заданной траектории.

Не представляю пока как поменять местами выделенные области массива...

Так-то оно, конечно, так, но! Поскольку задача состоит не просто в том, чтобы вывести одномерный массив на экран, а еще и в том, чтобы с ним дальше работать (сортировать), то следует сделать так:
В раздел TYPE (исключительно для соблюдения стиля) добавить:

Код:

Vector=array[1..15] of integer;

В раздел VAR:

Код:

V:Vector;

И, наконец, сама процедура. Либо так:

Код:

Procedure traekt;
 begin
  writeln('traektoriya:');
  for j:=1 to n do
   begin
    V[j]:=A[n,j];
    write(V[j]:5);
   end;
 end;

либо

Код:

Procedure traekt;
  begin
   writeln('traektoriya:');
   V:=A[n];
   for j:=1 to n do
     write(V[j]:5);
  end;

newkami · 15.01.2011, 12:05

Вот получилось отсортировать строку:

Код:

Procedure vozr;
     var k:integer;
     begin
      writeln('sort po vozr');
          for i:=1 to n do
 	 for j:=1 to n-1 do begin
	  if V[i]<V[j] then begin
	   k:=V[i];
	    V[i]:=V[j];
	   V[j]:=k;
	 end;
	end;
    for i:=1 to n do begin
    write(V[i]:5);
    end;
end;

Подскажите, плиз, каким образом менять указанные области в массиве?
Нашел что-то подобное, но там каким-то ,непонятным для меня, образом области массива меняются через целочисленное деление...

Код:

Procedure obmen(var n:integer); 
Var p:Integer; 
begin 
p:=n div 4+1; 
for i:=n div 4+1 to n div 2+1 do begin 
p:=p-1; 
for j:=(n div 2+1)+p to n-p do begin 
tmp:=a[i,j]; 
a[i,j]:=a[i+(n div 2),j-(n div 2)]; 
a[i+(n div 2),j-(n div 2)]:=tmp; 
end; 
end; 
end;

Вот этого не могу понять.
Тут правда другие участки меняются местами:

newkami · 15.01.2011, 12:31

Нашел максимум и минимум, но надо как-то исключить значения выделенных областей. Подскажите как эти области обозначить? как их найти,выделить...

Код:

Procedure maxmin;
  var
   min,max:integer;
  begin
    max:=A[1,1];
    min:=A[1,1];
    for i:=1 to n do
     for j:=1 to n do
      begin
       if A[i,j]>max then
       max:=A[i,j];
       if A[i,j]<min then
       min:=A[i,j];
     end;
   writeln('max=',max);
   writeln('min=',min);
  end;

правилььно?

Vladimir_S · 15.01.2011, 13:09

Ладно, будем считать, что совместными усилиями пришли сюда:

Код:

program kyrs;
uses crt;

type
 mas=array[1..15,1..15] of integer;
 vector=array[1..15] of integer;

var
 i,j,n:integer;
 A,B:mas;
 V,V1,V2:vector;

procedure vvod;
 begin
  repeat
   clrscr;
   write('vvedite razmernost massiva ot 5 do 15: ');
   readln(n);
  until (n>=5) and (n<=15);
  for i:=1 to n do
   for j:=1 to n do
    A[i,j]:=-100+random(201);
 end;

procedure vivod(Av:mas);
 var i1,j1:integer;
 begin
  i1:=(n div 2)+1;
  if (n mod 2)=0 then
   j1:=(n div 2)
  else
   j1:=(n div 2)+1;
  for i:=1 to n do
   begin
    for j:=1 to n do
     begin
      if (i<i1) or ((i>i1) and (j<=i-i1)) or
         ((i>=i1) and (j>j1) and (j<n-(i-i1))) then
       textcolor(13) else textcolor(14);
      write(Av[i,j]:5);
     end;
    writeln;
    textcolor(13);
   end;
  Writeln('Press "Enter" to continue...');
  ReadLn;
 end;

procedure vivod_V(Vv:vector);
 begin
  for i:=1 to n do
   write(Vv[i]:5);
  writeln;
 end;

procedure obmen(Ao:mas; var Bo:mas);
 var i1,j1:integer;
 begin
  Bo:=Ao;
  i1:=(n div 2)+1;
  if (n mod 2)=0 then
   begin
    j1:=(n div 2);
    for i:=i1 to n do
     for j:=i-i1+1 to j1 do
      begin
       Bo[j1+j,n-(i-i1)]:=Ao[i,j];
       Bo[i,j]:=Ao[j1+j,n-(i-i1)];
      end;
   end
  else
   begin
    j1:=(n div 2)+1;
    for i:=i1 to n do
     for j:=i-i1+1 to j1 do
      begin
       Bo[j1+j-1,n-(i-i1)]:=Ao[i,j];
       Bo[i,j]:=Ao[j1+j-1,n-(i-i1)];
      end;
   end;
 end;

procedure traekt;
 begin
  writeln('traektoriya:');
  V:=A[n];
  for j:=1 to n do
   write(V[j]:5);
  writeln;
  Writeln('Press "Enter" to continue...');
  ReadLn;
 end;

procedure order(Vo:vector; var Vo1:vector; var Vo2:vector);
 var d:integer;
 begin
  Vo1:=V;
  for i:=1 to n do
   for j:=1 to n-i do
    if Vo1[j]>Vo1[j+1] then
     begin
      d:=Vo1[j+1];
      Vo1[j+1]:=Vo1[j];
      Vo1[j]:=d;
     end;
  Vo2:=V;
  for i:=1 to n do
   for j:=1 to n-i do
    if Vo2[j]<Vo2[j+1] then
     begin
      d:=Vo2[j+1];
      Vo2[j+1]:=Vo2[j];
      Vo2[j]:=d;
     end;
 end;

procedure maxmin;
 var
  min,max,i1,j1:integer;
 begin
  i1:=(n div 2)+1;
  if (n mod 2)=0 then
   j1:=(n div 2)
  else
   j1:=(n div 2)+1;
  max:=A[1,1];
  min:=A[1,1];
  for i:=1 to i1-1 do
   for j:=1 to n do
    begin
     if A[i,j]>max then
      max:=A[i,j];
     if A[i,j]<min then
       min:=A[i,j];
    end;
  for i:=i1 to n-2 do
   for j:=j1+1 to n-(i-i1+1) do
    begin
     if A[i,j]>max then
      max:=A[i,j];
     if A[i,j]<min then
       min:=A[i,j];
    end;
  for i:=i1+1 to n do
   for j:=1 to i-i1 do
    begin
     if A[i,j]>max then
      max:=A[i,j];
     if A[i,j]<min then
       min:=A[i,j];
    end;
   writeln('max=',max);
   writeln('min=',min);
  end;

BEGIN
 clrscr;
 randomize;
 textbackground(9);
 textcolor(13);
 vvod;
 clrscr;
 Writeln('Ishodnaya matritsa:');
 vivod(A);
 obmen(A,B);
 Writeln('Preobrazovannaya matritsa:');
 vivod(B);
 clrscr;
 traekt;
 order(V,V1,V2);
 Writeln;
 vivod_v(V1);
 Writeln;
 vivod_v(V2);
 Writeln('Press "Enter" to continue...');
 Readln;
 Writeln;
 Maxmin;
 ReadLn;
END.

newkami · 15.01.2011, 14:35

Огромное вам спасибо, Vladimir_S. Вы мне очень помогли, Так бы еще не один день ушел на эту работу. А так двумя днями обошелся

Еще один вопрос: как можно эти области на матрице преобразованной выделить другим цветом? У меня почему-то цвет всех элементов матрицы меняется.

Наверно я куда-то не туда textcolor ставлю? Не подскажете куда воткнуть его?

Vladimir_S · 15.01.2011, 15:02

Цитата:

Сообщение от newkami

Огромное вам спасибо, Vladimir_S. Вы мне очень помогли, Так бы еще не один день ушел на эту работу. А так двумя днями обошелся

Еще один вопрос: как можно эти области на матрице преобразованной выделить другим цветом? У меня почему-то цвет всех элементов матрицы меняется.

Наверно я куда-то не туда textcolor ставлю? Не подскажете куда воткнуть его?

Цвета - это просто. Но только обнаружил, что с обменом малость напортачено. Сейчас постараюсь поправить.

14.01.2011, 15:06	#1 (permalink)
newkami Новичок Регистрация: 14.01.2011 Сообщений: 8 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Программа на Паскале. Массивы Помогите, пожалуйста, сделать программу: В квадратной матрице nxn (n принадлежит промежутку от 5 до 15) необходимо: 1. ввести размерность массива через клавиатуру с контролем вводимых значений. 2. Заполнить массив случайными числами от -100 да +100 и вывести полученную матрицу на экран. 3 Поменять местами, указанные области в массиве и вывести преобразованную матрицу на экран. 4. Пройтись по указанной траектории, и вывести полученные результаты в виде матрицы строки. 5.Полученную матрицу строку сортировать по возрастанию и убыванию. 6.В матрице, кроме выделенных областей, найти максимальный и минимальный элементы. Вот мои наработки: program kyrs; uses crt; type mas=array[1..15,1..15] of integer; var i,j,n:integer; A:mas; procedure vvod; begin write('vvedite razmernost massiva ot 5 do 15'); write('n='); readln(n); if (5<=n)and(n<=15) then begin for i:=1 to n do for j:=1 to n do A[i,j]:=-100+random(201); end else write('n ne sootvetstvuet promeutku [5,15]'); end; procedure vivod; begin for i:=1 to n do begin for j:=1 to n do write(A[i,j]:5); writeln; end; end; begin clrscr; randomize; textbackground(9); textcolor(13); vvod; vivod; readln; end. Первые два пункта сделал, но как делать дальше совсем не представляю.

14.01.2011, 15:40	#2 (permalink)
Vladimir_S Специалист Регистрация: 27.08.2008 Адрес: Санкт-Петербург Сообщений: 27,807 Сказал(а) спасибо: 340 Поблагодарили 583 раз(а) в 208 сообщениях Репутация: 113184	Ну что же, за исключением нескольких "шероховатостей" программа первой части написана грамотно. Вот только: 1. В Паскале, в отличие от Бэйсика, строки не нумеруются, и любой транслятор выдаст сообщение об ошибке. 2. Если Вы хотите проконтролировать попадание размерности матрицы в нужный диапазон, то эту часть программы лучше "зациклить". 3. Не очень понятно, зачем тут нужны процедуры. Они (равно как и введение пользовательского типа mas) тут явно просто "для мебели". Но, конечно, можно и так. В итоге я хочу предложить чуть подправленный вариант: Код: program kyrs; uses crt; type mas=array[1..15,1..15] of integer; var i,j,n:integer; A:mas; procedure vvod; begin repeat clrscr; write('vvedite razmernost massiva ot 5 do 15: '); readln(n); until (n>=5) and (n<=15); for i:=1 to n do for j:=1 to n do A[i,j]:=-100+random(201); end; procedure vivod; begin for i:=1 to n do begin for j:=1 to n do write(A[i,j]:5); writeln; end; end; begin clrscr; randomize; textbackground(9); textcolor(13); vvod; vivod; readln; end. Что касается последующих пунктов, то они сформулированы уж очень "мутно". Прежде всего - кто должен "выделять области" и "указывать траекторию"? И как это будет происходить? Непонятно...

15.01.2011, 00:46	#3 (permalink)
newkami Новичок Регистрация: 14.01.2011 Сообщений: 8 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Ах да, совсем забыл, простите меня, рисунок который предлагается к работе. вот он. Миниатюры

15.01.2011, 10:11	#4 (permalink)
newkami Новичок Регистрация: 14.01.2011 Сообщений: 8 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Код: Procedure traekt; begin writeln('traektoriya:'); for j:=1 to n do write(A[n,j]:5); end; Вот процедура которая выводит массив строку по заданной траектории. Не представляю пока как поменять местами выделенные области массива...

15.01.2011, 12:05	#6 (permalink)
newkami Новичок Регистрация: 14.01.2011 Сообщений: 8 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Вот получилось отсортировать строку: Код: Procedure vozr; var k:integer; begin writeln('sort po vozr'); for i:=1 to n do for j:=1 to n-1 do begin if V[i]<V[j] then begin k:=V[i]; V[i]:=V[j]; V[j]:=k; end; end; for i:=1 to n do begin write(V[i]:5); end; end; Подскажите, плиз, каким образом менять указанные области в массиве? Нашел что-то подобное, но там каким-то ,непонятным для меня, образом области массива меняются через целочисленное деление... Код: Procedure obmen(var n:integer); Var p:Integer; begin p:=n div 4+1; for i:=n div 4+1 to n div 2+1 do begin p:=p-1; for j:=(n div 2+1)+p to n-p do begin tmp:=a[i,j]; a[i,j]:=a[i+(n div 2),j-(n div 2)]; a[i+(n div 2),j-(n div 2)]:=tmp; end; end; end; Вот этого не могу понять. Тут правда другие участки меняются местами: Последний раз редактировалось newkami; 15.01.2011 в 12:14

14.01.2011, 15:06
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	На форуме часто создаются аналогичные темы, вот аналоги вашей Матрицы и массивы в паскале Задача на массивы в Паскале Массивы на Паскале Массивы

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070

15.01.2011, 12:31	#7 (permalink)
newkami Новичок Регистрация: 14.01.2011 Сообщений: 8 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Нашел максимум и минимум, но надо как-то исключить значения выделенных областей. Подскажите как эти области обозначить? как их найти,выделить... Код: Procedure maxmin; var min,max:integer; begin max:=A[1,1]; min:=A[1,1]; for i:=1 to n do for j:=1 to n do begin if A[i,j]>max then max:=A[i,j]; if A[i,j]<min then min:=A[i,j]; end; writeln('max=',max); writeln('min=',min); end; правилььно?

15.01.2011, 14:35	#9 (permalink)
newkami Новичок Регистрация: 14.01.2011 Сообщений: 8 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Огромное вам спасибо, Vladimir_S. Вы мне очень помогли, Так бы еще не один день ушел на эту работу. А так двумя днями обошелся Еще один вопрос: как можно эти области на матрице преобразованной выделить другим цветом? У меня почему-то цвет всех элементов матрицы меняется. Наверно я куда-то не туда textcolor ставлю? Не подскажете куда воткнуть его?