» Задачи на Turbo Pascal 7.0

Здрасьте всем. Помогите пожалуйста срочно решить 2 задачки. Первая: Даны действительные a1,...,a10, b1,...,b20. Получить действительную матрицу [cij] i=1,...,20, j=1,...,10, для которой cij=aij/(1+|bi|). И вторая: Дана действительная квадратная матрица порядка 9. Вычислить сумму тех из ее элементов, расположенных на главной диагонали и выше ее, некоторые певосходят по величине все элементы, расположенные ниже главной диагонали. Если на главной диагонали и выше нее нет элементов с указанным свойством, то ответом должно служить сообщение об этом.

Пожалуйста человеки, откликнитесь! Всем заранее большое спасибо!

Плзз помогите решить 2 задачки...

а)Дано натуральное число определить образуют ли цифры этого числа арифметическую прогрессию

б)Дана последовательность натуральных чисел ,заканчивающаяся нулем. Найти все числа, цифры которых образуют арифметическую последовательность.

Вопрос жизни и смерти ,ОГРОМНОЕ спасибо тем кто ответит =)

CAHR_89@mail.ru

еще раз спасибо

1KYPC
a)
uses crt;
var num:longint;
digs:array[1..10]of byte;
i,j:byte;
d:shortint;
begin
clrscr;
writeln('Введите число (-2147483648..2147483647): ');
readln(num);
i:=0;
while(num<>0)do
begin
inc(i);
digs[i]:=num mod 10;
num:=num div 10;
end;
if(i=1)or(i=2)then writeln('Да')
else
begin
d:=digs[2]-digs[1];
for j:=3 to i do
if(digs[j]-digs[j-1]<>d)then break;
if(digs[j]-digs[j-1]<>d)then writeln('Нет')
else writeln('Да');
end;
end.

Добавлено:
1KYPC
б)
uses crt;
const MAX=100;
var num:longint;
valids:array[1..MAX]of longint;
cur,i:integer;
function isarifm(num:longint):boolean;
var digs:array[1..10]of byte;
i,j:byte;
d:shortint;
begin
i:=0;
while(num<>0)do
begin
inc(i);
digs[i]:=num mod 10;
num:=num div 10;
end;
if(i=1)or(i=2)then isarifm:=true
else
begin
d:=digs[2]-digs[1];
for j:=3 to i do
if(digs[j]-digs[j-1]<>d)then break;
if(digs[j]-digs[j-1]<>d)then isarifm:=false
else isarifm:=true;
end;
end;
begin
clrscr;
writeln('Вводите последовательность:');
cur:=0;
repeat
read(num);
if(isarifm(num))then
begin
inc(cur);
valids[cur]:=num;
end;
until num=0;
writeln('Числа, удовлетворяющие условию:');
for i:=1 to cur do write(valids[i]:8);
end.

Премного благодарен rain87, спасибо тебе!!!

PRV огромное тебе спасибо!

Здрасьте всем. Помогите пожалуйста срочно решить 2 задачки. Первая: Даны действительные a1,...,a10, b1,...,b20. Получить действительную матрицу [cij] i=1,...,20, j=1,...,10, для которой cij=aij/(1+|bi|). И вторая: Дана действительная квадратная матрица порядка 9. Вычислить сумму тех из ее элементов, расположенных на главной диагонали и выше ее, некоторые певосходят по величине все элементы, расположенные ниже главной диагонали. Если на главной диагонали и выше нее нет элементов с указанным свойством, то ответом должно служить сообщение об этом.

Пожалуйста человеки, откликнитесь! Всем заранее большое спасибо!

Извините, но может ли кто-нибудь написать текст программы по задаче: Используя разложение в ряд Теулора найти значение exp(x) с заданной точностью *,а то что-то у меня не получается правильно её составить.Очень нужно!

Bukenist
держи...


Код:
{$APPTYPE CONSOLE}
uses Math;

var
epsilon, exactexp, x, expx, delta, factn: extended; //double;
n, i: integer;
begin
writeln;
write('give x = ');
readln(x);

exactexp := exp(x);

write('give epsilon = ');
readln(epsilon);

{
exp (x) = 1 + x/1 + x^2/2! + ... + x^n/n! + ...
}

n := 1;
expx := 1.;
delta := 10. * expx;

while (delta > epsilon) do begin
factn := 1.;
for i := 1 to n do
factn := i * factn;
delta := IntPower(x, n) / factn;
expx := expx + delta;
inc(n);
end;//while

writeln(#10#13'done!'#7);
writeln('------------------------');

writeln('our result = ', expx);
writeln('exact value = ', exactexp);
end.

Ребята ну просто очень нужна помощь!!! Нужно 2 программы написать в паскале: 1.вывести с клавиатуры х,у и вычислить, используя метод промежуточного аргумента : z=lg(1+[x+y-1])-arccos 1/1+[x+y-1] ([...] это модуль)! 2. Вычислить, выводя соответств. функцию в разделе function : y=arccos x-arccos2x+arccos3x!!! Помогите пжалста!!!!

akaGM
Спасибо, можешь выложить модуль 'Math'? И что такое {$APPTYPE CONSOLE}, компилятор пишет, 'Недопустимая директива компилятора'.

Bukenist
не могу... он тебе не поможет, т.к. у меня Дельфи, а у тебя, по всей видимости, Борланд/Турбо паскаль

убери строчки
{$APPTYPE CONSOLE}
и
uses Math;
и вот это --> //double;
а вместо IntPower() придётся использовать что-нибудь другое, т.к. в паскале, afair, такой функции нет...

щас...
вот:

Код:
function IntPower(x: extended; i: integer): extended;
var
y: integer;
begin
y := abs(i);
result := 1.;
while y > 0 do begin
while not odd(y) do begin
y := y shr 1;
x := x *x
end;
dec(y);
result := result * x;
end;
if i < 0 then
result := 1. / result;
end;

akaGM
Да, у меня Turbo Pascal.
Попробую всё сделать как ты написал. Благодарствую.

Добавлено:
akaGM
А что такое result. Компилятор пишет что это неизвестный идентификатор, но если его объявить в переменных, то программа завершается и выдаётся сообщение: invalid floating point operation. Подскажи в чём дело.

блин...
добавь красные строчки...


Код:
function IntPower(x: extended; i: integer): extended;
var
y: integer;
result: extended;
begin
y := abs(i);
result := 1.;
while y > 0 do begin
while not odd(y) do begin
y := y shr 1;
x := x *x
end;
dec(y);
result := result * x;
end;
if i < 0 then
result := 1. / result;
IntPower := result;
end;

akaGM
Огромное спасибо!!!Всё работает,только что означает exact?

Ну парни хелп плиз!!!!просто завтра завалюсь тогда.... 2 программы написать нада в паскале: 1.вывести с клавиатуры х,у и вычислить, используя метод промежуточного аргумента : z=lg(1+[x+y-1])-arccos 1/1+[x+y-1] ([...] это модуль)! 2. Вычислить, выводя соответств. функцию в разделе function : y=arccos x-arccos2x+arccos3x!!! SOS HELP!!!!!!

Bukenist

Цитата:

только что означает exact?

ну ты ваще... словаря нет? ты ж БукЕнист...

xRubi
тоже "зачот" нужен?
значитцца так...
щас напишу на Дельфи, под борландовский паскаль сам адаптируй...

ПАСИБА!!!!!!!! ДАВАЙ !!!ЖДУ!!!!)))))

xRubi

Цитата:

1.вывести с клавиатуры х,у и вычислить, используя метод промежуточного аргумента : z=lg(1+[x+y-1])-arccos 1/1+[x+y-1] ([...] это модуль)!

модуль можно и вот так написать
|x+y-1|

молодёжь...


Код:
{$APPTYPE CONSOLE}
uses Math;
var
x, y, z: extended;
begin
writeln;
write('give x = ');
readln(x);
write('give y = ');
readln(y);

z := log10(1.0+abs(x+y-1.0)) - arccos(1.0/(1.+abs(x+y-1.0)));

writeln(#10#13'done!'#7);
writeln('------------------------');

writeln('result = ', z);
end.

спасибо, все замечательно. Но ничего не работает, тк паскаль не знает арккос и тд. И в делфи7 тоже не работает кстати...

xRubi
насчёт арка в паскале не уверен...
а то что в Д не работает -- не гони, я проверял прежде чем тебе давать...
посмотри определение арка и подавай ему данные, кот. он может съесть, я никаких
проверок не делал и ликбез по тригонометрии устраивать не намерен...

Ну ладно, ладно..все равно спасибки...может чтоньть придумаю.)

Код:
{ IN: |X| <= 1 OUT: [0..PI] radians }
function ArcCos(const X : Extended) : Extended; overload;

Помогите плиз с задачей.
Задание: Исследовать зависимость давления P насыщенного пара от температуры Т в твердом и жидком состояниях системы:
1)Построить графики зависимости lgpж от 1/T и lgpт от 1/T (индексы указывают на состояние системы)
2)Определить с помощью метода наименьших квадратов коэффициенты зависимостей lgpж=а2*1/Tж+а1 и lgpт=а'2*1/Tт+а'1 и построить графики этих зависимостей
Исходные данные (значения через пробел):
Tт: 273,2 274,2 276,2 277,2 278,2
Pт: 3265,8 3465,8 3932,3 4305,6 4530
Tж: 274,2 275,2 276,2 278,2 283,2 290,2
Pж: 3730 4000 4160 4530 6050 8930

rimgal
"ну вы, блин, даёте"...

с такими задачами тебе явно в "работу для программистов"...

Люди кто знает как вывести на экран последовательность чётных степеней 10 (110010000...)?
Дано целое число k. Определить, какая цифра находится в k-ой позиции последовательности, в которой выписаны подряд чётные степени числа 10. Нужно только показать эту последовательность пользователю.

xRubi

Цитата:

спасибо, все замечательно. Но ничего не работает, тк паскаль не знает арккос и тд. И в делфи7 тоже не работает кстати...

...в делфи7 надо юнит Math добавить в uses чтобы заработало кстати
учи матчасть!

Ребятки!!! Помогите пожалуйста!!!
Для каждого слова заданного предложения указать долю согласных.
Определить слово, в котором доля согласных максимальна. Найти самое
длинное симметрическое слово заданного предложения, напимер АККА.

SerP and MoloT

Код: [no]uses crt;
const sogl:string='eyuioaj';
var s,cw,mw,msw:string;
ls,i,j,nsogl,lcw:byte;
mp,cp:real;
begin
clrscr;
writeln('Введите предложение:');
readln(s);
ls:=length(s);
i:=1;
mp:=0;
while(i<=ls)do
begin
while(i<=ls)and not(((s[i]>='A')and(s[i]<='Z'))or((s[i]>='a')and(s[i]<='z')))do inc(i);
cw:='';
while(i<=ls)and(((s[i]>='A')and(s[i]<='Z'))or((s[i]>='a')and(s[i]<='z')))do
begin
cw:=cw+s[i];
inc(i);
end;
nsogl:=0;
lcw:=length(cw);
for j:=1 to lcw do
if(pos(cw[j],sogl)<>0)then inc(nsogl);
cp:=nsogl/lcw;
writeln(cw,' ',cp:0:2);
if(cp>mp)then
begin
mp:=cp;
mw:=cw;
end;
for j:=1 to lcw div 2 do
if(cw[j]<>cw[lcw-j+1])then break;
if(cw[j]=cw[lcw-j+1])and(lcw>length(msw))then msw:=cw;
end;
writeln('Слово с макс содержанием согласных: ',mw,' ',mp:0:2);
writeln('Максимальное симметричное слово: ',msw);
end.[/no]

Подскажите пожалуйста, как можно сделать, чтобы консоль при компиляции не выключалась? Знаю способ, прописывать в конце кода readln, но ведь должен быть какой-нибудь другой способ?

Nikosss
консоль кого, BP/TP?
а ты как компилишь, средой команд-лайном, из виндов? тогда милости просим в свойства шорката (close on exit)...
"настоящие мужчины" компилят из-под фара или тотал коммандера, там проблем нет...

-------
прочитал внимательнее...

Цитата:

консоль при компиляции не выключалась? Знаю способ, прописывать в конце кода readln

ты сам-то понимаешь чтО спрашиваешь?