Операционные системы - Электронные книги, документация, FAQ, ОС и многое другое

Статьи :

Операционные системы :

Железо :

OS FAQ :

Кодинг :

Новости :

Примеры решения задач...

Материал подготовил(и): AlaRic

1. Задан массив A из 100 чисел. Описать функцию для определения количества нечетных чисел среди его первых N элементов. В качестве параметров взять A и N. Если нечетных нет, то результат функции - число 7777777.

CODE

uses crt;
var
a:array[1..100] of integer;
i,n:integer;
function Nech(b:array of integer; m:integer):word;
var
k,j:integer;
begin
k:=0;
j:=0;
for j:=1 to m do
begin
if b[j] mod 2<>0 then k:=k+1;
end;
if k=0 then Nech:=7777 else Nech:=k;
end;
begin
ClrScr;
Randomize;
for i:=1 to 100 do
begin
a[i]:=random(9)+1;
write(a[i]:2);
end;
writeln;
write('Input n -> ');readln(n);
writeln('Output -> ',Nech(a,n));
readln;
end.

2. Задан двумерный целочисленный массив G размером 10 на 10 элементов. Написать процедуру для определения числа тех строк массива, которые не содержат чисел из первой строки.

CODE

uses crt;
const n=5;{ Размерность массива }
var
a:array[1..n,1..n] of integer;
q:array[1..n] of integer;
i,j,k,y,t:integer;
b:boolean;
begin
ClrScr;
Randomize;
{=== Заполняем массив ===}
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(99)+1;
write(a[i,j]:4);
end;
writeln;
end;
{--------- Begin --------}
k:=0;t:=1;
for i:=2 to n do
begin
b:=true;
for j:=1 to n do
begin
for y:=1 to n do
if a[i,j]=a[1,y] then
begin
b:=false;
break;
end;
end;
if b then
begin
k:=k+1;
q[t]:=i;
t:=t+1;
end;
end;
{---------- End ---------}
writeln('Таких строк: ',k);
write('Вот их номера: ');for i:=1 to t-1 do write(q[i],' ');
readln;
end.

3. Даны 2 матрицы A(M,N) и B(N,N). Подсчитать и вывести на экран общее количество отрицательных элементов, определить в какой из матриц среднее арифметическое значение прочих элементов имеет большую величину.

CODE

program too_matrix;
const
m=4;
n=5;
var
A:array[1..m,1..n] of integer;
B:array[1..n,1..n] of integer;
i,j,Sa,Sb,k: integer;
ka,kb : integer;
SredA,SredB: real;
begin
k:=0; ka:=0; kb:=0;
for i:=1 to m do
begin
for j:=1 to n do
begin
a[i,j]:=random(10)-5;
write(a[i,j]:3);
if a[i,j]<0 then begin k:=k+1; ka:=ka+1; Sa:=Sa+abs(a[i,j]); end;
end;
writeln;
end;
writeln;
for i:=1 to n do
begin
for j:=1 to n do
begin
b[i,j]:=random(10)-5;
write(b[i,j]:3);
if b[i,j]<0 then begin k:=k+1; kb:=kb+1; Sb:=Sb+abs(b[i,j]); end;
end;
writeln;
end;
writeln('Elements < 0: ',k);
if ka<>0 then SredA:=Sa/ka;
if kb<>0 then SredB:=Sb/kb;
if SredA>SredB then writeln('В массиве A среднее арифметическое отрицательных элементов больше.')
else if SredB>SredA then writeln('В массиве B среднее арифметическое отрицательных элементов больше.')
else writeln('Одинаково!');
readln;
end.

4. Дан вещественный массив X(M) найти элемент массива, значение которого наиболее близко к какому нибудь целому числу.

CODE

program n_2;
const
m=10;
var
x : array[1..m] of real;
i,index : integer;
min,res : real;
begin
for i:=1 to m do
begin
write('x[',i,']=');
readln(x[i]);
end;
min:=1;
for i:=1 to m do
begin
if frac(x[i])>=0.5 then res:=1-frac(x[i])
else res:=1-(1-frac(x[i]));
if res begin
min:=res;
index:=i;
end;
end;
write('Output: ',x[index]:0:3);
readln;
end.

5. Составить программу, выводящую на экран номера элементов массива, кратных четырем.

CODE

program Mod4;
const n=8; { Размерность массива }
var
i : byte;
a : array [1..n] of integer;
begin
{ Заполнение массива }
for i:=1 to n do
begin
write('a[',i,']=');
readln(a[i]);
end;
for i:=1 to n do
if a[i] mod 4 = 0 then write(i,' ');
readln;
end.

6. Составить алгоритм и программу для сортировки массива по следующему принципу следования элементов: максимальный элемент, минимальный элемент, 2й по величине, предпоследний, 3й по величине, 3й с конца и т.д.

CODE

program Sort_Mas;
const n=8; { Размерность массива }
var
i,j : byte; { Счетчики в циклах }
imin: byte; { Индекс минимального элемента }
k,c : integer;
min : integer; { Минимальный элемент }
a : array [1..n] of integer;
begin
{ Заполнение массива }
for i:=1 to n do
begin
write('a[',i,']=');
readln(a[i]);
end;
{ Пузырьковая сортировка по возрастанию }
for i:=2 to n do
for j:=n downto i do
begin
if a[j-1]>a[j] then
begin
c:=a[j-1];a[j-1]:=a[j];a[j]:=c;
end;
end;
{ Ставим максимальные элементы на нужные позиции }
i:=1;k:=n;
while k>(n div 2)+1 do
begin
c:=a[i];
a[i]:=a[k];
a[k]:=c;
i:=i+2;
k:=k-1;
end;
{ Ставим минимальные элементы на нужные позиции }
i:=2;k:=0;
while k<(n div 2) do
begin
min:=a[i-1];imin:=i-1;
for j:=i-1 to n do
if a[j] c:=a[i];
a[i]:=a[imin];
a[imin]:=c;
i:=i+2;
k:=k+1;
end;
{ Вывод отсортированного массива }
for i:=1 to n do write(a[i],' ');
readln;
end.

7. Задача: определить номер минимального элемента заданного одномерного массива.

CODE

uses crt;
const
Len = 10
var
mas: array[1 .. Len] of integer;
min, n, i:integer;
begin
{ заполняем массив }
randomize;
for i:=1 to Len do mas[i]:=random(100);

{ собственно сортировка }
min:=mas[1]; {начальный минимальный эл-т}
for i := 1 to Len do begin
if min min:=mas[i];
n:=i;
end;
end;

{ В n содержится номер минимального элемента }
end.

Материал подготовил(и): AlaRic

8. Даны 10 вещественых чисел. Определить наибольшее из отрицательныхчисел, округлить его к ближайшему целому.

CODE

program desyat;
var
a:array[1..10] of real;
min:real;
i:integer;
begin
writeln('Ввести 10 чисел');
for i:=1 to 10 do read(a[i]);
min:=a[1];
for i:=2 to 10 do
if (min>a[i]) and (a[i]<0) then min:=a[i];
writeln('Ответ: ',round(min));
end.

9. Ввести два вещественых числа aи b. Найти остаток от деления aи b. Определить принадлежность остатка интервалу [0 .. 4].

CODE

program dva;
var q,a,b,c:real;
begin
writeln('Ввести A');
readln(a);
writeln('Ввести B');
readln(B);
c:=a/b;
q:=a-(b*trunc( c ));
if (q>=0) or (q<=4) then writeln('Принадлежит отрезку');
writeln('Остаток: ',q:3:1);
end.

10. Вводятся различные целые числа. Надо определить четные и нечетные.
Результат вывести на экран.

CODE

Program by_Deadly;
Uses crt;
Var
massiv:array[1..10] of longint;
x:byte;
Begin
for x:=1 to 10 do begin
write('massiv[',x,']:=? ');
readln(massiv[x]);
end;
ClrScr;
for x:=1 to 10 do begin
if odd(massiv[x])=true then
writeln('massiv[',x,']=',massiv[x],' - Нечетное число')
else writeln('massiv[',x,']=',massiv[x],' - Четное число');
end;
End.

11. Нужно преобразовать матрицу, осуществив поворот элементов вокруг ее центра на 90 градусов против часовой стрелки.

CODE

12. Задать двумерный массив n*n. Посчитать число элементов бОльших, мЕньших, равных нулю. Вывести исходный массив элементов в виде таблицы и результаты вычислений.

CODE

uses crt;
const
n=10;
var
mas:array[1..n,1..n] of integer;
i,j,max,min,nol:integer;
begin
randomize;
clrscr;
min:=0; max:=0; nol:=0;
for i:=1 to n do begin
for j:=1 to n do begin
mas[i,j]:=random(20)-10;
if mas[i,j]>0 then max:=max+1
else
if mas[i,j]<0 then min:=min+1
else nol:=nol+1;
write(mas[i,j],'|');
end;
writeln;
end;

writeln;
writeln('bolshe 0 - ',max);
writeln('menshe 0 - ',min);
writeln('ravnih 0 - ',nol);
end.

13. Как расположить элементы отсортированной матрицы в ввиде "улитки"?

CODE

Материал подготовил(и): AlaRic

Разбор задач:

14 . Даны натуральное число N и последовательность A1, A2, ... An, состоящая из N целых чисел. Получить последовательность, которая отличается от исходной тем, что все нечетные элементы удвоены. Оба массива вывести на экран.
15 . Даны натуральное число N и последовательность A1, A2, ... An. Определить количество вхождений N в данную последовательность (N – вводится с клавиатуры).
16 . Даны натуральное число N и последовательность A1, A2, ... An. Определить наименьшее положительное среди A1, A2, ... An и найти сумму отрицательных.
17 . Дана последовательность из 50 чисел. Найти их среднее арифметическое. Найти сколько среди них отличных от последнего числа.
18 . Дана последовательность из N вещественных чисел. Вычислить сумму тех элементов последовательности, номера которых совпадают со значениями элементов последовательности.
19 . Дана последовательность из N вещественных чисел. Все элементы последовательности с четными номерами, предшествующие первому по порядку элементу с наибольшим значением, домножить на него.
20 . Дана последовательность из N вещественных чисел. Найти номер первого вхождения данного числа в последовательность или вывести сообщение, что такого числа нет.

14 . Даны натуральное число N и последовательность A1, A2, ... An, состоящая из N целых чисел. Получить последовательность, которая отличается от исходной тем, что все нечетные элементы удвоены. Оба массива вывести на экран.

Код

program N1;
const n=10;
var
i:integer;
a:array[1..n] of integer;
begin
for i:=1 to n do begin
a[i]:=random(9)+1;write(a[i],' ');
end;

writeln;
for i:=1 to n do begin
if a[i] mod 2<>0 then a[i]:=a[i]*2;
write(a[i],' ');
end;
readln;
end.

15 . Даны натуральное число N и последовательность A1, A2, ... An. Определить количество вхождений N в данную последовательность (N – вводится с клавиатуры).

Код

program N2;
var
i,n,k:integer;
a:array[1..100] of integer;
begin
write('Input n (n<=100) -> ');readln(n);
k:=0;
for i:=1 to n do begin
write('-> '); readln(a[i]);
if a[i]=n then k:=k+1;
end;
write(k);
readln;
end.

16 . Даны натуральное число N и последовательность A1, A2, ... An. Определить наименьшее положительное среди A1, A2, ... An и найти сумму отрицательных.

Код

program N3;
const n=10;
var
i,min,S:integer;
a:array[1..n] of integer;
begin
S:=0;
for i:=1 to n do begin
a[i]:=random(10)-5;
write(a[i],' ');
end;
min:=32767;
for i:=1 to n do begin
if a[i]>0 then
if a[i] if a[i]<0 then S:=S+a[i];
end;
writeln;
writeln('Min pol -> ',min);
writeln('Summ otriz -> ',S);
readln;
end.

17 . Дана последовательность из 50 чисел. Найти их среднее арифметическое. Найти сколько среди них отличных от последнего числа

Код

program N4;
uses crt;
const n=10;
var a:array[1..n] of integer;
i,S,k:integer;
begin
ClrScr;
S:=0; k:=0;
for i:=1 to n do begin
a[i]:=random(10)+1;
write(' ',a[i]);
S:=S+a[i];
end;

for i:=1 to n-1 do
if a[i]<>a[n] then k:=k+1;
writeln;
writeln('Sred arifmet: ',(S/n):0:2);
writeln('Otl ot Poslednego: ',k);
readln;
end.

18 . Дана последовательность из N вещественных чисел. Вычислить сумму тех элементов последовательности, номера которых совпадают со значениями элементов последовательности.

Код

program N5;
const n=10;
var
i,k:integer;
a:array[1..n] of real;
begin
k:=0;
for i:=1 to n do begin
write('-> '); readln(a[i]);
end;

for i:=1 to n do
if a[i]=i then k:=k+1;
write('Otvet: ',k);
readln;
end.

19 . Дана последовательность из N вещественных чисел. Все элементы последовательности с четными номерами, предшествующие первому по порядку элементу с наибольшим значением, домножить на него.

Код

program N6;
const n=10;
var
a:array[1..n] of real;
i,k:integer;
max:real;
begin
for i:=1 to n do begin
a[i]:=random(9)+1;
write(a[i]:3:1,' ');
end;

for i:=1 to n do
if a[i]>max then begin
max:=a[i];k:=i;
end;

for i:=1 to k-1 do
if i mod 2=0 then a[i]:=a[i]*max;
writeln;
for i:=1 to n do write(a[i]:3:1,' ');
readln;
end.

20 . Дана последовательность из N вещественных чисел. Найти номер первого вхождения данного числа в последовательность или вывести сообщение, что такого числа нет.

Код

program N7;
const n=10;
var
a:array[1..n] of real;
i,k:integer;
r:real;
begin
k:=0;
write('Input r -> ');readln(r);
for i:=1 to n do begin
write('-> '); readln(a[i]);
end;

for i:=1 to n do
if a[i]=r then begin
k:=i; break;
end;

if k=0 then writeln('Net!')
else writeln('N: ',k);
readln;
end.

Материал взят с сайта Всё о Паскале

Комментарии:

(0) | Pascal & Delphi | 2006-06-01

Переборные алгоритмы

Материал подготовил(и): virt

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

1)задача о ферзях :
Условие :
на шахматной доске размера n*n расставить n ферзей так ,что-бы они не били друг друга.
Решение :
диагональ первого типа: [attachmentid=1960]
диагональ второго типа: [attachmentid=1961]

CODE

var up:array[2..16]of boolean; //признак занятости диагоналей первого типа
down:array[-7..7]of boolean; //признак занятости диагоналей второго типа
vert:array[1..8]of boolean; //признак занятости вертикали
ihor:array[1..8]of integer; //номер вертикали ,на которой стоит ферзь на каждой горизонтали
n:integer;

function d_hod(i,j:integer):boolean; //проверка на допустимость хода в позицию (i,j)
begin
d_hod:=vert[j] and up[i+j] and down[i-j];
end;

procedure hod(i,j:integer); //сделать ход
begin
ihor[i]:=j;
vert[j]:=false;
up[i+j]:=false;
down[i-j]:=false;
end;

procedure o_hod(i,j:integer); //отменить ход
begin
vert[j]:=true;
up[i+j]:=true;
down[i-j]:=true;
end;

Нахождение одного варианта расстановки :

CODE

procedure find_one(i:integer;var q:boolean);
var j:integer;
begin
j:=0;
repeat
inc(j);
q:=false;
if d_hod(i,j) then
begin
hod(i,j);
if i find_one(i+1,q);
if not q then o_hod(i,j);
end else q:=true;
end;
until q or (j=n);
end;

Нахождение всех рещений :

CODE

procedure print;
var i:integer;
begin
write(' ',s,' ');for i:=1 to n do write(ihor[i],' ');writeln;
end;

procedure find_all(i:integer);
var j:integer;
begin
if i<=n then
begin
for j:=1 to n do
if d_hod(i,j) then begin
hod(i,j);
find_all(i+1);
o_hod(i,j);
end;
end else
begin
inc(s);
print;
end;
end;

2)задача о шахматном коне :
Условие :
Найти количество всех вариантов обхода шахматной доски конем.
Решение :

CODE

program kon_in_nm_matr_full_variants;
const _maxnm=8;
dx:array[1..8]of integer=(-2,-1,1,2,2,1,-1,-2);
dy:array[1..8]of integer=(1,2,2,1,-1,-2,-2,-1);
var a:array[-1.._maxnm+2,-1.._maxnm+2]of integer;
n,m,i,j:integer;
t:longint;

procedure solve(x,y,l:integer);
var k,i,j:integer;
begin
a[x,y]:=l;
if l=n*m then inc(t) else
for k:=1 to 8 do
begin
i:=x+dx[k];j:=y+dy[k];
if a[i,j]=0 then solve(i,j,l+1);
end;
a[x,y]:=0;
end;

begin
readln(n,m);
for i:=-1 to n+2 do a[i,-1]:=-1;
for i:=-1 to n+2 do a[i,0]:=-1;
for i:=-1 to n+2 do a[i,m+1]:=-1;
for i:=-1 to n+2 do a[i,m+2]:=-1;
for j:=1 to m do a[-1,j]:=-1;
for j:=1 to m do a[0,j]:=-1;
for j:=1 to m do a[n+1,j]:=-1;
for j:=1 to m do a[n+2,j]:=-1;
for i:=1 to n do
for j:=1 to m do
a[i,j]:=0;
t:=0;
for i:=1 to n do
for j:=1 to m do
begin
solve(i,j,1);
end;
writeln(' ',t);
end.

Условие :
Найти один вариант обхода методом Варнсдорфа.
Суть метода : при обходе коня следует ставить на поле ,из которого он может сделать минимальное количество перемещений на еще не занятые поля.
Решение :

CODE

program kon_in_nm_matr_one_variant;
const _maxnm=8;
dx:array[1..8]of integer=(-2,-1,1,2,2,1,-1,-2);
dy:array[1..8]of integer=(1,2,2,1,-1,-2,-2,-1);
var a:array[-1.._maxnm+2,-1.._maxnm+2]of integer;
n,m,i,j:integer;

procedure solve(x,y,l:integer);
var w:array[1..8]of integer;
xn,yn,i,j,m1:integer;
begin
a[x,y]:=l;
if l=n*m then
begin
writeln;
for i:=1 to n do
begin
for j:=1 to m do write(a[i,j],' ');
writeln;
end;
halt;
end else
begin
for i:=1 to 8 do
begin
w[i]:=0;
xn:=x+dx[i];
yn:=y+dy[i];
if a[xn,yn]=0 then
begin
for j:=1 to 8 do
if a[xn+dx[j],yn+dy[j]]=0 then inc(w[i]);
end else w[i]:=-1;
end;
i:=1;
while i<=8 do
begin
m1:=1;
for j:=2 to 8 do
if w[j] if (w[m1]>=0) and (w[m1] solve(x+dx[m1],y+dy[m1],l+1);
w[m1]:=maxint;
inc(i);
end;
end;
a[x,y]:=0;
end;

begin
readln(n,m);
for i:=-1 to n+2 do a[i,-1]:=-1;
for i:=-1 to n+2 do a[i,0]:=-1;
for i:=-1 to n+2 do a[i,m+1]:=-1;
for i:=-1 to n+2 do a[i,m+2]:=-1;
for j:=1 to m do a[-1,j]:=-1;
for j:=1 to m do a[0,j]:=-1;
for j:=1 to m do a[n+1,j]:=-1;
for j:=1 to m do a[n+2,j]:=-1;
for i:=1 to n do
for j:=1 to m do
a[i,j]:=0;
for i:=1 to n do
for j:=1 to m do
begin
solve(i,j,1);
end;
end.

3)задача о лабиринте :
Условие :
Дано клеточное поле ,некоторые клетки заняты препятствиями. Найти количество путей от начальной точки до конечной.
Решение :

CODE

program labirint_way;
const _maxn=30;
dx:array[1..4]of integer=(1,0,-1,0);
dy:array[1..4]of integer=(0,1,0,-1);
var a:array[0.._maxn+1,0.._maxn+1]of integer;
xn,yn,xk,yk:integer;
i,j,n:integer;
t:longint;

procedure solve(x,y,k:integer);
var i:integer;
begin
a[x,y]:=k;
if (x=xk) and (y=yk) then inc(t) else
for i:=1 to 4 do
if a[x+dx[i],y+dy[i]]=0 then solve(x+dx[i],y+dy[i],k+1);
a[x,y]:=0;
end;

begin
fillchar(a,sizeof(a),1);
read(n);
for i:=1 to n do
for j:=1 to n do
read(a[i,j]);
readln(xn,yn,xk,yk);
t:=0;
solve(xn,yn,1);
writeln(t);
end.

4)задача о парламенте :
Условие :
На некотором демократическом острове каждый из жителей организовал партию которую и возглавил. В каждой партии кроме президента оказался еще как минимум один член. Составить самый малочисленный парламент ,в котором будут представлены члены всех партий.
Решение :

CODE

const maxn=150;
type zint=0..maxn+1;
zset=set of 0..maxn;
person=record
man:zint;
num_part:zint;
part:zset;
end;
var a:array[zint]of person;
n,mn,min,i:zint;
rwork,rbest:zset;

...........

procedure include(k:zint);
begin
rwork:=rwork+[a[k].man];
inc(mn);
end;

procedure exclude(k:zint);
begin
rwork:=rwork-[a[k].man];
dec(mn);
end;

procedure solve(k:zint;res,rt:zset);
var i:zint;
begin
if rt=[] then
begin
if mn begin
min:=mn;
rbest:=rwork;
end;
end else
begin
i:=k;
while i<=n do
begin
include(i);
solve(i+1,res+a[i].part,rt-a[i].part);
exclude(i);
inc(i);
end;
end;
end;

begin
init;
solve(1,[],[1..n]);
for i:=1 to n do
if i in rbest then write(i,' ');
end.

5)задача о рюкзаке :
Условие :
Дано - максимальный вес рюкзака . Дано n предметов имеющих свой вес и стоимость. Определить максимальную стоимость груза ,вес которого не превышает максимального веса рюкзака.
Решение :

CODE

program rukzak_perebor;
const maxn=20;{?}
var n,w:integer;
weight,price:array[1..maxn]of integer;
best,now:array[1..maxn]of integer;
maxprice:longint;

procedure init;
var i:integer;
begin
read(n);
read(w);
for i:=1 to n do read(weight[i]);
for i:=1 to n do read(price[i]);
end;

procedure rec(k,w:integer;st:longint);
var i:integer;
begin
if (k>n) and (st>maxprice) then
begin
best:=now;
maxprice:=st;
end else
if k<=n then
for i:=0 to w div weight[k] do
begin
now[k]:=i;
rec(k+1,w-i*weight[k],st+i*price[k]);
end;
end;

begin
init;
rec(1,w,0);
writeln(' ',maxprice);
end.

Материал подготовил(и): virt

6)задача о коммивояжёре :
Условие :
Имеется n городов расстояния между которыми заданы. Коммивояжеру необходимо выйти из какого-то города ,побывать во всех остальных n-1 городах точно по одному разу и вернуться в исходный город. Маршрут должен быть минимальным по длине.
Решение :

CODE

const maxv=100;
var a:array[1..maxv,1..maxv]of integer; //матрица расстояний между городами
b:array[1..maxv,1..maxv]of byte;
way,best:array[1..maxv]of byte;
nnew:array[1..maxv]of boolean; //был ли коммивояжер в данном городе
bestcost:integer;
n,i:integer;

....................
procedure sortlines; //сортируем каждую строку матрицы А по возрастанию
var k,i,j:integer; //расстояний. Однако сами элементы матрицы А не
w:integer; //переставляем ,а изменяем в матрице B номера столбцов
begin //матрицы А.
for i:=1 to n do
for j:=1 to n do
b[i,j]:=j;
for k:=1 to n do
for i:=1 to n-1 do
for j:=i+1 to n do
if a[k,b[k,i]]>a[k,b[k,j]] then
begin
w:=b[k,i];
b[k,i]:=b[k,j];
b[k,j]:=w;
end;
end;

CODE

procedure solve(v,count:byte;cost:integer); //основная процедура
var i:integer;
begin
if cost>bestcost then exit;
if count=n then
begin
cost:=cost+a[v,1];
way[n]:=v;
if cost begin
bestcost:=cost;
best:=way;
end;
exit;
end;
nnew[v]:=false;
way[count]:=v;
for i:=1 to n do
if nnew[b[v,i]] then solve(b[v,i],count+1,cost+a[v,b[v,i]]);
nnew[v]:=true;
end;

begin
init;
sortlines;
solve(1,1,0);
writeln(bestcost:4); //вывод результата
for i:=1 to n do write(best[i],' ');writeln;
end.

Материал взят с сайта Всё о Паскале

Комментарии:

(0) | Pascal & Delphi | 2006-06-01

Решение уравнений различных степеней

Материал подготовил(и): volvo

Очень часто при решении задач необходимо находить корни уравнений различных порядков (квадратных, кубических и т.д.) Вместо того, чтобы писать свое решение этой задачи, можно воспользоваться функциями, которые содержатся в присоединенном модуле Equation:

Код

Function solveQuadratic(Var x, y: Array Of Double): Byte;

Решение квадратного уравнения вида:

QUOTE

x[0] * x^2 + x[1] * x + x[2] = 0

Результат, возвращаемый функцией - количество действительных корней (cами корни возвращаются в y[0], y[1]).

Пример использования:

CODE

{$n+}
Uses Equation;
Const
ax: Array[0 .. 2] Of Double =
(24, -50, 25 );
Var
ay: array[0 .. 2] Of Float;
roots, i: Integer;

Begin
roots := solveQuadratic(ax, ay);
Writeln( 'number of roots = ', roots );
For i := 0 To Pred(roots) Do
WriteLn( 'root #', i + 1, ' = ', ay[i]:10:5 );
End.

Код

Function solveCubic(Var x, y: Array Of Double): Byte;

Решение кубического уравнения:

QUOTE

x[0] * x^3 + x[1] * x^2 + x[2] * x + x[3] = 0

Результат, возвращаемый функцией - количество действительных корней (сами корни возвращаются в y[0], y[1], y[2]).

Пример использования:

CODE

{$n+}
Uses Equation;
Const
ax: Array[0 .. 3] Of Float =
(1, 0, -9, 4 );
Var
ay: array[0 .. 3] Of Float;
roots, i: Integer;

Begin
roots := solveCubic(ax, ay);
Writeln( 'number of roots = ', roots );
For i := 0 To Pred(roots) Do
WriteLn( 'root #', i + 1, ' = ', ay[i]:10:5 );
End.

Для решения уравнений 4-ой степени применяются 2 функции

Решение алгебраическим методом (метод Феррари)

Код
```
Function solveQuarticAlgebra(Var x, results: Array Of Double): Byte;
```
Решение по методу Виета (предпочтительно)

Код
```
Function solveQuarticVieta(Var x, results: Array Of Double): Byte;
```

Также в модуль включена функция:

Код

Function PolySolve(Const order: Integer;

         Var coeffs, roots: Array Of Double): Integer;

позволяющая решать алгебраические уравнения практически любого порядка (порядок задается константой maxOrder, и изначально установлен равным 12) при помощи последовательности Штурма.

Пример использования (решение уравнения 4-ой степени сначала методом Vieta, а затем - методом Штурма):

CODE

{$n+}
Uses Equation;
Const
Order = 4;
coeffs: Array[0 .. Order] Of Double = (
1, 0, -25, 60, -36
);

Var
roots: array[0 .. maxOrder] Of Double;
nroots, i: Integer;

begin

WriteLn('Vieta method :');
nroots := solveQuarticVieta(coeffs, roots);
{ nroots := solveQuarticAlgebra(coeffs, roots); }
Writeln( 'number of roots = ', nroots );
For i := 0 To Pred(nroots) Do
WriteLn( 'root #', i + 1, ' = ', roots[i]:7:4 );

WriteLn;

WriteLn('Sturm sequence method :');
nroots := PolySolve(Order, coeffs, roots);

If nroots = 0 Then Begin
WriteLn('solve: no real roots'); Halt(0)
End
Else Begin
WriteLn(nroots, ' distinct real root(s) for x: ');
For i := 0 To Pred(nroots) Do
WriteLn('root #', i + 1, ' = ', roots[i]:7:4);
End;

end.

Материал взят с сайта Всё о Паскале

Комментарии:

(0) | Pascal & Delphi | 2006-06-01

Нахождение центра окружности

Материал подготовил(и): Altair

Задача:
Найти центр описанной окружности возле произвольного многоугольника.
Дано:
Произвольный n-угольник.
Координаты вершин.
Требуется:
Координаты центра описанной окружности.
При:
Количество углов 2 Не указанно, что многоугольник выпуклый.
Указание:
Счиать описанной окружностью, окружность с наименьшим радиусом, в которую "поместиться" (наложением) многоугольник.

Материал подготовил(и): Altair

1 решение.

Суть алгоритма:
искомая точка обладает следующим свойством - максимальное расстояние от нее до вершин многоугольника минимально! Вот программа под FPC, запускаем, тыкаем мышью, где разместить точки, нажимаем ENTER когда все точки ввели, прога подумает с 2 секунды и нарисует окружность.

Вот код, а сама прога в присоединенном архиве

Код

{$MODE OBJFPC}
{$APPTYPE GUI}
{$E+}
{$E+}
Uses GraphiX, GXCRT, GXMouse, GX2D;
Type
Telem=record
X, Y:longint;
end;
ArrType = array[1..100] of telem;

Function MaxR(TX,TY:longint; A:arrType; n:word):Extended;
var
R:Extended;
i:longint;
Begin
r:=0;
for i:=1 to n do begin
If r r:=SQRT(SQR(a[i].X-TX)+SQR(a[i].y-ty));
end;
Result:=R;
end;

Var
Arr:ArrType;
Tx,Ty,n,i,j,TSuperX,SuperY:longint;
EnterB:boolean; NK:byte; TRR:Extended;
Begin
InitGraphix(ig_detect,ig_col16); {Инициализация графической системы}

{установка графического режима - 1024*768 16 битный цвет}
SetModeGraphix(1024,768,ig_col16);
Bar(0,0,1024,768,rgbcolorRgb(0,0,0)); {заливаем экран черной краской}

{инициализируем мышь и включаем отображение указателя}
InitMouse; MouseON;
EnterB:=false;
n:=0;

{пока не нажата клавиша ENTER}
While not EnterB do begin
Repeat {ждем нажатия клавиши или мыши}
Until (KeyPressed) or (IsMouseInArea(0,0,1024,768)>128);

If keypressed then begin
NK:=ord(readkey);
If NK=13 then EnterB:=true
end
else begin
inc(N);
MouseCoords(Tx,Ty); {получаем координаты курсора}
delay(100); {задержка что бы не было мерцания указателя}
MouseOFF; {выключаем указатель}
putPixel(Tx,Ty,rgbcolorrgb(255,255,255)); {рисуем белую точку}
MouseOn; {сключаем мышь}
arr[n].X:=Tx; {сохраняем в массви координаты точки}
arr[n].Y:=Ty;
end
end;
TRR:=MaxR(1,1,arr,n);

{поиск точки, максимальное расстояние до остальных в которой минимально}
For i:=1 to 1024 do
For j:=1 to 768 do begin
If MaxR(i,j,Arr,n) SuperX:=i; SuperY:=j; TRR:=MaxR(i,j,Arr,n)
end;
end;
MouseOff;
circle(SuperX,SuperY,Trunc(MaxR(SuperX,SuperY,Arr,N)),
rgbcolorrgb(1,118,156));
mouseon;
readkey; {ожидаем нажатия клавиши}
end.

Материал подготовил(и): volvo

2 решение.

Вот мое решение задачи (программа написана под Delphi), но по несколько другому алгоритму:

Вначале по-прежнему ищем пару максимально удаленных друг от друга точек.
( назовем найденные точки А и В )
А теперь находим точку, максимально удаленную от центра отрезка АВ (Естественно, сами точки А и В исключаются из поиска).
Найденную точку назовем С.
Тривиальная задача о построении окружности по трем точкам...

Запускаем ЕХЕ, мышкой выбираем положение точек (до 100), меню File -> Start , получаем окружность. После отрисовки окружности не рекомендуется добавлять точки и запускать алгоритм снова - лучше перезапустить программу...

Материал взят с сайта Всё о Паскале

Комментарии:

(0) | Pascal & Delphi | 2006-06-01

Динамические массивы и матрицы

Материал подготовил(и): Altair

Модуль для работы с динамическими массивами.
Модуль позволяет работать с массивами с динамической длинной

Constructor INIT;
Инициализирует массив. Требуется запустить лишь один раз - в начале работы с массивом, но после определения начальной длины

Procedure SetSizeArray(_Size:word);
Устанавливает длинну массива равную _Size. При первом запуске, после нее требуется запустить конструктор.

Function GetSizeArray:Word;
Возвращает текущую длинну массива. Лучше использовать ее и не открывать доступ к переменной sizeofarray, т.к. последствия могут быть непредсказуемые.

Procedure EnteringArray(visible:Byte;VideoMode:Byte);
Процедура ввода массива.
Не очень надежна, т.к. нет поддержки backspace, но зато возможен ввод в графическом режиме и возможно управлять отображением вводимых чисел. (Для вывода, скажем звездочек вместо вводимых символов, ставим параметр visible=<код звездочки>
Videomode может иметь RText или RGraph - соответственно ввод в текстовом и ввод в графическом режиме.
Внимание: если тип режима указан неверно, произойдет ошибка периода исполнения.

Procedure PrintCRTarray(Videomode:byte);
Вывод на экран массива. Возможны 2 режима как и у метода для ввода массива.

Procedure QSort(left,right:integer);
Быстрая сортировка массива.

Procedure HSort;
Пирамидальная сортировка массива. Полезна если вы уверены что массив почти или полностью отсортирован.

Function GetMaxElem:Telem;
Возвращает максимальный элемент массива.

Function GetMinElem:Telem;
Возвращает мимнимальный элемент массива.

Function GetNumMaxElem:Word;
Возвращает номер максимального элемента в массиве. (Первого, если таких элементов несколько)

Function GetNumMinElem:Word;
Возвращает номер минимального элемента.

Function ElemInArray(T:Telem):Word;
Проверяет вхождение элемента в массив. 0 - если не найдено, иначе индекс элемента.

Procedure InvertArray;
Инвертирует массив.

Вот программа демонстрирующая возможности модуля.

Код

Program TEST_UNIT_ARRAYS;

Uses CRT,Arrays;

var

 a:TArrayWork;

 i,c:integer;

 dlinna:word;

 poisk:Telem;

begin

 CLRSCR;

 Writeln('Введите длинну:');

 readln(dlinna);

 a.SetSizeArray(dlinna);

 a.Init; {теперь можно работать}

 writeln;

 a.EnteringArray(RealkeyV,RText);

 writeln('Введенный массив:');

 A.PrintCRTArray(RText);

 writeln;

 a.hsort;

 writeln('Отсортированный массив:');

 a.printcrtarray(RText);

 writeln; writeln('Инвертированный:');

 a.InvertArray;

 a.printcrtarray(rtext);

 writeln;

 writeln('максимальный элемент: ',a.GetMaxElem);

 Writeln('минимальный элемент: ',a.GetMinElem);

 writeln('Номер Макс. элемента: ',a.getnummaxelem);

 writeln('номер минимального элемента :',a.getnumminelem);

 write('введите искомый элемент: '); readln(Poisk);

 if a.eleminarray(poisk)=0 then

   writeln('не найден!') else

   Writeln('номер искомого элемента: ',a.eleminarray(poisk));



 write('Введите новую длинну: ');readln(dlinna);

 If dlinna<=a.GetSizeArray then a.SetSizeArray(dlinna) else

 begin

  a.setsizearray(dlinna);

  {a.init;}

 end;

 writeln('Элементы массива: ');

 a.printcrtarray(rtext);

 readln(a.arr^[dlinna-1]);

 a.printcrtarray(rtext);

end.

В присоединенном файле сам модуль. (исходник).

ЗЫ: при реализации динамического массива, использовался алгоритм, предложенный volvo

Материал подготовил(и): volvo

Работа с динамическими массивами
Для того, чтобы работать с динамическими массивами, необходимо перед началом работы выделить память под такой массив, а после использования массива - освободить выделенную память:
[PASCODE]{
Обязательно отключить проверку индексов,
иначе возникнет ошибка времени исполнения
}
{$R-}
Type
TType = Integer; { Или любой другой тип }

{ Указатель на динамический массив }
PDynArray = ^TDynArray;
TDynArray = array[1 .. 1] of TType;

Var
{ Через эту переменную будет осуществляться вся работа с массивом }
arr: PDynArray;

n, i: integer;

Begin
Write('n = '); ReadLn(n); { Вводится размер массива }

{
В "куче" запрашивается блок памяти с размером,
достаточным для хранения N элементов типа TType
}
GetMem(arr, n * SizeOf(TType));

(*** Начало работы с массивом ***)

{
Обращение к элементу динамического массива - почти такое же,
как и к элементу обычного (статического) массива,
за исключением операции "^" - разыменования ...

Пример:
}
For i := 1 To n Do arr^[i] := 2 * i;

For i := 1 To n Do
Write(arr^[i]:4);

(*** Закончили работу с массивом - уничтожаем его ***)

{ Возвращаем память назад в "кучу" }
FreeMem(arr, n * SizeOf(TType));
End.[/PASCODE]

Еще один модуль для работы с динамическими массивами (ООП).
Модуль позволяет работать с массивами с переменной длиной (допускается создание массивов, использующих любые типы данных - встроенные типы Паскаля, перечисления и записи - в качестве базового типа).
Дополнительная информация

Использование процедур и функций модуля:

Constructor Init(sz: Word);
Инициализирует массив. Требуется запустить его лишь один раз - в начале работы с массивом.
Destructor Done;
Удаляет массив. Вызывается по окончании работы с массивом для освобождения динамической памяти.
Procedure Resize(sz: Word);
Процедура для увеличения размера массива (новый размер определяется значением sz). Если sz < текущей длины массива, размер меняться не будет. После изменения размера все предыдущие значения остаются на своих местах, новые - заполняются нулями.
Function GetSize: Word;
Возвращает текущую длину массива. Используется для упрятывания переменной SizeOfArray, т.к. последствия доступа к SizeOfArray напрямую могут быть непредсказуемые.
Function Get(i: Word): PTType;
Функция, возвращающая адрес i-го элемента массива. Если значение i > максимальной длины массива, возвращается nil.
Procedure Put(i: Word; T: TType);
Процедура для записи элемента T в i-ю позицию массива. Если значение i > максимальной длины массива, никаких действий не производится.
Function Input(n: Integer; s: String): Integer;
Процедура ввода первых N элементов массива. S - имя текстового файла, из которого нужно прочитать эти элементы.
Для ввода с клавиатуры пользуемся std_in. Функция возвращает (-1) если файла с указанным именем не существует.
Function Print(s: String): Integer;
Функция выводит массив в текстовый файл. S - имя файла, в который будет осуществляться вывод. Для вывода на экран пользуемся std_out. Функция возвращает (-1) если не может создать файл с указанным именем.
Procedure qSort(Left,Right:integer);
Быстрая сортировка массива.
Procedure hSort;
Пирамидальная сортировка массива. Полезна если Вы уверены что массив почти или полностью отсортирован.
Function max: PTType;
Возвращает указатель на максимальный элемент массива.
Function min: PTType;
Возвращает указатель на минимальный элемент массива.
Function maxIndex: Word;
Возвращает индекс максимального элемента в массиве. (Если элементов с таким значением несколько - возвращается первый из них)
Function minIndex: Word;
Возвращает индекс минимального элемента в массиве. (Если элементов с таким значением несколько - возвращается первый из них)
Function IndexOf(T: TType): Word;
Проверяет вхождение элемента T в массив. Возвращает 0, если элемент не был найден, иначе возвращается индекс элемента.
Procedure Invert;
Инвертирует массив.
Function Concat(Var a: TArray): Boolean;
Используется для "слияния" двух динамических массивов. Возвращает True в случае успеха. Иначе - False.
Внимание !!! При успешном завершении Concat массив, передаваемый как параметр А удаляется.

Ниже приведена программа, демонстрирующая основные возможности модуля.

Код

Program TestArray;

Uses CRT, DynArr;





Var

  inArr, secondArr: TArray;



begin

  ClrScr;



  inArr.Init(6);

  WriteLn('Enter 6 Integers');



  inArr.Input(6, StdIn);

  inArr.Print(StdOut);



  inArr.hSort;

  inArr.Print(StdOut);



  secondArr.Init(8);

  WriteLn('Enter 8 Integers');

  secondArr.Input(8, StdIn);



  secondArr.Concat(inArr);

  secondArr.Print(StdOut);

  secondArr.hSort;

  secondArr.Print(StdOut);



  secondArr.Done;



end.

Исходники модуля вместе с текстовой программой:
[attachmentid=1632] Скачать: [attachmentid=1630]

Данный модуль можно адаптировать для работы с любым встроеннымтипом данных Турбо Паскаля. Все, что потребуется изменить - это:

Код

Type TType = Integer; { изменить на название другого типа}

Код

Procedure _print_(Var f: Text; Var T: TType);

{

  Изменить на процедуру, выводящую переменную

  заданного типа в текстовый фаил

}

Begin

  Write(f, T)

End;

Procedure _input_(Var f: Text; Var T: TType);

{

  Изменить на процедуру, вводящую переменную

  заданного типа из текстового файла

}

Begin

  ReadLn(f, T)

End;

Для работы с пользовательскими типами можно использовать вот этот модуль, (который несколько отличается от приведенного выше):
[attachmentid=1633] Скачать: [attachmentid=1631]

В нем содержатся тип и функция сравнения переменных пользовательского типа (т.к. основной сложностью и является то, что для типов, НЕопределенных в языке отсутствуют операции сравнения):

Код

{ Допустим, тип пользователя выглядит так: }

Type

  TRec = Record

    X, Y: Integer;

  End;



Type

  {

    Определяем, каким может быть результат сравнения

    двух переменных такого типа:

  }

  cmType = (cmLow, cmEqual, cmHigh);



const { Для удобства дальнейшей работы }

  cmLowEq = [cmLow, cmEqual];

  cmHighEq = [cmHigh, cmEqual];

{

  И сама функция сравнения, которая возвращает:

  cmHigh (A > B), cmLow (A < B) и cmEqual (A = B)

}

Function _compare_(a, b: TType): cmtype;

(*

  Пример функции для типа TRec (допустим, что нужно

  сравнить записи только по значению первого поля)

*)

begin

  _compare_ := cmEqual;

  if a.X > b.X then _compare_ := cmHigh

  else if a.X < b.X then _compare_ := cmLow

end;

ВСЕ операции сравнения, в которых участвуют переменные типа TType заменены на вызовы функции _compare_, т.е.

Код

If arr^[i] > arr^[max_ix] ...

{ Заменено на: }

If _compare_(arr^[i], arr^[max_ix]) = cmHigh ...



(* также как *)

While (arr^[l] <= B) ...

{ заменено на: }

While (_compare_(arr^[l], B) In cmLowEq) ...

Ну и , естественно, при смене типа TType не забываем изменять процедуры _print_ и _input_, как и для модуля, приведенного выше...

Материал подготовил(и): volvo

Работа с динамическими матрицами
Для того, чтобы работать с динамическими матрицами, проще всего представить матрицу, как массив векторов (массив, содержащий указатели на строки матрицы). Перед началом работы с такой матрицей нужно сначала выделить память под массив указателей на строки, и только потом выделять память для хранения самих данных. После использования матрицы выделенная память освобождается в обратной последовательности:

[PASCODE]{
Обязательно отключить проверку индексов,
иначе возникнет ошибка времени исполнения
}
{$R-}
Type
TType = Word; { Или любой другой тип }
Type
PVector = ^TVector;
{ Это - одна "строка" динамической матрицы }
TVector = Array[1 .. 1] of TType;

PDynMatrix = ^TDynMatrix;
{ Сама матрица - представляется как массив указателей на "строки" }
TDynMatrix = Array[1 .. 1] of PVector;

Var
{ Через эту переменную будет осуществляться вся работа с матрицей }
mxDynamic: PDynMatrix;
n, i, j: Word;
Begin
Write('n = '); ReadLn(n);

{ Выделяем память под указатели на "строки" }
GetMem(mxDynamic, n * SizeOf(PVector));
{ И для каждой "строки" - выделяем память для хранения данных }
For i := 1 To n Do
GetMem(mxDynamic^[i], n * SizeOf(TType));

(*** Работаем с матрицей ***)
{
Динамическая матрица представлена немного иначе,
чем динамический массив, поэтому для того, чтобы обратиться
к ее элементу, необходимы 2 операции разыменования указателей.
Пример:
}
For i := 1 To n Do { Строки }
For j := 1 To n Do { Столбцы (элементы строки) }
mxDynamic^[I]^[J]:=I*J;

For i := 1 To n Do Begin
WriteLn;
For j := 1 To n Do
Write(mxDynamic^[I]^[J]:4);
End;

(*** Закончили работу с матрицей - уничтожаем ее ***)

{ Освобождаем память в обратном порядке: }
{ Сначала - удаляем все "строки" }
For i := 1 To n Do
FreeMem(mxDynamic^[i], n * SizeOf(TType));
{ А теперь и указатели на них ... }
FreeMem(mxDynamic, n * SizeOf(PVector));
End.[/PASCODE]

Модуль для работы с динамическими матрицами

В этом модуле для работы с матрицами вводится тип:

CODE

Type
TType = Double;
PTRows = ^TRows;
TRows = Array[1 .. (2 * maxInt) Div SizeOf(TType)] Of TType;

PTCol = ^TCol;
TCol = Array[1 .. (2 * maxInt) Div SizeOf(PTRows)] Of PTRows;

PTMatrix = ^TMatrix;
TMatrix =
Record
nRow, nCol: Integer;
matrix: PTCol;
End;

При таком представлении матрицы к каждому ее элементу нельзя обращаться как к элементу обычного двумерного массива (т.е. так: arr[i, j] := 0). Для того, чтобы работать с TMatrix нужно изменить вызов на: arr.matrix^[i]^[j] := 0.
Поля nRow, nCol содержат количество строк и столбцов соответственно.

Прилагаемый модуль содержит основные функции для работы с матрицами:

Function mxO(size: Integer): PTMatrix;
Создание в динамической памяти "нулевой" матрицы, т.е. такой, что:
A+O = O+A = A

Function mxE(size: Integer): PTMatrix;
Создание в динамической памяти "единичной" матрицы (элементы главной диагонали равны единице, все остальные - нули), т.е. такой, что:
A*E = E*A = A

Function mxCreate(pRows, pCols: Integer): PTMatrix;
Функция возвращает указатель на созданную в динамической памяти матрицу (или nil при невозможности выделения памяти)

Procedure mxDispose(Var p: PTMatrix);
Процедура освобождает динамическую память, занятую матрицей p^, и устанавливает значение p в nil.

Procedure mxInput(Var a: TMatrix);
Процедура поэлементно вводит с клавиатуры матрицу, переданную ей в качестве параметра.

Procedure mxPrint(a: TMatrix);
Процедура выводит на экран матрицу, переданную ей в качестве параметра.

Function matrixAdd(a, b: TMatrix): PTMatrix;
Функция возвращает указатель на созданную в динамической памяти матрицу, являющуюся суммой матриц a и b, передаваемых как параметры (или nil при невозможности выделения памяти или при несоответствии размеров матриц A и B)
Function matrixSub(a, b: TMatrix): PTMatrix;
Функция аналогична matrixAdd, но возвращает разность матриц A и B

Function matrixMult(a, b: TMatrix): PTMatrix;
Функция возвращает указатель на созданную в динамической памяти матрицу, являющуюся произведением матриц a и b, передаваемых как параметры (или nil при невозможности выделения памяти или если матрицы a и b не являются "сцепленными", т.е. число столбцов A не равно числу строк B)

Function matrixScale(a: TMatrix; f: Double): PTMatrix;
Функция возвращает указатель на созданную в динамической памяти матрицу, являющуюся произведением матрицы A на число f (или nil при невозможности выделения памяти)

Function matrixDet(a: TMatrix): Double;
Возвращает значение определителя квадратной матрицы A (при передаче матрицы, не являющейся квадратной, функция вернет 0)

Function matrixEqual(a, b: TMatrix): Boolean;
Функция поэлементного сравнения матриц. Если матрицы имеют разный размер или не эквивалентны, функция возвращает False.

Function matrixTranspose(a: TMatrix): PTMatrix;
Функция возвращает указатель на созданную в динамической памяти матрицу, являющуюся транспонированной матрицей A, т.е. строки исходной матрицы становятся столбцами и наоборот (или nil при невозможности выделения памяти)

Function matrixInvert(a: TMatrix; Var multBy: Double): PTMatrix;
Функция возвращает указатель на созданную в динамической памяти матрицу, являющуюся инверсной (обратной) по отношению к A, то есть матрицей, результатом умножения которой на A является единичная матрица (или nil при невозможности выделения памяти).
(В переменной multBy возвращается значение 1/det(A))

Пример использования модуля:

CODE

Uses crt, matrixUnit;

Const
size = 3;

Var
mxCheck, mxA, invA: PTMatrix;
mx1, mx2: PTMatrix;

i, j: integer;
ToMult: Double;
Begin
clrscr;
{ Проверка умножения матриц }
mx1 := mxCreate(2, 3);
mxInput(mx1^); mxPrint(mx1^);
mx2 := mxCreate(3, 3);
mxInput(mx2^); mxPrint(mx2^);

mxCheck := matrixMult(mx1^, mx2^);
mxPrint(mxCheck^);

{ Проверка создания обратной матрицы }
mxA := mxCreate(size, size);
mxInput(mxA^); mxPrint(mxA^);

invA := matrixInvert(mxA^, ToMult);
WriteLn(ToMult:5:2);
mxPrint(invA^);

{ Не забываем освобождать память }
mxDispose(invA);
mxDispose(mxA);
mxDispose(mxCheck);

mxDispose(mx2);
mxDispose(mx1)
End.

Материал взят с сайта Всё о Паскале

Комментарии:

(0) | Pascal & Delphi | 2006-06-01

Страница 1 из 212 »

Поиск :

На форуме :

Друзья :

Опросы :

Получается ли у вас скачивать книги с нашего сервера?

Да, получается
Нет, с ошибками

Результаты опроса Все опросы

Сейчас на сайте :

0 пользователей, 33 гостей :