Форум программистов, компьютерный форум, киберфорум
Massaraksh7
Войти
Регистрация
Восстановить пароль
Библиотека матвычислений на Delphi.
Здесь будут публиковаться рабочие процедуры, выполняющие различные математические вычисления.

Интересная функция

Запись от Massaraksh7 размещена 20.03.2024 в 00:14
Показов 1434 Комментарии 3

Нашёл забавную функцию, график которой при изменении параметра причудливо меняет форму, напоминая то ли сокращающееся сердце, то ли ещё что. Функция в декартовых координатах неявная, поэтому график строится через преобразование в полярные координаты, и решение кубического уравнения.
(x2+y2)2-A*x*y2=850*y
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  ExtCtrls, TAGraph, TASeries, Math;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Chart1: TChart;
    Chart1LineSeries1: TLineSeries;
    Image1: TImage;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    procedure FormShow(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
  ak:integer;
  procedure DoGraph;
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
//-------Решение куб. уравнения по формуле Кардано
function Kardano(a,b,c,d:Extended):Extended;
var p,q,qq,alfa,beta:Extended;
begin
p:=(3*a*c-b*b)/(3*a*a);
q:=(2*b*b*b-9*a*b*c+27*a*a*d)/(27*a*a*a);
qq:=p*p*p/27+q*q/4;
if qq>0 then
   begin
   alfa:=power(-q/2+Sqrt(qq),1/3);
   beta:=power(-q/2-Sqrt(qq),1/3);
   Result:=alfa+beta;
   end;
if qq=0 then Result:=0;
if qq<0 then Result:=0;
end;
 
//------Функция в полярных коррдинатах сводится к решению куб. уравнения
function MyFunc(ap,fi:Extended):Extended;
var cf,sf,x:Extended;
a,b,c,d:Extended;
begin
a:=1;
cf:=cos(fi*PI/180);sf:=sin(fi*PI/180);
b:=ap*cf*sf*sf;
c:=0;
d:=-850*sf;
Result:=Kardano(a,b,c,d);
end;
 
//-----------График функции (x^2+y^2)^2+-a*x*y^2=850y    -43<=a<=43
//-----------Полярн.коорд r^3+-a*cos(ф)*sin^2(ф)*r^2-850*sin(ф)=0;     r=f(ф)
procedure TForm1.DoGraph;
var i:integer;
r,x,y:Extended;
begin
Chart1LineSeries1.Clear;
if ak<0 then Chart1LineSeries1.LinePen.Color:=clRed else Chart1LineSeries1.LinePen.Color:=clBlue;
for i:=0 to 180 do
   begin
   r:=MyFunc(Form1.ak,i);
   x:=r*cos(i*PI/180);
   y:=r*sin(i*PI/180);
   if i=0 then begin x:=0;y:=0;r:=0;end;
   Chart1LineSeries1.AddXY(x,y);
   end;
end;
 
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
ak:=TrackBar1.Position;
Label1.Caption:='a='+IntToStr(ak);
DoGraph;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
ak:=0;DoGraph;
end;
 
end.
Миниатюры
Нажмите на изображение для увеличения
Название: Func.gif
Просмотров: 206
Размер:	1.50 Мб
ID:	8572  
Размещено в Без категории
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Всего комментариев 3
Комментарии
  1. Старый комментарий
    Аватар для gunslinger
    На тему "сердца": https://www.cyberforum.ru/cpp-... 91822.html
    Запись от gunslinger размещена 20.03.2024 в 02:05 gunslinger вне форума
  2. Старый комментарий
    Аватар для Massaraksh7
    Цитата Сообщение от gunslinger
    На тему "сердца": https://www.cyberforum.ru/cpp-... 91822.html
    Да, кардиоида-то известна ещё с 18 века. А вот "действующая модель" - это, действительно, забавно. )))
    Запись от Massaraksh7 размещена 20.03.2024 в 03:08 Massaraksh7 вне форума
  3. Старый комментарий
    Аватар для gunslinger
    Я хотел сказать, что "сердце" тоже можно анимировать.
    Запись от gunslinger размещена 20.03.2024 в 09:58 gunslinger вне форума
 
Новые блоги и статьи
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
Программа опроса у.з. расходомера SLS-720F
Argus19 02.09.2026
Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
Как у меня протекала болезнь
zorxor 27.08.2026
Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .
Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему
kumehtar 26.08.2026
ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru