Помогите с двумя программами

[Deomurg]

Помогите с двумя программами



помогите кто чем может... завтро отчитать надо... Писать в среде Free Pascal... заранее спасибо

 

[Vladimir_S]

Посмотреть вложение 140046

помогите кто чем может... завтро отчитать надо... Писать в среде Free Pascal... заранее спасибо

Ничего не выйдет: тег IMG у нас запрещен, а клик по Вашей ссылке раскрывает только маленькую неразборчивую копию без возможности увеличения. Так что Вам - сюда:
http://www.tehnari.ru/f8/t32642/

 

[Deomurg]

вот... так можно?

 

[Vladimir_S]

Посмотреть вложение 140047

вот... так можно?

Можно. Но не нужно. Более того, крайне нежелательно. А можно и нужно вот так:

 

[Deomurg]

program prog_8;
uses crt;
const p=3.14;
var y:array[1..11] of real;
b,j,u,o,i,n:integer;
m,sum:real;
begin
clrscr;
n:=0;
j:=0;
for i:=1991 to 2001 do
begin
inc;
y[n]:=100*(abs(cos(2*i)/(3*i-p))+2.54);
if y[n]<0 then
inc(j);
end;
writeln('god velichina dohoda');
n:=0;
for i:=1991 to 2001 do
begin
inc;
write(i,' ',y[n]:5:3);
writeln;
end;
if j<>0 then
begin
m:=y[1];
n:=0;
for i:=1991 to 2001 do
begin
inc;
if y[n]<0 then
sum:=sum+y[n];
if y[n]<m then
begin
m:=y[n];
b:=i;
end;
end;
writeln('summa ubitkov sostavlyet=',sum:5:3);
writeln('v ',b,' godu ubitki bili naimenshie');
end;
for i:=1 to n do
if y>0 then
inc(u)
else inc(o);
if u=n then writeln('firma na ptotachenii 10 let ubitkov ne imela')
else if o=n then writeln('firma na protishenii 10 let pribili ne imela')
else writeln('firma na protichenii 10 let imela i ubitki i pribol');
readln;
end.


8-я вот у меня какая вышла, но она работает только на половину(((

 

[Vladimir_S]

По поводу второй задачи.
Я уже имел счастие с ней встречаться здесь (№4):
http://www.tehnari.ru/f41/t43893/
И тогда, и сейчас повторю: формула построена так, что НИ ПРИ КАКИХ значениях параметров величина у НЕ МОЖЕТ БЫТЬ ОТРИЦАТЕЛЬНОЙ! Потому что складывается значение АБСОЛЮТНОЙ ВЕЛИЧИНЫ некоей функции (неважно какой) с ПОЛОЖИТЕЛЬНОЙ КОНСТАНТОЙ. Значит, в условии - брёх. Разбирайтесь с преподавателем.
По первой задаче - обязательна ли кириллица? Нельзя ли латиницей обойтись? Поясню: я пользуюсь исключительно DOS-версией Free Pascal, и отсюда проблемы с кодировкой кириллицы.

 

[Deomurg]

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

 

[Vladimir_S]

Вопрос, можно ли 2-ю задачу написать хоть как нибудь, я имею ввиду выполнить без отрицательных значений параметра дополнительную чать или хоть как нибудь преобразовать мой вариант задачи что бы эта часть работала?

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

program prog_8;
uses
 crt;
var
 y:array[1991..2001] of real;
 i:integer;
begin
 clrscr;
 writeln('god velichina dohoda');
 for i:=1991 to 2001 do
  begin
   y[i]:=100*(abs(cos(2*i)/(3*i-Pi))+2.54);
   writeln(i,' ',y[i]:5:3);
  end;
 readln;
END.

Кстати, обратите внимание: Вашу константу я выбросил за ненадобностью: Паскаль имеет "встроенную" константу (функцию) Pi, отдающую число Архимеда.

 

[Deomurg]

допустим... а что с 7-й?

 

[Vladimir_S]

допустим... а что с 7-й?

А вот что:

program prog_7;
VAR
 S:STRING;
 i,k,Na,Naf,p:Byte;
BEGIN
 Writeln('Enter Name, Patronymic and Surname, divided by single space,');
 Writeln('e.g. Ivan Petrovich Sidorov:');
 Writeln;
 ReadLn(S);
 Writeln;
 Na:=0;
 For i:=1 to Length(S) do
  if S[i]='a' then Inc(Na);
 Naf:=0;
 p:=0;
 k:=0;
 Repeat
  Inc(k);
  If (S[k]=' ') and (p=0) then p:=1;
 Until (S[k]=' ') and (p=1);
 For i:=k+1 to Length(S) do
  if S[i]='a' then Inc(Naf);
 Writeln('Text contains ',Na,' letters "a"');
 Writeln('Surname contains ',Naf,' letters "a"');
 ReadLn;
END.

 

[Deomurg]

Вас не затруднит написать еще такую прогу? Если сложно то не стоит... Просто с ней у меня тоже трудность небольшая... Заранее спасибо

Протабулировать функцию y = sin(2x/pi – 4,1) + cos^3(2х) на отрезке [0;I] с шагом h = 0.1*I, где I – номер варианта. Результаты вычисления вывести на экран в виде таблицы пар чисел x,y. Вычислить сумму и произведение всех значений функции y, для которых выполняется неравенство 0<y<3,2.

 

[Vladimir_S]

Вас не затруднит написать еще такую прогу? Если сложно то не стоит... Просто с ней у меня тоже трудность небольшая... Заранее спасибо

Протабулировать функцию y = sin(2x/pi – 4,1) + cos^3(2х) на отрезке [0;I] с шагом h = 0.1*I, где I – номер варианта. Результаты вычисления вывести на экран в виде таблицы пар чисел x,y. Вычислить сумму и произведение всех значений функции y, для которых выполняется неравенство 0<y<3,2.

Да ладно, пожалуйста:

VAR
 I,j,q:Byte;
 S,P,h:Real;

FUNCTION Y(x:Real):Real;
 begin
  Y:=Sin(2*x/Pi-4.1)+Cos(2*x)*Cos(2*x)*Cos(2*x);
 end;

BEGIN
 Write('Variant N ');
 ReadLn(I);
 Writeln;
 h:=0.1*I;
 S:=0;
 P:=1;
 q:=0;
 For j:=0 to 10 do
  begin
   WriteLn(h*j:4:1, Y(h*j):12:5);
   if (Y(h*j)>0) and (Y(h*j)<3.2) then
    begin
     q:=1;
     S:=S+Y(h*j);
     P:=P*Y(h*j);
    end;
  end;
 Writeln;
 If q=0 then
  Writeln('No values in the range 0..3.2')
 else
  begin
   Writeln('S= ',S:10:5);
   Writeln('P= ',P:10:5);
  end;
 Readln;
END.

 

[Deomurg]

Спасибо вам огромнейшее) вы меня прям выручили)) Век буду помнить))
Еще раз спасибо))