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

brokilone · 3 Янв 2012

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

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

Vladimir_S · 4 Янв 2012

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

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

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

AlexZir · 4 Янв 2012

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

shrek=) · 4 Янв 2012

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

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

Vladimir_S · 4 Янв 2012

brokilone написал(а):
Нужно написать две слишком сложные для меня программы в 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.

Vladimir_S · 4 Янв 2012

shrek=) написал(а):
Что думать о других педагогах?

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

brokilone · 4 Янв 2012

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

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

Vladimir_S · 4 Янв 2012

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

Код:

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);

Vladimir_S · 4 Янв 2012

brokilone написал(а):
Vladimir_S, Вы просто гений!

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

brokilone · 4 Янв 2012

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

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

brokilone · 7 Янв 2012

Vladimir_S,
Я, видимо, совсем не разбираюсь в Паскале, третий день изучаю код программ, которые Вы мне написали. Я Вам очень благодарна, но если Вас не очень сильно затруднит, не могли бы Вы дать краткие комментарии к программам. А то я даже не знаю, за что схватиться в первую очередь, чтобы разобраться.:tehnari_ru_121:

Vladimir_S · 7 Янв 2012

brokilone написал(а):
Vladimir_S,
Я, видимо, совсем не разбираюсь в Паскале, третий день изучаю код программ, которые Вы мне написали. Я Вам очень благодарна, но если Вас не очень сильно затруднит, не могли бы Вы дать краткие комментарии к программам. А то я даже не знаю, за что схватиться в первую очередь, чтобы разобраться.:tehnari_ru_121:

Сочиняю трактат, подождите. Надеюсь, впрочем, что со второй задачкой разберетесь - там всё просто.

brokilone · 7 Янв 2012

Спасибо-спасибо, жду сколько потребуется:tehnari_ru_942:

Vladimir_S · 7 Янв 2012

brokilone написал(а):
Vladimir_S,
Я, видимо, совсем не разбираюсь в Паскале, третий день изучаю код программ, которые Вы мне написали. Я Вам очень благодарна, но если Вас не очень сильно затруднит, не могли бы Вы дать краткие комментарии к программам. А то я даже не знаю, за что схватиться в первую очередь, чтобы разобраться.:tehnari_ru_121:

Охо-хо, вспоминать надо, уже подзабыл. Ну ладно.
Итак, смотрим на рисунок:

Что требуется сделать, чтобы сосчитать искомые (зеленые) площади? Вообще-то очень много чего:
1. Найти уравнения окружности и эллипса.
2. Определить координаты точки пересечения окружности с эллипсом, а также эллипса с осью Х.
3. Провести (в смысле найти уравнение) прямую через две эти точки.
4. Найти координаты правой точки пересечения прямой с окружностью.
5. Найти площади, для чего мысленно разбить ось Х на 3 участка:
I ) От точки пересечения окружности и эллипса до 0.
II ) От 0 до точки пересечения эллипса с положительной полуосью Х.
III) От точки пересечения эллипса с положительной полуосью Х до правой точки пересечения окружности и прямой.
При вычислении интегралов по областям II и III не забываем изменить знак: Y там отрицательный, площадь же, естественно, должна быть положительной.
Итак, решаем в перечисленном порядке.
1. Ищем координаты центра окружности (X0c, Y0c). Считая, что через точку Х=32 проходит касательная к окружности, параллельная оси Y, сразу устанавливаем, что X0c=-1. Далее, зная, что окружность проходит через точку (0, -40), из уравнения окружности
(X-X0c)² + (Y-Y0c)² = R²
находим Y0c.
Аналогично поступаем и с центром эллипса (X0e, Y0e). Кстати, как водится в методичках, на рисунке в надписи полуоси перепутаны: вдоль оси Х идет малая полуось (а=16), а вдоль оси Y - большая (b=38). Из этого и будем исходить. Здесь сразу находим Y0e=+2, и из уравнения эллипса
{(X-X0e)/a}² + {(Y-Y0e)/b}² = 1
находим X0e.
2. Точку пересечения (слева) окружности и эллипса находим численно. Тут я вынужден оговориться: предписанных в методичке способов не знаю, а потому решаю, как мне удобно и как я привык. Суть: стартуя с точки Х=-21 идем по оси Х вправо с шагом 1, каждый раз вычисляя расстояние между точкой левой верхней четверти эллипса с координатами (X, Y - Y находим, подставляя Х в уравнение эллипса) и центром окружности, до тех пор, пока это расстояние не станет большим R. Тогда "отпрыгиваем" на 1 шаг назад, мельчим шаг в 10 раз и повторяем процедуру. При этом каждая такая итерация добавляет следующую значащую десятичную цифру в результат. В программе делается 5 итераций.
Аналогично в дальнейшем находятся координаты правой точки пересечения окружности с прямой.
Координата Х точки пересечения эллипса с положительной полуосью Х находится из уравнения эллипса путем подстановки Y=0.
Итак, все точки пересечения определены.
3. Уравнение прямой, проходящей через 2 заданные точки, описано в функции Ysl(Xsl). Кстати, функции Ycr1, Ycr2 и Yel описывают уравнение левой верхней части окружности, правой нижней части ее же и левой верхней части эллипса, соответственно (прочие квадранты этих фигур нас не интересуют).
4. Алгоритм поиска координат правой точки пересечения окружности и прямой описан выше в п.2. В принципе, тут можно было и аналитически, благо одно из уравнений системы - линейное, да мне, извините, лень было возиться с этими многоэтажными радикалами.
5. Для поиска площадей определяем функции, которые будем интегрировать. На учаске I это разность между Y-координатами окружности и прямой - функция F1. На участке II - между окружностью и эллипсом, но, поскольку требуется поменять знак, в качестве F2 берем разность между эллипсом и окружностью. Аналогично на участке III - там функция F3 - это разность между прямой и окружностью.
Функции Rectangle1, Rectangle2, Rectangle3, Trapezium1, Trapezium2, Trapezium3, Simpson1, Simpson2, Simpson3 - это вычисление самих интегралов методами прямоугольников, трапеций и Симпсона для областей I, II и III.
Складываем полученные результаты, оформляем таблицу.
Вроде всё.
Спрашивайте, если что непонятно.

brokilone · 7 Янв 2012

Vladimir_S написал(а):
Охо-хо, вспоминать надо, уже подзабыл. Ну ладно.

Спасибо, ситуация начинает проясняться.
Но в связи с этими пояснениями у меня закрались сомнения в правильности написания мной еще одной работы.
Не хочу злооупотреблять Вашим временем, но прошу при возможности взглянуть на это мое творение (суть задачи и код во вложении).

Vladimir_S · 7 Янв 2012

brokilone написал(а):
Но в связи с этими пояснениями у меня закрались сомнения в правильности написания мной еще одной работы.

Посмотрел. Программу не запускал, но вроде, на взгляд, всё правильно. Вот только...
1. Откуда взялись уравнения фигур? Дело в том, что они не вполне соответствуют рисунку. К примеру, на рисунке окружность проходит через точку (0, -40). Попробуйте подставить эти координаты в приведенное уравнение, и вместо радиуса 33 Вы получите 32 с копейками. Ну ладно, будем считать уравнения правильными.
2. Это уже не к Вам, но удержаться не могу - просто клокочу от ярости. Уже десятки лет тому (а точнее с конца 60-х), как сообщество программистов выработало основные принципы современного структурного программирования, наиглавнейшим из которых является НЕИСПОЛЬЗОВАНИЕ GoTo. В современных языках, тем не менее, этот оператор присутствует, но рассматривается, как применяемый в очень ограниченном числе особых случаев. И вот на тебе: эти горе-преподаватели требуют от студентов составления программ с goto да метками, в то время, как реализовать тот же алгоритм через операторы Repeat-Until или While-Do не представляет абсолютно никаких сложностей, и получится программа с нормальной структурой, а не "лапша". Зло берет прямо. Но, повторяю, к Вам это не относится.
Удачи!

brokilone · 7 Янв 2012

Спасибо, что посмотрели!

Jekich · 23 Янв 2012

Здравствуйте. Имеется аналогичная задача по нахождению площади фигур. Код программы не получилось переделать под мой вариант. Xc и Yc находил сам математически на бумаге. Завис на нахождении точек 1, 2, 3, 4 - пересечения прямой и так подозреваю далее надо что то ещё в коде программы менять. X0e поставил своё подсчитанное число -8, так как не мог понять как считает формула.

Код:

Uses CRT;
Const
 Xc=37.0;
 Yc=-39.0;
 Xe=-43.0;
 Ye=30.66;
 R=35.0;
 Ae=35.0;
 Be=25.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:=2.0;
 Y0c:=Yc+Sqrt(sqr(R)-sqr(X0c));
 Y0e:=-5.66;
 X0e:=-8;
 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.

Помогите пожалуйста.
Вот изображение с заданием.

Jekich · 24 Янв 2012

Помогите пожалуйста...

Vladimir_S · 25 Янв 2012

Jekich написал(а):
Помогите пожалуйста...

Хорошо, я адаптировал программу к вашему рисунку. Только вот не знаю, есть ли в том прок. Видите ли, задача очень не простая, и сомневаюсь, что Вы сумеете разобраться. Тем более, что эта задача уже такого класса, что тут проще написать программу самому, чем разбираться в чужой. Но попробуйте.
На всякий случай - о нумерации точек пересечения. Точка 1 (координаты X1, Y1) - это левое пересечение окружности с эллипсом, точка 2 - самое правое пересечение окружности с осью "Х". Прямая проведена через точки 1 и 2. Точка 3 расположена между точками 1 и 2 и является точкой пересечения прямой и эллипса.
Область с искомой площадью разбита не на 3, как в предыдущем случае, а на 4 участка вдоль оси Х. Идем слева на право:
I. От левой точки пересечения окружности с осью "Х" до Х1.
II. От Х1 до Х=0.
III. От Х=0 до Х3.
IV. От Х3 до Х2.
Все надписи и экранные сообщения во избежание проблем с кодировками даны на английском языке.

Код:

Uses CRT;
Const
 R=35.0;
 Ae=35.0;
 Be=25.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 Ycr(Xcr:Real):Real;
begin
 Ycr:=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:=-Ycr(Xf);
end;

Function F2(Xf:Real):Real;
begin
 F2:=-Ysl(Xf);
end;

Function F3(Xf:Real):Real;
begin
 F3:=Yel(Xf)-Ycr(Xf);
end;

Function F4(Xf:Real):Real;
begin
 F4:=Ysl(Xf)-Ycr(Xf);
end;

Function Rectangle1:Real;
var
 i:Integer;
 Sum,h,a,b:Real;
begin
 a:=X0c-Sqrt(sqr(R)-sqr(Y0c));
 b:=X1;
 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:=X1;
 b:=0;
 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:=0;
 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 Rectangle4:Real;
var
 i:Integer;
 Sum,h,a,b:Real;
begin
 a:=X3;
 b:=X2;
 h:=(b-a)/N;
 Sum:=0;
 for i:=0 to N-1 do
  Sum:=Sum+h*F4(a+h*i);
 Rectangle4:=Sum;
end;

Function Trapezium1:Real;
var
 i:Integer;
 Sum,h,a,b:Real;
begin
 a:=X0c-Sqrt(sqr(R)-sqr(Y0c));
 b:=X1;
 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:=X1;
 b:=0;
 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:=0;
 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 Trapezium4:Real;
var
 i:Integer;
 Sum,h,a,b:Real;
begin
 a:=X3;
 b:=X2;
 h:=(b-a)/N;
 Sum:=(F4(a)+F4(b))/2*h;
 for i:=1 to N-1 do
  Sum:=Sum+h*F4(a+h*i);
 Trapezium4:=Sum;
end;

Function Simpson1:Real;
var
 i,Ns:Integer;
 Sum,h,a,b:Real;
begin
 a:=X0c-Sqrt(sqr(R)-sqr(Y0c));
 b:=X1;
 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:=X1;
 b:=0;
 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:=0;
 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;

Function Simpson4:Real;
var
 i,Ns:Integer;
 Sum,h,a,b:Real;
begin
 a:=X3;
 b:=X2;
 Ns:=N div 2;
 h:=(b-a)/(2*Ns);
 Sum:=(F4(a)+F4(b))/3*h;
 for i:=1 to Ns do
  Sum:=Sum+4.0*h/3.0*F4(a+h*(2*i-1));
 for i:=2 to Ns do
  Sum:=Sum+2.0*h/3.0*F4(a+h*(2*i-2));
 Simpson4:=Sum;
end;

BEGIN
 ClrScr;
 X0c:=2.0;
 Y0c:=-39+Sqrt(sqr(R)-sqr(X0c));
 X0e:=-8.0;
 Y0e:=-30+Be*Sqrt(1.0-sqr(X0e/Ae));
 Writeln('X0c=',X0c:9:5,' - X circle center coordinate');
 Writeln('Y0c=',Y0c:9:5,' - Y circle center coordinate');
 Writeln('X0e=',X0e:9:5,' - X ellipse center coordinate');
 Writeln('Y0e=',Y0e:9:5,' - Y ellipse center coordinate');
 Writeln;
 Step:=-1;
 X1:=0;
 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 first crossing point coordinate');
 Writeln('Y1= ',Y1:9:5,' - Y first crossing point coordinate');
 Y2:=0;
 X2:=X0c+Sqrt(sqr(R)-sqr(Y0c));
 Writeln('X2= ',X2:9:5,' - X second crossing point coordinate');
 Writeln('Y2= ',Y2:9:5,' - Y second crossing point coordinate');
 Step:=1;
 X3:=0;
 For i:=1 to 5 do
  begin
   Step:=Step/10;
   Repeat
    X3:=X3+Step;
    Y3:=Ysl(X3);
   Until Sqr((X3-X0e)/Ae)+Sqr((Y3-Y0e)/Be)>1;
   X3:=X3-Step;
  end;
 Y3:=Ysl(X3);
 Writeln('X3= ',X3:9:5,' - X third crossing point coordinate');
 Writeln('Y3= ',Y3:9:5,' - Y third crossing point coordinate');
 Writeln;
 Writeln('Press "Enter" to continue...');
 Readln;
 ClrScr;
 k:=0;
 Repeat
  Write('Enter the number of points (0 to exit the program) ');
  Readln(N);
  If N>0 then
   Begin
    ClrScr;
    Inc(k);
    Np[k]:=N;
    For i:=1 to 58 do Write('-');
    Writeln;
    Writeln('| Number of points|                Result                |');
    Writeln('|                 |--------------------------------------|');
    Writeln('|       n         |      A     |      B     |     C      |');
    For i:=1 to 58 do Write('-');
    Writeln;
    Rect[k]:=Rectangle1+Rectangle2+Rectangle3+Rectangle4;
    Trap[k]:=Trapezium1+Trapezium2+Trapezium3+Trapezium4;
    Simp[k]:=Simpson1+Simpson2+Simpson3+Simpson4;
    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.

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

Новые

Вложения

Ученик

support

Студент БГПУ

Ученик

Ученик

Новые

Ученик

Ученик

Новые

Новые

Ученик

Новые

Ученик

Новые

Вложения

Ученик

Новые

Ученик

Вложения

Ученик

Ученик