Технический форум - Программа на Паскале. Массивы

Технический форум (http://www.tehnari.ru/)

- Помощь студентам (http://www.tehnari.ru/f41/)

- - Программа на Паскале. Массивы (http://www.tehnari.ru/f41/t45376/)

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

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

В квадратной матрице 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.

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

Ну что же, за исключением нескольких "шероховатостей" программа первой части написана грамотно. Вот только:
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.

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

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

Код:

Procedure traekt;

 begin

 writeln('traektoriya:');

 for j:=1 to n do

 write(A[n,j]:5);

 end;

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

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

Цитата:

Сообщение от newkami (Сообщение 446177)

Код:

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;

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

Код:

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;

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

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

Код:

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;

правилььно?

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

Код:

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.

Огромное вам спасибо, Vladimir_S. Вы мне очень помогли, Так бы еще не один день ушел на эту работу. А так двумя днями обошелся :)
Еще один вопрос: как можно эти области на матрице преобразованной выделить другим цветом? У меня почему-то цвет всех элементов матрицы меняется. :(
Наверно я куда-то не туда textcolor ставлю? Не подскажете куда воткнуть его?

Цитата:

Сообщение от newkami (Сообщение 446290)

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