Дан массив х (n) . переписать в массив y(n) отрицательные элементы массива х умноженные на 2. (со сжатием., без пустых элементов внутри) затем упорядочить методом «выбора и перестановки»по возрастанию новый массив.
Program gt; var x,y:array[1..1000]of integer; k,n,i,j,r:integer; begin read(n); k:=0; for i:=1 to n do begin read(x[i]); if(x[i]<0)then begin k:=k+1; y[k]:=x[i]*2; end; end; for i:=1 to k do begin for j:=1 to k-i do begin r:=y[j]; if(y[j]>y[j+1])then begin y[j]:=y[j+1]; y[j+1]:=r; end; end; end; for i:=1 to k do begin write(y[i],' '); end; end. это метод пузырка
// PascalABC.NET 3.1, сборка 1230 от 27.04.2016 unit MatInt;
interface
type Matrix=array[,] of integer;
function MatCreate(m,n:integer):Matrix; procedure MatPrint(a:Matrix;w:integer); procedure MatMax(a:Matrix;var x,imax,jmax:integer);
implementation
function MatCreate(m,n:integer):Matrix; // создает матрицу и инициализирует её нулями begin SetLength(Result,m,n); end;
procedure MatPrint(a:Matrix;w:integer); // выводит матрицу, отводя w позиций под элемент begin var n:=Length(a,1)-1; for var i:=0 to Length(a,0)-1 do begin for var j:=0 to n do Write(a[i,j]:w); Writeln end end;
procedure MatMax(a:Matrix;var x,imax,jmax:integer); // возвращает значение максимального элемента и его координаты begin imax:=0; jmax:=0; var n:=Length(a,1)-1; for var i:=0 to Length(a,0)-1 do for var j:=0 to n do if a[i,j]>a[imax,jmax] then (imax,jmax):=(i,j); Inc(imax); Inc(jmax); x:=a[imax-1,jmax-1] end;
// PascalABC.NET 3.1, сборка 1230 от 27.04.2016 uses MatInt; begin var a:=MatCreate(5,8); var n:=Length(a,1)-1; for var i:=0 to Length(a,0)-1 do for var j:=0 to n do a[i,j]:=Random(-50,50); MatPrint(a,4); var irow,jcol,max:integer; MatMax(a,max,irow,jcol); Writeln('Максимальный А[',irow,',',jcol,']=',max) end.
// PascalABC.NET 3.1, сборка 1230 от 27.04.2016 function FS(a,b:real):=0.5*a*b; begin var a,b:real; Write('Катеты первого треугольника: '); Read(a,b); var S1:=FS(a,b); Write('Катеты второго треугольника: '); Read(a,b); var S2:=FS(a,b); if S1>S2 then Writeln('Площадь первого треугольника больше') else if S1<S2 then Writeln('Площадь второго треугольника больше') else Writeln('Площади треугольников равны') end.
Тестовое решение Катеты первого треугольника: 4.18 6 Катеты второго треугольника: 5.4 3.9 Площадь первого треугольника больше
var x,y:array[1..1000]of integer;
k,n,i,j,r:integer;
begin
read(n);
k:=0;
for i:=1 to n do
begin
read(x[i]);
if(x[i]<0)then begin
k:=k+1;
y[k]:=x[i]*2;
end;
end;
for i:=1 to k do
begin
for j:=1 to k-i do
begin
r:=y[j];
if(y[j]>y[j+1])then begin
y[j]:=y[j+1];
y[j+1]:=r;
end;
end;
end;
for i:=1 to k do
begin
write(y[i],' ');
end;
end.
это метод пузырка