Программы на массивы, и процедуры, и функции.

@ZerEl · Регистрация: 29.06.2009

Author24 — интернет-сервис помощи студентам

Помогите пожалуйста написать программы! А то завтра экзамен и у меня не допуск!
1) Найдите номер последнего отрицательного элемента данного одномерного массива

Pascal

program otr;
const N=10;
type mas=array[1..N] of integer;
var massiv:mas; a,b:integer; i:byte;
procedure print(arr:mas;size:byte);
begin
     for i:=1 to size do
         write(arr[i],' ');
     writeln;
end;
begin
     randomize;
     a:=-9;
     b:=9;
     write('Массив: ');
     for i:=1 to N do
         massiv[i]:=random(b-a+1)+a;
     print(massiv,N);

Вот так я задаю массив.

2) Задан массив, состоящий из N целых чисел. Упорядочить его по убыванию, вставить в него элемент, значение которого равно c.

Pascal

program upr_c;
const N=10;
label qwer;
type mas=array[1..N] of integer;
var massiv:mas; a,b,e,t,u:integer; i,s,d:byte;
procedure print(arr:mas;size:byte);
begin
     for i:=1 to size do
         write(arr[i],' ');
     writeln;
end;
begin
     randomize;
     a:=-9;
     b:=9;
     writeln('Исходный массив');
     for i:=1 to N do
         massiv[i]:=random(b-a+1)+a;
     print(massiv,N);
     d:=N-2 div 2;
                  e:=1;
          qwer:for i:=1 to d do
          begin
 
               if massiv[i]<massiv[i+1] then
               begin
               u:=massiv[i];
               massiv[i]:=massiv[i+1];
               massiv[i+1]:=u;
               end;
 
          end;
          if e<=1000 then
          begin
          e:=e+1;
          goto qwer;
          end;
 
     writeln('Преобразованный массив');
     print(massiv,N);
end.

А вот в этой я его смог упорядочить только! Остальные вообще не понимаю!

3) Дана матрица размера M x N. Вывести ее элементы, расположенные в строках с
четными номерами (2, 4, ...). Вывод элементов производить по строкам, условный
оператор не использовать.
4) Матрица А (n, n) заполняется генератором случайных чисел и переписывается в
одномерный массив по строкам. Найти максимальный элемент главной диагонали
матрицы. В одномерном массиве обнулить элементы строки матрицы, в котором он
содержится, а содержащий его столбец удалить. Из оставшихся элементов
сформировать новую матрицу с тем же количеством строк.
5) Даны числа X, Y, Z, T – длинны сторон четырехугольника. Вычислить его площадь,
если угол между сторонами длинной X и Y – прямой.

@Puporev · 29.06.2009, 13:27

Остальные вообще не понимаю!

Тогда о каком допуске может идти речь? Только о допуске в ВС.

@mamedovvms · 29.06.2009, 13:28

3)

Pascal

uses crt;
var a:array[1..100,1..100] of integer;
      i,j,n,m:integer;
begin
 clrscr;
 writeln('n,m ');
 readln(n,m);
 
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=random(50);
    write(a[i,j]:4);
   end
  writeln;
 end;
writeln('Massiv');
i:=0;
repeat
i:=i+2;
 for j:=1 to m do
  write(a[i,j],' ');
writeln;
until(i>=n);
readln;
end.

@ZerEl · 29.06.2009, 14:23 **[ТС]**

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

Тогда о каком допуске может идти речь? Только о допуске в ВС.

Самому это сложновато разобрать! А объяснять нам толком не объяснили. Только на лекции в общем рассказали о том что такое массив и о процедурах с функциями. Так то я разбираюсь в написанной программе. Только вот самому не всегда хватает фантазии написать ее.
P.S.: 1) А ты злой, Puporev. :-)
2) Спасибо mamedovvms.

Добавлено через 30 минут 27 секунд
1) Вот первую додумал!

Pascal

program otr;
const N=10;
label qwer;
type mas=array[1..N] of integer;
var massiv:mas; a,b:integer; i:byte;
procedure print(arr:mas;size:byte);
begin
     for i:=1 to size do
         write(arr[i],' ');
     writeln;
end;
begin
     randomize;
     a:=-9;
     b:=9;
     write('массив: ');
     for i:=1 to N do
         massiv[i]:=random(b-a+1)+a;
     print(massiv,N);
     write('Номер последнего отрицательного элемента: ');
     for i:=1 to n do
     begin
          if massiv[n-i+1]<0 then
             begin
                  write(n-i+1,'  ');
                  goto qwer;
             end;
     end;
     qwer:writeln;
end.

@Puporev · 29.06.2009, 16:20

5) Даны числа X, Y, Z, T – длины сторон четырехугольника. Вычислить его площадь,
если угол между сторонами длинной X и Y – прямой.
Найти площадь прямоугольного треугольника и длину его гипотенузы. Потом по формуле Герона найти площадь второго треугольника и сложить.
При вводе сделать проверку. Ввести Х и У, потом Z и Т, проверить чтоб Z+T>sqrt(X*X+Y*Y), иначе 4х угольник не получится.

Добавлено через 48 минут 29 секунд
Держи, добрый человек, четвертую.

Pascal

uses crt;
var a:array[1..20,1..20] of integer;
    b:array[1..400] of integer;
    max:integer;
    n,i,j,k,l,imax:byte;
begin
clrscr;
randomize;
write('Размер матрицы n=');
readln(n);
writeln('Матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(20);
    write(a[i,j]:4);
   end;
  writeln;
 end;
max:=a[1,1];imax:=1;
for i:=1 to n do
if a[i,i]>max then
 begin
  max:=a[i,i];
  imax:=i;
 end;
writeln('Максимальный на главной диагонали=',max,' строка ',imax,' столбец ',imax);
writeln('Исходный массив:');
k:=0;
for i:=1 to n do
for j:=1 to n do
 begin
  k:=k+1;{считаем элементы}
  b[k]:=a[i,j];{записываем их в массив}
  write(b[k],' ');
 end;
writeln;
for i:=(imax-1)*n+1 to imax*n do{нужная строка}
b[i]:=0;{обнуляем}
writeln('Обнуление:');
for i:=1 to k do
write(b[i],' ');
writeln;
for i:=n downto 1 do{повторяем каков размер матрицы, только с конца}
for j:=k downto 1 do{по массиву с конца}
if j=(i-1)*n+imax then{если элемент принадлежит нужному столбцу}
 begin
  for l:=j to k-1 do{сдвигаем массив влево на 1 к этому элементу}
  b[l]:=b[l+1];
  k:=k-1;{уменьшаем размер массива}
 end;
writeln('Массив:');
for i:=1 to k do
write(b[i],' ');
readln
end.

Добавлено через 34 минуты 37 секунд
И вторую. На 2+ сойдет.

Pascal

uses crt;
var a:array[1..100] of integer;
    n,i,j,l,c,x:integer;
begin
clrscr;
randomize;
write('Размер массива n=');
readln(n);
writeln('Исходный массив:');
for i:=1 to n do
 begin
  a[i]:=random(20);
  write(a[i],' ');
 end;
writeln;
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]<a[j] then
 begin
  x:=a[i];
  a[i]:=a[j];
  a[j]:=x;
 end;
writeln('Отсортированный массив:');
for i:=1 to n do
write(a[i],' ');
writeln;
write('Введите число для вставки c=');
readln(c);
if c<=a[n] then a[n+1]:=c
else
 begin
  j:=0;
  for i:=1 to n do
  if a[i]>=c then j:=i;
  for l:=n+1 downto j+2 do
  a[l]:=a[l-1];
  a[j+1]:=c;
 end;
writeln('Результат:');
for i:=1 to n+1 do
write(a[i],' ');
readln
end.

@ZerEl · 29.06.2009, 16:34 **[ТС]**

Спасибо большущее! Я как раз сделал пятую!

Pascal

program prjam;
label zanovo;
var
   x,y,z,t,gip,p,S1,S2,S:real;
begin
     zanovo:
     writeln('Введите x,y,z,t');
     readln(x,y,z,t);
     if z+t<sqrt(x*x+y*y) then
     begin
          writeln('Введите в другом порядке строны, т.к. 4-х угольник не получается');
          goto zanovo;
     end;
     s1:=(x*y)/2;
     gip:=sqrt(x*x+y*y);
     p:=(z+t+gip)/2;
     s2:=sqrt(p*(p-z)*(p-t)*(p-gip));
     s:=s1+s2;
     writeln('Площадь = ',s:0:3);
end.

Ток вот странно что пятая работа была в теме процедур и функций, а тут это вообще не нужно.

@Puporev · 29.06.2009, 16:56

была в теме процедур и функций,

Напишите 2 функции, 1я- определение площади прямоугольного треугольника, 2я-определение площади по формуле Герона, раз уж тема такая.

@ilshat · 29.06.2009, 17:06

Никто не знает, как сделать так, чтобы после создания программы в конце не писалось Е+

к примеру 1,423742898126E+01

@Puporev · 29.06.2009, 17:11

write('x=',x:10:5); Ну ли сколько там надо знаков. 10-количество позизиций в строке под число, 5-количество знаков после запятой.
И не лезьте в чужие темы, в следующий раз удалю.

@ZerEl · 29.06.2009, 18:13 **[ТС]**

Вот так! Только как-то глупо получается!

Pascal

program prjam;
label zanovo;
var
   x,y,z,t,s:real;
function plo_4(a,b,c,d:real):real;
var gip,p,s1,s2,s0:real;
begin
     s1:=(a*b)/2;
     gip:=sqrt(a*a+b*b);
     p:=(c+d+gip)/2;
     s2:=sqrt(p*(p-c)*(p-d)*(p-gip));
     s0:=s1+s2;
     plo_4:=s0;
end;
begin
     zanovo:
     writeln('Введите x,y,z,t');
     readln(x,y,z,t);
     if z+t<sqrt(x*x+y*y) then
     begin
          writeln('Введите в другом порядке строны, т.к. 4-х угольник не получается');
          goto zanovo;
     end;
     s:=plo_4(x,y,z,t);
     writeln('Площадь = ',s:0:3);
end.

@Puporev · 29.06.2009, 18:45

Писать программу нужно вдумчиво, создавая ее структуру, чтоб действия шли последовательно, чтоб логика была. Старайся без нужды не использовать глобальные переменные и, тем более, эту древность goto.

Pascal

program prjam;
uses crt;
procedure PloshPrm(a,b:real;var c,s:real);
begin
c:=sqrt(a*a+b*b);
s:=a*b/2;
end;
function PloshTrg(a,b,c:real):real;
var p:real;
begin
p:=(a+b+c)/2;
PloshTrg:=sqrt(p*(p-a)*(p-b)*(p-c));
end;
var
   x,y,z,t,gip,s1,s2,s:real;
begin
clrscr;
writeln('Введите x,y');
readln(x,y);
repeat
writeln('Введите z,t');
readln(z,t);
if z+t<=sqrt(x*x+y*y) then
writeln('Это не 4-х угольник!');
until z+t>sqrt(x*x+y*y);
PloshPrm(x,y,gip,s1);
s2:=PloshTrg(z,t,gip);
s:=s1+s2;
writeln('Площадь = ',s:0:3);
readln
end.

@ZerEl · 30.06.2009, 17:26 **[ТС]**

Спасибо. Буду учиться. А goto мне просто нравится. Я знаю, что многие программисты против него!

@Puporev Почетный модератор 64300 / 47595 / 32743 Регистрация: 18.05.2008 Сообщений: 115,181
	29.06.2009, 13:27	2
	Остальные вообще не понимаю! Тогда о каком допуске может идти речь? Только о допуске в ВС. 0

@Puporev Почетный модератор 64300 / 47595 / 32743 Регистрация: 18.05.2008 Сообщений: 115,181
	29.06.2009, 16:56	7
	была в теме процедур и функций, Напишите 2 функции, 1я- определение площади прямоугольного треугольника, 2я-определение площади по формуле Герона, раз уж тема такая. 0

@ilshat 56 / 56 / 0 Регистрация: 04.06.2009 Сообщений: 357
	29.06.2009, 17:06	8
	Никто не знает, как сделать так, чтобы после создания программы в конце не писалось Е+ к примеру 1,423742898126E+01 0

@Puporev Почетный модератор 64300 / 47595 / 32743 Регистрация: 18.05.2008 Сообщений: 115,181
	29.06.2009, 17:11	9
	write('x=',x:10:5); Ну ли сколько там надо знаков. 10-количество позизиций в строке под число, 5-количество знаков после запятой. И не лезьте в чужие темы, в следующий раз удалю. 0

@ZerEl 0 / 0 / 0 Регистрация: 29.06.2009 Сообщений: 5
	30.06.2009, 17:26 [ТС]	12
	Спасибо. Буду учиться. А goto мне просто нравится. Я знаю, что многие программисты против него! 0