Технический форум - Помогите написать программы на языке Pascal

Технический форум (http://www.tehnari.ru/)

- Помощь студентам (http://www.tehnari.ru/f41/)

Помогите написать программы на языке Pascal

Прошу помощи!:tehnari_ru_837:
Нужно написать две слишком сложные для меня программы в Pascal. Суть в приложенном файле!
Буду рада любой помощи! Сессия близко!

Цитата:

Сообщение от brokilone (Сообщение 645764)

Прошу помощи! Нужно написать две слишком сложные для меня программы в Pascal. Суть в приложенном файле! Буду рада любой помощи! Сессия близко!

Да, как говорится - проснулись, девушка! Задачки-то в 5 минут не делаются, работы много. К тому же сформулировано (как, впрочем, всегда в методичках) - бестолково. Например, вопросы по 1 задаче:
1. Что нужно сосчитать - суммарную площадь зеленых фрагментов тремя способами? Или площадь фигуры А следует рассчитать методом А (прямоугольники), а площадь фигуры В - методом В (трапеции)?
2. Можно ли считать прямую, параллельную оси Y и пересекающую ось X в точке х=32 касательной к окружности, а прямую, параллельную оси X и пересекающую ось Y в точе y=40 касательной к эллипсу?
Ладно, будем считать ответ на второй вопрос утвердительным, а по первому будем искать сумму площадей тремя методами.
Попробую Вам помочь, хотя и не следовало бы - такие дела в пожарном порядке не делаются! Тут одной аналитической геометрии на несколько часов работы: составить уравнения окружности и эллипса, решить их совместно для нахождения координат точек пересечения, составить уравнение прямой, проходящей через эти точки, правильно задать саму функцию для нахождения площадей.

P.S. 2AlexZir. Лёша, как человек, работающий в системе образования, объясните Вы мне, бестолковому - почему составление методичек поручают исключительно идиотам? Ну что это такое: методы расчета - А, В, С, крайние точки интервала - А,В, области интегрирования - тоже А,В? Букв что ли мало? Ух, как я зол... :D

Владимир, уверяю вас, что я тут совершенно не при чем, это они своим студентусам-двоечникам поручают или аспирантам-недоучкам, а среди них гениев почти не наблюдается :D

Цитата:

Сообщение от Vladimir_S (Сообщение 645868)

почему составление методичек поручают исключительно идиотам?

Владимир, Вы не поверите, но при виде моей методички по программированию у меня возникает такой же вопрос.
Эту методичку составляла Завкафедрой! Что думать о других педагогах?

Цитата:

Сообщение от brokilone (Сообщение 645764)

Нужно написать две слишком сложные для меня программы в Pascal.

Ну вот, первая (черт, весь день с этой ерундой провозился):

Код:

Uses CRT;

Const

 Xc=32.0;

 Yc=-40.0;

 Xe=-21.0;

 Ye=40.0;

 R=33.0;

 Ae=16.0;

 Be=38.0;



Var

 X0c,Y0c,X0e,Y0e,X1,Y1,X2,Y2,X3,Y3,Step:Real;

 i,Nt,k:Byte;

 N:Word;

 Rect,Trap,Simp:Array[1..100] of Real;

 Np:Array[1..100] of Word;



Function Ysl(Xsl:Real):Real;

begin

 Ysl:=Y1+(Xsl-X1)/(X2-X1)*(Y2-Y1);

end;



Function Ycr1(Xcr:Real):Real;

begin

 Ycr1:=Y0c+Sqrt(Sqr(R)-Sqr(Xcr-X0c));

end;



Function Ycr2(Xcr:Real):Real;

begin

 Ycr2:=Y0c-Sqrt(Sqr(R)-Sqr(Xcr-X0c));

end;



Function Yel(Xel:Real):Real;

begin

 Yel:=Y0e-Be*Sqrt(1-Sqr((Xel-X0e)/Ae));

end;



Function F1(Xf:Real):Real;

begin

 F1:=Ycr1(Xf)-Ysl(Xf);

end;



Function F2(Xf:Real):Real;

begin

 F2:=Yel(Xf)-Ycr2(Xf);

end;



Function F3(Xf:Real):Real;

begin

 F3:=Ysl(Xf)-Ycr2(Xf);

end;



Function Rectangle1:Real;

var

 i:Integer;

 Sum,h,a,b:Real;

begin

 a:=X1;

 b:=0;

 h:=(b-a)/N;

 Sum:=0;

 for i:=0 to N-1 do

  Sum:=Sum+h*F1(a+h*i);

 Rectangle1:=Sum;

end;



Function Rectangle2:Real;

var

 i:Integer;

 Sum,h,a,b:Real;

begin

 a:=0;

 b:=X2;

 h:=(b-a)/N;

 Sum:=0;

 for i:=0 to N-1 do

  Sum:=Sum+h*F2(a+h*i);

 Rectangle2:=Sum;

end;



Function Rectangle3:Real;

var

 i:Integer;

 Sum,h,a,b:Real;

begin

 a:=X2;

 b:=X3;

 h:=(b-a)/N;

 Sum:=0;

 for i:=0 to N-1 do

  Sum:=Sum+h*F3(a+h*i);

 Rectangle3:=Sum;

end;



Function Trapezium1:Real;

var

 i:Integer;

 Sum,h,a,b:Real;

begin

 a:=X1;

 b:=0;

 h:=(b-a)/N;

 Sum:=(F1(a)+F1(b))/2*h;

 for i:=1 to N-1 do

  Sum:=Sum+h*F1(a+h*i);

 Trapezium1:=Sum;

end;



Function Trapezium2:Real;

var

 i:Integer;

 Sum,h,a,b:Real;

begin

 a:=0;

 b:=X2;

 h:=(b-a)/N;

 Sum:=(F2(a)+F2(b))/2*h;

 for i:=1 to N-1 do

  Sum:=Sum+h*F2(a+h*i);

 Trapezium2:=Sum;

end;



Function Trapezium3:Real;

var

 i:Integer;

 Sum,h,a,b:Real;

begin

 a:=X2;

 b:=X3;

 h:=(b-a)/N;

 Sum:=(F3(a)+F3(b))/2*h;

 for i:=1 to N-1 do

  Sum:=Sum+h*F3(a+h*i);

 Trapezium3:=Sum;

end;



Function Simpson1:Real;

var

 i,Ns:Integer;

 Sum,h,a,b:Real;

begin

 a:=X1;

 b:=0;

 Ns:=N div 2;

 h:=(b-a)/(2*Ns);

 Sum:=(F1(a)+F1(b))/3*h;

 for i:=1 to Ns do

  Sum:=Sum+4.0*h/3.0*F1(a+h*(2*i-1));

 for i:=2 to Ns do

  Sum:=Sum+2.0*h/3.0*F1(a+h*(2*i-2));

 Simpson1:=Sum;

end;



Function Simpson2:Real;

var

 i,Ns:Integer;

 Sum,h,a,b:Real;

begin

 a:=0;

 b:=X2;

 Ns:=N div 2;

 h:=(b-a)/(2*Ns);

 Sum:=(F2(a)+F2(b))/3*h;

 for i:=1 to Ns do

  Sum:=Sum+4.0*h/3.0*F2(a+h*(2*i-1));

 for i:=2 to Ns do

  Sum:=Sum+2.0*h/3.0*F2(a+h*(2*i-2));

 Simpson2:=Sum;

end;



Function Simpson3:Real;

var

 i,Ns:Integer;

 Sum,h,a,b:Real;

begin

 a:=X2;

 b:=X3;

 Ns:=N div 2;

 h:=(b-a)/(2*Ns);

 Sum:=(F3(a)+F3(b))/3*h;

 for i:=1 to Ns do

  Sum:=Sum+4.0*h/3.0*F3(a+h*(2*i-1));

 for i:=2 to Ns do

  Sum:=Sum+2.0*h/3.0*F3(a+h*(2*i-2));

 Simpson3:=Sum;

end;



BEGIN

 ClrScr;

 X0c:=-1.0;

 Y0c:=Yc+Sqrt(sqr(R)-sqr(X0c));

 Y0e:=2.0;

 X0e:=Xe+Ae*Sqrt(1.0-sqr(Y0e/Be));

 Writeln('X0c=',X0c:9:5,' - X координата центра окружности');

 Writeln('Y0c=',Y0c:9:5,' - Y координата центра окружности');

 Writeln('X0e=',X0e:9:5,' - X координата центра эллипса');

 Writeln('Y0e=',Y0e:9:5,' - Y координата центра эллипса');

 Writeln;

 Step:=1;

 X1:=X0e-Ae;

 For i:=1 to 5 do

  begin

   Step:=Step/10;

   Repeat

    X1:=X1+Step;

    Y1:=Y0e+Be*Sqrt(1-sqr((X1-X0e)/Ae));

   Until Sqr(X1-X0c)+Sqr(Y1-Y0c)>Sqr(R);

   X1:=X1-Step;

  end;

 Y1:=Y0e+Be*Sqrt(1-sqr((X1-X0e)/Ae));

 Writeln('X1= ',X1:9:5,' - X координата первой точки пересечения');

 Writeln('Y1= ',Y1:9:5,' - Y координата первой точки пересечения');

 Y2:=0;

 X2:=X0e+Ae*Sqrt(1-sqr(Y0e/Be));

 Writeln('X2= ',X2:9:5,' - X координата второй точки пересечения');

 Writeln('Y2= ',Y2:9:5,' - Y координата второй точки пересечения');

 Step:=1;

 X3:=X2;

 For i:=1 to 5 do

  begin

   Step:=Step/10;

   Repeat

    X3:=X3+Step;

    Y3:=Ysl(X3);

   Until Sqr(X3-X0c)+Sqr(Y3-Y0c)>Sqr(R);

   X3:=X3-Step;

  end;

 Y3:=Ysl(X3);

 Writeln('X3= ',X3:9:5,' - X координата третьей точки пересечения');

 Writeln('Y3= ',Y3:9:5,' - Y координата третьей точки пересечения');

 Writeln;

 Writeln('Нажмите "Enter" для продолжения...');

 Readln;

 ClrScr;

 k:=0;

 Repeat

  Write('Введите количество точек (0 для выхода из программы) ');

  Readln(N);

  If N>0 then

   Begin

    ClrScr;

    Inc(k);

    Np[k]:=N;

    For i:=1 to 58 do Write('-');

    Writeln;

    Writeln('| Число разбиений |              Результат               |');

    Writeln('|                 |--------------------------------------|');

    Writeln('|       n         |      A     |      B     |     C      |');

    For i:=1 to 58 do Write('-');

    Writeln;

    Rect[k]:=Rectangle1+Rectangle2+Rectangle3;

    Trap[k]:=Trapezium1+Trapezium2+Trapezium3;

    Simp[k]:=Simpson1+Simpson2+Simpson3;

    For i:=1 to k do

     Writeln('|     ',Np[i]:4,'        |',Rect[i]:12:6,'|',Trap[i]:12:6,'|',Simp[i]:12:6,'|');

    For i:=1 to 58 do Write('-');

    Writeln;

   End;

 Until N=0;

END.

Цитата:

Сообщение от shrek=) (Сообщение 646057)

Что думать о других педагогах?

Миша, а зачем о них думать? Нужно как на аватарке! :D:D:D

Цитата:

Сообщение от Vladimir_S (Сообщение 646087)

Ну вот, первая (черт, весь день с этой ерундой провозился):

Vladimir_S, Вы просто гений! Спасибо огромноееееее! Склоняю свою глупую голову перед Вашим мастерством!

Второе задание (тут возможно потребуется правка; подробно - после листинга):

Код:

Uses CRT;

Const

 M=20;

 N=10;

 Vow=['A','E','I','O','U','Y'];

VAR

 W:Array[1..M,1..N] of String;

 i,j,k,N2v,q:Integer;

 Lng:Array[1..M,1..N] of Byte;

 C:Set of Byte;

 b:Boolean;



BEGIN

 C:=[];

 Randomize;

 ClrScr;

 TextColor(7);

 Writeln('Initial Array:');

 Writeln;

 For i:=1 to M do

  Begin

   For j:=1 to N do

    begin

     Lng[i,j]:=2+Random(5);

     W[i,j]:='';

     For k:=1 to Lng[i,j] do

      W[i,j]:=W[i,j]+Chr(65+Random(26));

     Write(W[i,j]:7);

    end;

   Writeln;

  End;

 Writeln('Press "Enter" to continue...');

 Readln;

 ClrScr;

 N2v:=0;

 Writeln('Words containing 2 vowels are red:');

 For i:=1 to M do

  Begin

   For j:=1 to N do

    begin

     q:=0;

     For k:=1 to Lng[i,j] do

      If W[i,j][k] in Vow then Inc(q);

     If q=2 then

      begin

       Inc(N2v);

       textcolor(12);

       Write(W[i,j]:7);

      end

     else

      begin

       textcolor(7);

       Write(W[i,j]:7);

      end;

    end;

   Writeln;

  End;

  Textcolor(7);

 Writeln(N2v,' words');

 Writeln('Press "Enter" to continue...');

 Readln;

 ClrScr;

 N2v:=0;

 Writeln('Words in columns containing at least 1 word finishing with vowel (blue):');

 For j:=1 to N do

  begin

   b:=false;

   i:=0;

   Repeat

    Inc(i);

    If W[i,j][Lng[i,j]] in Vow then b:=true;

   Until b or (i=M);

   If b then C:=C+[j];

  end;

 For i:=1 to M do

  Begin

   For j:=1 to N do

    begin

     If j in C then

      begin

       Inc(N2v);

       textcolor(1);

       Write(W[i,j]:7);

      end

     else

      begin

       textcolor(7);

       Write(W[i,j]:7);

      end;

    end;

   Writeln;

  End;

 Textcolor(7);

 Writeln(N2v,' words');

 Readln;

End.

Возможные исправления связаны с тем, что я использую черный DOS-экран низкого разрешения, и указанное количество слов у меня в него не лезет. Если у Вас этого ограничения нет, то следует строку
Lng[i,j]:=2+Random(5);
заменить на
Lng[i,j]:=2+Random(6);
и во всех трёх выводах массива вместо строк
Write(W[i,j]:7);
записать
Write(W[i,j]:8);
Далее, если у Вас экран не черный, а белый, то, вероятно, всюду строку
textcolor(7);
следует заменить на
textcolor(0);

Цитата:

Сообщение от brokilone (Сообщение 646108)

Vladimir_S, Вы просто гений!

А? Да-да, я знаю... :D:D:D

Цитата:

Сообщение от Vladimir_S (Сообщение 646185)

Второе задание (тут возможно потребуется правка; подробно - после листинга):

:tehnari_ru_288:
ААААА Спасибо-спасибо, пойду разбираться!!!