Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.05.2012, 22:02   #1
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
Сообщение Объединить подпрограммы

Код:
program one;
uses crt;
type mat = array [1..3,1..3] of integer;
Var a:mat;
    det,i,j,d:integer;

function detr(a:mat):integer;
var p1,p2:integer;
begin
p1:=a[1,1]*a[2,2]*a[3,3]+a[1,2]*a[2,3]*a[3,1]+a[2,1]*a[3,2]*a[1,3];
p2:=a[1,3]*a[2,2]*a[3,1]+a[1,2]*a[2,1]*a[3,3]+a[2,3]*a[3,2]*a[1,1];
detr:=p1-p2;
end;

begin clrscr;
for i:=1 to 3 do
for j:=1 to 3 do
begin
write('vvedite a[', i, ',', j, ']=');
readln(a[i,j]);
end;
for i:=1 to 3 do 
begin
writeln;
for j:=1 to 3 do
write(a[i,j]:6);
end;
det:=detr(a);
writeln;
writeln('det=',det);
readln;
end.
Код:
Program two;
uses crt;
type mat = array[1..10,1..10] of integer;
var a:mat;
i,j,m,n:integer;

procedure input(mo,no:integer; var b:mat);
begin
for i:=1 to mo do
for j:=1 to no do
begin
write('vvedite a[', i, ',', j, ']: ');
read(b[i,j]);
end;
end;

procedure sort(mo,no:integer; var b:mat);
var g,im,jm,min:integer;
begin
if mo>=no then
g:=no
else
g:=mo;
for i := 1 to g do
for j := i to i do
begin
min:=b[i,j];
for im := i to g do
for jm := im to im do
if abs(min) > abs(b[im,jm]) then
begin
min := b[im,jm];
b[im,jm] := b[i,j];
b[i,j] := min;
end;
end;
end;

procedure output(mo,no:integer; b:mat);
begin
for i:=1 to mo do
begin
writeln;
for j:=1 to no do
write(b[i,j]:6);
end;
end;

begin
clrscr;
writeln('vvedite razmernost m,n');
read(m,n);
input(m,n,a);
readln;
output(m,n,a);
sort(m,n,a);
writeln;
output(m,n,a);
writeln;
end.
Код:
program three;
Uses crt;
var tg, x: real;

function tang(x: real):real;
begin
tang:=(exp(x)-exp(-x))/(exp(x)+exp(-x));
end;

begin clrscr;
write('x= ');
readln(x);
tg:=tang(x);
writeln('tg(x)= ',tg:2:2);
readln
end.
Код:
program four;
Uses crt;
const
e=0.001;
var x, s: real;

function tab(x:real):real;
var t, n, c, s: real;
begin
if x < 0.5 then begin
s := 0;
n := 0;
c := 1;
t := 1;
while (t / c) > e do
begin
n := n + 1;
s := s + t / c;
t := t * sqr(x);
c := 4 * n + 1;
end;
tab := s * (sqr(x) + 3 * x + 4)/ (5 * x + 1);
end
else
begin
s := 0;
n := 1;
t := x;
while n <= 10 do
begin
s := s + t / n;
t := t * x;
n := n + 1;
end;
tab := s * x / 3;
end;
end;

begin Clrscr;
x:=-1;
while x<=1 do
begin
s:=tab(x);
writeln('x= ',x:2:1,' y=: ', s:2:3);
x:=x+0.1;
end;
end.
Camelot_2012 вне форума Ответить с цитированием
Старый 04.05.2012, 15:19   #2
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию

Правильно?
Код:
program zadacha_10_3;
uses crt;

procedure zadacha_10_3_1;
type mat = array[1..3,1..3] of integer;
var a:mat;
    det,i,j:integer;

procedure vvod(var  b:mat);
var i,j:integer;
begin
for i:=1 to 3 do
for j:=1 to 3 do
begin
write('vvedite b[', i, ',', j, ']: ');
read(b[i,j]);
end;
end;

procedure vivod(var  b:mat);
var i,j:integer;
begin
for i:=1 to 3 do
begin
writeln;
for j:=1 to 3 do
write(b[i,j],' ');
end;
end;

function detr(b:mat):integer;
var p1,p2:integer;
begin
p1:=b[1,1]*b[2,2]*b[3,3]+b[1,2]*b[2,3]*b[3,1]+b[2,1]*b[3,2]*b[1,3];
p2:=b[1,3]*b[2,2]*b[3,1]+b[1,2]*b[2,1]*b[3,3]+b[2,3]*b[3,2]*b[1,1];
detr:=p1-p2;
end;

begin
vvod(a);
writeln;
vivod(a);
writeln;
writeln;
det:=detr(a);
writeln('det=',det);
readln;
end;

procedure zadacha_10_3_2;
type mat = array[1..10,1..10] of integer;
var a:mat;
i,j,m,n:integer;

procedure input(mo,no:integer; var b:mat);
var i,j:integer;
begin
for i:=1 to mo do
for j:=1 to no do
begin
write('vvedite a[', i, ',', j, ']: ');
read(b[i,j]);
end;
end;

procedure sort(mo,no:integer; var b:mat);
var g,im,jm,min,i,j:integer;
begin
if mo>=no then
g:=no
else
g:=mo;
for i := 1 to g do
for j := i to i do
begin
min:=b[i,j];
for im := i to g do
for jm := im to im do
if abs(min) > abs(b[im,jm]) then
begin
min := b[im,jm];
b[im,jm] := b[i,j];
b[i,j] := min;
end;
end;
end;

procedure output(mo,no:integer; b:mat);
var i,j:integer;
begin
for i:=1 to mo do
begin
writeln;
for j:=1 to no do
write(b[i,j]:6);
end;
end;

begin
writeln;
writeln('vvedite razmernost m,n');
read(m,n);
input(m,n,a);
readln;
output(m,n,a);
sort(m,n,a);
writeln;
output(m,n,a);
writeln;
end;


procedure zadacha_10_3_3;
var tg, x: real;

function tang(x: real):real;
begin
tang:=(exp(x)-exp(-x))/(exp(x)+exp(-x));
end;

begin
writeln;
write('x= ');
readln(x);
tg:=tang(x);
writeln('tg(x)= ',tg:2:2);
readln
end;

procedure zadacha_10_3_4;
const
e=0.001;
var x, s: real;

function tab(x:real):real;
var t, n, c, s: real;
begin
if x < 0.5 then begin
s := 0;
n := 0;
c := 1;
t := 1;
while (t / c) > e do
begin
n := n + 1;
s := s + t / c;
t := t * sqr(x);
c := 4 * n + 1;
end;
tab := s * (sqr(x) + 3 * x + 4)/ (5 * x + 1);
end
else
begin
s := 0;
n := 1;
t := x;
while n <= 10 do
begin
s := s + t / n;
t := t * x;
n := n + 1;
end;
tab := s * x / 3;
end;
end;

begin
x:=-1;
while x<=1 do
begin
s:=tab(x);
writeln('x= ',x:1:1,' y=: ', s:1:3);
x:=x+0.1;
end;
readln;
end;

begin clrscr;
    zadacha_10_3_1;
    zadacha_10_3_2;
    zadacha_10_3_3;
    zadacha_10_3_4;
end.

Последний раз редактировалось Camelot_2012; 04.05.2012 в 15:22.
Camelot_2012 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Объединить программы в подпрограммы(использование procedure) и нарисовать блок схему. Camelot_2012 Паскаль, Turbo Pascal, PascalABC.NET 7 16.04.2012 22:31
Объединить 2 списка mazzahaker Помощь студентам 0 10.04.2012 15:09
Объединить 2 макроса в 1 1134 Microsoft Office Excel 5 07.07.2010 16:09
Подпрограммы-процедуры, подпрограммы-функции в Pascal rishikesh Помощь студентам 19 18.05.2010 23:05
Объединить списки levandowskiy Общие вопросы C/C++ 1 22.08.2009 12:09