» Парочка задачек на Turbo Pascal'е

red2003
Если целочисленный, то исправь real на integer.

Вот тебе вторая задачка:

program test2;

function f(const x:real):real;
begin
f:=cos (x-exp(x));
end;

procedure root(const a0,b0,tol:real;var _root:real);
var a,b,c,delta:real;
{ a0 < b0 !!! and root exists}
begin
a:=a0;
b:=b0;
repeat
c:=(a+b)/2;
if (f(a)*f(c))<0 then
b:=c
else
a:=c;
delta:=abs(f(c));
until (delta<tol);
_root:=c;
end;


{main}
var x,a,b,tol:real;
begin
tol:=1e-06;
a:=0;
b:=2;
root(a,b,tol,x);
writeln ('root=',x);
end.

Только если будешь подставлять другие функции убедись, что они на заданном промежутке имеют 1 корень и переменная a содержит левый конец интервала, а переменная b -- правый конец интервала. В противном случае у тебя программа зависнет.
(т.е. можно написать умную прогу, но, по-моему, это не требуется)

Добавлено
red2003


Цитата:

положительного массива Х

А это что за зверь???
...положительных элементов массива X?

autumn_orion Упссс....не заметил.....
A4-сумма косинусов положительных элементов Х.
Сенкс за вторую задачку

red2003

лови третью...
только пояснения сам напиши

program test3;

const k=15;

type vector=array [1..k] of real;


function Y(const A1,A4:real; const M1:integer):real;
begin
if (A1>=0) then
Y:=0.000135*A4
else
Y:=(A1+2.8*0.001*A4)/(0.3+M1*A1);
end;

function A1_sum(const _vector:vector):real;
var tmpsum:real;
i:integer;
begin
tmpsum:=0;
for i:=1 to k do
tmpsum:=tmpsum+_vector[i];
A1_sum:=tmpsum;
end;

function A4_sum(const _vector:vector):real;
var tmpsum:real;
i:integer;
begin
tmpsum:=0;
for i:=1 to k do
if _vector[i]>0 then
tmpsum:=tmpsum+cos(_vector[i]);
A4_sum:=tmpsum;
end;

function M1_val(const _vector:vector; const _A1:real):integer;
var i,count:integer;
begin
count:=0;
for i:=1 to k do
if (_vector[i]<_A1) then
count:=count+1;
M1_val:=count;
end;

procedure print_vector (const _vector:vector);
var i:integer;
begin
for i:=1 to k do
writeln ('X[',i,']=',_vector[i]);
end;

procedure init (var _vector:vector);
begin
_vector[1]:=1.0;
_vector[2]:=2.0;
_vector[3]:=3.0;
_vector[4]:=3.0;
_vector[5]:=2.0;
_vector[6]:=1.0;
_vector[7]:=-1.0;
_vector[8]:=-2.0;
_vector[9]:=-3.0;
_vector[10]:=-2.0;
_vector[11]:=-1.0;
_vector[12]:=5.0;
_vector[13]:=10.0;
_vector[14]:=11.0;
_vector[15]:=-27.0;
end;

{main}
var X:vector;
A1,A4:real;
M1:integer;
begin
init (X);
print_vector(X);
A1:=A1_sum(X);
A4:=A4_sum(X);
M1:=M1_val(X,A1);
writeln ('A1=',A1);
writeln ('A4=',A4);
writeln ('M1=',M1);
writeln ('result=',Y(A1,A4,M1))
end.

Удачи... Больше времени, увы, нет...

__
кстати, во второй задачке tol -- точность, с котоорой ищется корень

autumn_orion


Цитата:

Поравочка.......за место *M12 там М2......я просто ночью всё этоделал ......запарился..немного!!!
М2-Колличество положительных элементов матрицы!

red2003


Цитата:

М2-Колличество положительных элементов матрицы!

тогда так:

program test1;

const k=3;

type matrix=array[1..k,1..k] of double;


procedure init(var a:matrix);
begin
a[1,1]:=3.12;
a[1,2]:=2.14;
a[1,3]:=6.18;
a[2,1]:=8.99;
a[2,2]:=9.00;
a[2,3]:=14.77;
a[3,1]:=15.6;
a[3,2]:=9.8;
a[3,3]:=100.0;
end;

function max_str_num(const a:matrix):integer;
var i,j:integer;
maxelem:real;
begin
maxelem:=a[1,1];
max_str_num:=1;
for i:=1 to k do
for j:=1 to k do
if (a[i,j]>maxelem) then
begin
maxelem:=a[i,j];
max_str_num:=i;
end;
end;

function M2_val(const a:matrix):integer;
var i,j,count:integer;
begin
count:=0;
for i:=1 to k do
for j:=1 to k do
if (a[i,j]>0) then
count:=count+1;
M2_val:=count;
end;

function Y(const a:matrix; const strnum,M2:integer):real;
var i:integer;
tmpY:real;
begin
tmpY:=0;
for i:=1 to k do
tmpY:=tmpY+a[strnum,i]+a[i,strnum];
Y:=tmpY*M2/strnum;
end;

{main}
var matr:matrix;
i,j:integer;
begin
init(matr);
i:=max_str_num(matr);
j:=M2_val(matr);
writeln ('result=',Y(matr,i,j));
end.

autumn_orion
Пасиба ещё раз огромное....ты мне помог!!!

Привет народ!!! i`am need help!!! Блин задачки нада сделать а я впаскале не силён...а уже нада скоро сдать их.....помогите плзззз!

1)составить алгоритм и программу вычисления выражения 5x+3x^2*корень(1+x^3*sin(2x))/(2*c^x+a^2)

2)Даны функции y1=(4+x)^2 и y2=-x. Составить алгоритм и программу, для нахождения точки пересечения этих функций при -4<=x<=0. Вычисления производить с точностью до E.

3)В резервуаре, имеющем форму цилиндра диаметром D=2,5м и высотой H=6,5м и стоящем вертикально, хранится масло. Через отверстие в резервуаре S=3 см^2 на высоте А=0,35Н вытекает масло. Течь заметили четез Т=6ч. Скорость вытекания V=корень(2g(L-A)), где уровень масла в данный момент времени L=2,8м, ускорение силы тяжести g=9,8. Количество масла, вытекающего в единицу времени из резервуара Q=V*S. Какое количество масла (%) потеряно на момент обнаружения течи.

Что, никто помоч не может?

CoddeX
Это -- номер раз...

program pr1;

function power(const arg,deg:real):real;
begin
power:=exp(deg*ln(arg));
end;

{main}
var a,c,f,x:real;
begin
a:=1.5;
c:=2.5;
x:=10.0;
f:=5*x+3*x*x*sqrt(1+x*x*x*sin(2*x))/(2*power(c,x)+a*a);
writeln ('a=',a,' c=',c, ' x=',x);
writeln ('result=',f);
end.

Задача номер 2 имеет аналитическое решение. Чтобы найти точку пересечения функций y1(x) и y2(x) нужно решить уравнение y1(x) - y2(x) = 0, тогда
(4+x)^2 - (-x) = 0,
16 + 8x + x^2 + x =0,
x^2 + 9x + 16 = 0.

дальше решаешь это простейшее квадратное уравнение аналитическим методом

x1,2 = (-9 +-Sqrt(81 - 64))/2 = (-9 +- Sqrt(17))/2

x1 = (-9 + Sqrt(17))/2,
x2 = (-9 - Sqrt(17))/2.

Помогите пожалуйста с задачкой

1. Создать программу, которая выводит на экран "бегущую строку" (Любая фраза на английском).

Люди, помогите написать одну прогу. Маюсь с еню уже давно. Вот её условия:
•    Ввести количество строк и столбцов матрицы;
•    Ввести значения элементов матрицы;
•    Вычислить новую матрицу, первая строка которой состоит из минимальных , а вторая - из максимальных элементов столбцов заданной матрицы;
•    Вывести на экран значения заданной и новой матриц.
•    Для выполнения этого задания использовать только процедуры(не функции) для ввода и вывода первонач матрицы, а затем и использовать процедуру для нахождения новой матрицы.

Привет всем, помогите, пожалуйста, написать программу в Turbo Pascal с использованием процедур. Задача такая На плоскость задаются координаты N произвольных точек. Выделить среди них две точки, расстояние между которыми максимально и две точки, расстояние между которыми минимально.