нарисовать блок схему: uses crt;
const nmax=10;
var n:integer;
type
Tmass=array[1..nmax] of real;
Tmatrix=array[1..nmax,1..nmax] of real;
{перестановка строк при главном элементе=0}
procedure Per(k:integer;var a:Tmatrix;var p:integer);
var z:Real;
j,i:integer;
begin
z:=abs(a[k,k]);{модуль главного элемента}
i:=k;{номер строки}
p:=0;{количество перестановок}
for j:=k+1 to n do {ищем в столбце ниже}
begin
if abs(a[j,k])>z then {элемент по модулю больше}
begin
z:=abs(a[j,k]);
i:=j;
p:=p+1;//счетчик перестановок
end;
end;
if i>k then{если нашли}
for j:=k to n do
begin
z:=a[i,j];
a[i,j]:=a[k,j];{обмениваем строки}
a[k,j]:=z;
end;
end;
{определение знака определителя}
function Znak(p:integer):integer;
begin
if p mod 2=0 then
Znak:=1 else Znak:=-1;
end;
{вычисление определителя матрицы коэффициентов по Гауссу}
procedure Opr(var det:real;var a:tmatrix);
var k,i,j,p:integer;r:real;
begin
det:=1.0;
for k:=1 to n do
begin
if a[k,k]=0 then Per(k,a,p);//перестановка строк
det:=znak(p)*det*a[k,k];//вычисление определителя
for j:=k+1 to n do //пересчет коэффициентов
begin
r:=a[j,k]/a[k,k];
for i:=k to n do
a[j,i]:=a[j,i]-r*a[k,i];
end;
end;
end;
{вычисление алгебраических дополнений}
procedure Dop(d:tmatrix;var det1:real);
var k,i,j,p:integer;r:real;
begin
det1:=1.0;
for k:=2 to n do
begin
Per(k,d,p);
det1:=znak(p)*det1*d[k,k];
for j:=k+1 to n do
begin
r:=d[j,k]/d[k,k];
for i:=k to n do
d[j,i]:=(d[j,i]-r*d[k,i]);
end;
end;
end;
{установление знака алгебраических дополнений}
function Znak1(i,m:integer):integer;
begin
if (i+m) mod 2=0 then
Znak1:=1 else Znak1:=-1;
end;
{формирование присоединенной матрицы}
Procedure Peresch(b:Tmatrix;var e:Tmatrix );
var i,m,k,j:integer;z,det1:real;d,c:Tmatrix;
begin
for i:=1 to n do
begin
for m:=1 to n do
begin
for j:=1 to n do {перестановка строки}
begin
z:=b[i,j];
for k:=i downto 2 do
d[k,j]:=b[k-1,j];
for k:=i+1 to n do
d[k,j]:=b[k,j];
d[1,j]:=z;
end;
for k:=1 to n do {перестановка столбца}
begin
z:=d[k,m];
for j:=m downto 2 do
c[k,j]:=d[k,j-1];
for j:=m+1 to n do
c[k,j]:=d[k,j];
c[k,1]:=z;
end;
Dop(c,det1); {вычисление дополнений}
e[i,m]:=(det1)*znak1(i,m); {установление знака дополнений и }
end; {формирование присоединенной матрицы }
end;
end;
{транспонирование матрицы}
Procedure Trans(b:Tmatrix;var e:Tmatrix);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
e[i,j]:=b[j,i];
end;
{нахождение корней умножением обратной матрицы на столбец свободных членов}
Procedure Resh(n:integer;a:Tmatrix;b:Tmass;var x:Tmass);
var k,j:integer;z:real;
begin
for k:=1 to n do
begin
x[k]:=0;
for j:=1 to n do
begin
z:=a[k,j]*b[j];
x[k]:=x[k]+z;
end;
end;
end;
var a,a1,at,b,c:Tmatrix;
f,x:Tmass;
det:Real;
i,j,d,v:integer;
begin
textbackground(black);
clrscr;
for d := 10 to 110 do
for v:= 1 to 1 do
begin
GotoXY(d,v);
Write('-');
end;
for d := 110 to 110 do
for v := 2 to 15 do
begin
GotoXY(d,v);
textcolor(white);
Write('|');
end;
for d := 10 to 10 do
for v := 2 to 15 do
begin
GotoXY(d,v);
textcolor(white);
Write('|');
end;
for d := 10 to 110 do
for v := 15 to 15 do
begin
GotoXY(d,v);
textcolor(white);
Write('-');
end;
textcolor(red);
gotoxy(55,2);
writeln('Курсовая работа');
//textcolor(lightblue);
gotoxy(56,3);
writeln('по дисциплине');
textcolor(red);
gotoxy(42,4);
write('"Алгоритмические языки программирования"');
textcolor(red);
gotoxy(57,5);
writeln('на тему');
textcolor(red);
gotoxy(52,6);
writeln('"работа с матрицами"');
textcolor(red);
gotoxy(56,7);
writeln('Задание 5.4');
textcolor(red);
gotoxy(90,8);
writeln('Выполнил:');
textcolor(red);
gotoxy(90,9);
writeln('Студент гр. 9044');
textcolor(red);
gotoxy(90,10);
writeln('Демянчук Д.В.');
textcolor(red);
gotoxy(90,11);
writeln('Проверила');
textcolor(red);
gotoxy(90,12);
writeln('Доцент кафедры ВПМ');
textcolor(red);
gotoxy(90,13);
writeln('Москвитина О.А.');
textcolor(red);
gotoxy(55,14);
writeln('Рязань 2020');
textcolor(red);
gotoxy(55,15);
writeln(' ');
textcolor(white);
{решение системы}
repeat
write('Порядок системы до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Введите коэффициенты системы:');
for i:=1 to n do
for j:=1 to n do
begin
write('a[',i,',',j,']=');
readln(a[i,j]);
end;
clrscr;
writeln('Введите свободные члены:');
for i:=1 to n do
begin
write('f[',i,']=');
readln(f[i]);
end;
clrscr;
writeln('Исходная система:');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:5:1);
writeln(f[i]:7:1);
end;
writeln;
a1:=a;{сделаем копию матрицы для нахождения определителя, она изменится}
Opr(det,a1);{вычисление определителя матрицы}
writeln('Определитель=',det:0:0);
if det=0 then
begin
write('Решений не существует');
readln;
exit;
end;
Peresch(a,b); { вычисление присоединенной матрицы}
Trans(b,c);{транспонирование присоединенной матрицы}
for i:=1 to n do
for j:=1 to n do
c[i,j]:=c[i,j]/det;{деление на определитель=обратная матрица}
{нахождение корней}
Resh(n,c,f,x);
for i:=1 to n do
writeln('x[',i,']=',x[i]:0:1);
readln;
end.
2+4+6+...+198+200.
1. Самый короткий вариант
// PascalABC.NET 3.1, сборка 1219 от 16.04.2016
begin
Writeln(Range(2,200,2).Sum)
end.
Результат:
10100
2. Более длинный и более "школьный" вариант
// PascalABC.NET 3.1, сборка 1219 от 16.04.2016
begin
var s:=0;
var i:=2;
while i<=200 do begin
s:=s+i;
i:=i+2
end;
Writeln(s)
end.
3. Совсем "тупой школьный" вариант (решение "в лоб")
// PascalABC.NET 3.1, сборка 1219 от 16.04.2016
var
i,s:integer;
begin
s:=0;
for i:=1 to 200 do
if i mod 2 =0 then s:=s+i;
Writeln(s)
end.
4. Улучшенный "школьный" вариант
// PascalABC.NET 3.1, сборка 1219 от 16.04.2016
var
i,s:integer;
begin
s:=0;
for i:=1 to 100 do s:=s+2*i;
Writeln(s)
end.
//PascalABC.Net 3.0, сборка 1111
type
Point=record
x,y:double
end;
function TriangleSquare(A,B,C:Point):double;
begin
Result:=0.5*abs(A.x*(B.y-C.y)+B.x*(C.y-A.y)+C.x*(A.y-B.y))
end;
procedure GetPoint(c:char; var A:Point);
begin
Write('Введите координаты точки ',c,': ');
Readln(A.x,A.y)
end;
var
A:array['A'..'F'] of Point;
i:'A'..'F';
s1,s2:double;
begin
for i:='A' to 'F' do GetPoint(i,A[i]);
s1:=TriangleSquare(A['A'],A['B'],A['C']);
s2:=TriangleSquare(A['D'],A['E'],A['F']);
if s1>s2 then Writeln('Площадь первого треугольника больше')
else
if s2>s1 then Writeln('Площадь второго треугольника больше')
else Writeln('Площади треугольников равны')
end.
Тестовое решение:
Введите координаты точки A: -4 3.7
Введите координаты точки B: -6.3 0
Введите координаты точки C: 10.2 5.93
Введите координаты точки D: 7.143 8.1
Введите координаты точки E: -6 -3
Введите координаты точки F: 7.4 -5.7
Площадь второго треугольника больше