Помогите решить задачу на Паскале???

[Yez]

Помогите решить задачу, ПЛИЗЗЗ!!! Условие: Дан массив размера n ненулевых целых чисел. Проверить, чередуются ли в нём чётные и нечётные числа. Если чередуются, то вывести значения TRUE, если нет, то вывести номер первого элемента, нарушающего закономерность.
Подскажите хотя бы идею решения!!! Зарание всем СПАСИБО!!!

 

[zubr]

Type
mas=Array[1..100] of Integer;

function CheckMassiv(buf:mas; var nom:Integer):boolean;
var
even:boolean;
i:Integer;
begin
Result:=True;
even:=(buf[1] mod 2)=0;//первый элемент четный или нечетный
For i:=1 to 100 do
begin
If even then
begin
 If (((i mod 2)<>0) and ((buf[i] mod 2)<>0)) or (((i mod 2)=0) and ((buf[i] mod 2)=0)) then
 begin
 nom:=i;
 Result:=False;
 exit;
 end;
end
else
begin
 If (((i mod 2)<>0) and ((buf[i] mod 2)=0)) or (((i mod 2)=0) and ((buf[i] mod 2)<>0)) then
 begin
 nom:=i;//номер элемента нарушающего закономерность
 Result:=False;
 exit;
 end;
end;
end;
end;

 

[Yez]

zubr
Спасибо тебе большое!!! Может подскажешь где нормально разъеснены
решения интегралов на
Паскале???

 

[zubr]

Может подскажешь где нормально разъеснены
решения интегралов на
Паскале???

Неа, давно такое не делал, уже забыл.

 

[Yez]

zubr
Извини, пожалуйста, может поможешь решить ещё одну задачу???
Условие: Найдите приближённос точностью до 0.01 наибольшее значение функции y=(axквадрат+bx +c)/dx+e на отрезке [x1;x2]. Значения a, b, c, d, e, x1, x2 введите с клавиатуры. Зарание СПАСИБО!!!

 

[zubr]

Проще всего это решить с рекурсией. Вот примерный код:

program MaxFunc;

var
a, b, c, d, e, x1, x2, y, Max, int:Real;

procedure Recurs(a, b, c, d, e, x2:Real; var x1, int, y, Max:Real);
var
y2, x_int:Real;
begin
If x1>=x2 then
begin
exit;
end;
x_int:=x1+int;
y2:=(a*x_int*x_int+b*x_int+c)/(d*x_int)+e;
If Abs(y2-y)>0.01 then
begin
int:=int/2;
Recurs(a, b, c, d, e, x1, x2, int, y, Max);
end
else
begin
If y2>Max then
Max:=y2;
x1:=x1+int;
Recurs(a, b, c, d, e, x1, x2, int, y2, Max);
end;
end;

begin
Write('Enter a:');
Readln(a);
Write('Enter b:');
Readln(b);
Write('Enter c:');
Readln(c);
Write('Enter d:');
Readln(d);
Write('Enter e:');
Readln(e);
Write('Enter x1:');
Readln(x1);
Write('Enter x2:');
Readln(x2);
y:=(a*x1*x1+b*x1+c)/(d*x1)+e;
Max:=y;
int:=(x2-x1)/2;
Recurs(a, b, c, d, e, x2, x1, int, y, Max);
Writeln('Result=', Max);
Writeln('Press "Enter" to exit');
Readln;
end.

Здесь отрицательные значения функции не учитываются, это ты уже сам.

 

[Yez]

zubr
Спасибо, тебе большое, но я уже сам решил, и всё таки ты не знаешь где можно достать документацию по решению интегралов???

 

[Quistis]

Кто-нибудь объясните как решается эта задача. ПОЖАЛУЙСТА
function F(X:string):string;
var
L:integer;
T:string;
begin
L:=Length(X);
if L>1 then
begin
T:copy(X,2,L-1);
case X(1) of
`0`:F:=T;
`1`:F:=F(T)+`0`+F(T)
else F:=F(X)
end
end
else
F:=F(X)
end
Нужно найти строку Х, для которой F(X)=10X

 

[zubr]

Функция function F(X:string):string не будет зацикливаться, только если X будет вида '10101010'
Ответ здесь Х='10101'

 

[Guest_Quistis]

zubr
Спасибо за ответ И если тебе не лень, разъясни как ты это вычислил

 

[Guest_Quistis]

zubr
Пришел брат, он у меня сис. админ и решил задачку она конечно простая теперь и для меня.

 

[zubr]

Пришел брат, он у меня сис. админ и решил задачку она конечно простая теперь и для меня.

Рад за вас
А функцию кто писал? Кривовата она.

 

[Guest]

А такое решите??? Пожалуйста….очень надо))..если что мой маил enik1986@mail.ru

Плииззз решите..

У фирмы три магазина. Известен доход каждого магазина за каждый из десяти дней:
магазин ДАТА
1 2 3 4 5 6 7 8 9 10
1-ый 3 5 4 7 9,5 8 2,3 3 7 5,1
2-ой 4,1 2,8 4,3 1,2 6,7 8 5,5 3 4 8
3-ий 8,3 9,1 10 8 7 2 3,4 2 3 9
ДОХОД

Организовать ввод информации по этой таблице и определить:
А) какой из магазинов получил максимальный общий доход за 10 дней;
Б) какого числа фирма получила максимальный общий доход;
В) какой магазин, и какого числа получил максимальный доход за день
Г) для каждого магазина определить, какого числа этот магазин получил максимальный доход;
Д) для каждого магазина определить среднюю численность в группе

 

[zubr]

А что самому никак? Задача простенькая. У меня пока нет времени. Может на днях, если просвет будет, что подкину.

 

[zubr]

Женя
Вот код:

program Magazins;

type
mags=array [1..3, 1..10] of real;

var
mag:mags;
i, j:Integer;

procedure A(mag:mags);
var
i, j, n:Integer;
max:array [1..3] of real;
maxsum:real;
begin
For j:=1 to 3 do
begin
max[j]:=mag[j, 1];
For i:=2 to 10 do
begin
 If mag[j, i]>max[j] then
 max[j]:=mag[j, i];
end;
end;
maxsum:=max[1];
n:=1;
For j:=2 to 3 do
begin
If max[j]>maxsum then
begin
 maxsum:=max[j];
 n:=j;
end;
end;
Writeln('Maxsimalniui doxod y magazina N', n);
end;

procedure B(mag:mags);
var
i, j, n:Integer;
max:array [1..10] of real;
maxsum:real;
begin
For j:=1 to 10 do
begin
max[j]:=0;
For i:=1 to 3 do
begin
 max[j]:=max[j]+mag[i, j];
end;
end;
maxsum:=max[1];
n:=1;
For j:=2 to 10 do
begin
If max[j]>maxsum then
begin
 maxsum:=max[j];
 n:=j;
end;
end;
Writeln('Maxsimalniui doxod y firmi ', n, ' chisla');
end;

begin
For j:=1 to 3 do
begin
Writeln('Vvedite doxod po dniam ',j,'-go magazina:');
For i:=1 to 10 do
begin
 Write(i,' den: ');
 Readln(mag[j, i]);
end;
end;
Writeln;
A(mag);
Writeln;
B(mag);
Writeln;
Writeln('Dlia vixoda iz programmi nagmite Enter');
Readln;
end.

Сделано для пунктов А), Б), остальное сам.

 

[Sima]

:lol: Помогите, пожалст., решить задачу в Паскале: Даны параметры (длина и ширина)-Word прямоугольника. Нужно отсекать самые большие квадраты в нем до тех пор, пока стороны прямоугольника не станут по 1.

 

[zubr]

program Kvadrat;

var
 a, b:Word;
 i:Integer;

begin
Write('Shirina: ');
Readln(a);
Write('Visota: ');
Readln(b);
If a=b then
begin
 Writeln('Nevernoe yslovie!');
 Writeln('Dlia vixoda nagmite Enter');
 Readln;
 exit;
end;
i:=0;
While (a>1) or (b>1) do
begin
 inc(i);
 If a>b then
 begin
  a:=a-b;
  Writeln(i, ' kvadrat: ', b, '*', b);
 end
 else
 begin
  b:=b-a;
  Writeln(i, ' kvadrat: ', a, '*', a);
 end;
Writeln('Ostalsia priamoygolnik: ', a, '*', b);
end;
Writeln('Dlia vixoda nagmite Enter');
Readln;
end.

 

[Sima]

СПАСИБА АГРОМНАЯ!!!

 

[Sima]

Во чёрт! Оказывается, не пасиба! Задачу-то нужно решить рекурсией, а так и я тоже могу... А вот ентую рекурсию не понимаю, хоть убейте!!! :blink:

 

[zubr]

Ну на тебе с рекурсией:

program Kvadrat;

var
a,b:Word;
i:Integer;

procedure Recurs(var a, b:Word; var i:Integer);
begin
If (a=1) and (b=1) then
exit;
If a=b then
begin
Writeln('Ostalsia kvadrat: ', a, '*', b);
Writeln('Dalshe reshenia net');
exit;
end;
inc(i);
If a>b then
begin
a:=a-b;
Writeln(i, ' kvadrat: ', b, '*', b);
Writeln('Ostalsia priamoygolnik: ', a, '*', b);
end
else
begin
b:=b-a;
Writeln(i, ' kvadrat: ', a, '*', a);
Writeln('Ostalsia priamoygolnik: ', a, '*', b);
end;
Recurs(a, b, i);
end;

begin
Write('Shirina: ');
Readln(a);
Write('Visota: ');
Readln(b);
If a=b then
begin
Writeln('Nevernoe yslovie!');
Writeln('Dlia vixoda nagmite Enter');
Readln;
exit;
end;
i:=0;
Recurs(a, b, i);
Writeln('Dlia vixoda nagmite Enter');
Readln;
end.