Текущий архив: 2017.09.24;
Скачать: CL | DM;

Вниз

Помогите вычислить тенденцию   Найти похожие ветки 

← →
Twister   (2015-10-13 13:40) [0]

Никак не могу сообразить.
Допустим есть числа
85
83
81
76
73
82
76
69
62
58
к примеру, как можно определить, что допустим идет тенденция на уменьшение ну или на увеличение и какой-нибудь коэфициент получить этой тенденции? допустим с 5 по 12 число, было уменьшение и скорость или прогресс уменьшения допустим равно стока-то, а с чисел с 3 по 10 стока-то? а лучше не с такого-то числа по такойто, а например с 5 по 12 числа, прогресс уменьшение относительно числа 70 было, вверх или вниз с таким-то коэффициентом?
что-то башку уже сломал всю.
чисел конечно может быть произвольное кол-во.

---

← →
Sha ©   (2015-10-13 15:38) [1]

Если по-простому, то на каждом шагу пересчитываешь что-нибудь вроде
sum:=p*delta[i]+(1-p)*sum;
где: p=(0..1), delta[i]=x[i]-x[i-1]

---

← →
Twister   (2015-10-13 15:43) [2]

Если по-простому, то на каждом шагу пересчитываешь что-нибудь вроде
sum:=p*delta[i]+(1-p)*sum;
где: p=(0..1), delta[i]=x[i]-x[i-1]

что-то не понял, p это или 0 или 1 или считать оба варианта?
и в самой формуле *sum от предыдущего расчета? а как быть с самым первым расчетом? sum = 0?

---

← →
Sha ©   (2015-10-13 16:28) [3]

Twister   (13.10.15 15:43) [2]

var
 sum, p: double;

p - вес первого слагаемого в диапазоне от 0 до 1
(1-p) - вес второго слагаемого
в начале sum=0

---

← →
Twister   (2015-10-13 16:43) [4]

или я не догоню или еще что-то, что значит вес? как выбирать 0 или 1?

можешь просто пример с расчетами в цифрах написать?

---

← →
Palladin ©   (2015-10-13 17:14) [5]

код ему напиши, а то умничаешь тут

---

← →
Token   (2015-10-14 11:04) [6]

Производную найти? Сразу будут видны минимумы, максимумы и скорость.

---

← →
ВладОшин ©   (2015-10-16 09:13) [7]

если массив
х1
х2
х3
..

добить до матрицы
х1  (x1-x2) (x1-x3) ..
х2  (x2-x1) (x2-x3) ..
х3  (x3-x1) (x3-x1) ..
..

то тенденция от Хn до Хm будет сумма в соотв. строки от n до m
а коэффициент эта сумма на кол-во слагаемых

---

← →
Twister   (2015-10-18 08:40) [8]

Что-то не получается с этой матрицей:

[1]21.00->{0.00}{-1.00}{1.00}{1.00}{5.50}{5.50}{5.50}{5.50}{6.50}{6.50}==36.00
[2]21.00->{0.00}{-1.00}{1.00}{1.00}{5.50}{5.50}{5.50}{5.50}{6.50}{6.50}==36.00
[3]22.00->{1.00}{1.00}{2.00}{2.00}{6.50}{6.50}{6.50}{6.50}{7.50}{7.50}==47.00
[4]20.00->{-1.00}{-1.00}{-2.00}{0.00}{4.50}{4.50}{4.50}{4.50}{5.50}{5.50}==25.00
[5]20.00->{-1.00}{-1.00}{-2.00}{0.00}{4.50}{4.50}{4.50}{4.50}{5.50}{5.50}==25.00
[6]15.50->{-5.50}{-5.50}{-6.50}{-4.50}{-4.50}{0.00}{0.00}{0.00}{1.00}{1.00}==-24.50
[7]15.50->{-5.50}{-5.50}{-6.50}{-4.50}{-4.50}{0.00}{0.00}{0.00}{1.00}{1.00}==-24.50
[8]15.50->{-5.50}{-5.50}{-6.50}{-4.50}{-4.50}{0.00}{0.00}{0.00}{1.00}{1.00}==-24.50
[9]15.50->{-5.50}{-5.50}{-6.50}{-4.50}{-4.50}{0.00}{0.00}{0.00}{1.00}{1.00}==-24.50
[10]14.50->{-6.50}{-6.50}{-7.50}{-5.50}{-5.50}{-1.00}{-1.00}{-1.00}{-1.00}{0.00}==-35.50
[11]14.50->{-6.50}{-6.50}{-7.50}{-5.50}{-5.50}{-1.00}{-1.00}{-1.00}{-1.00}{0.00}==-35.50

Их сумма всегда равна 0

---

← →
han_malign ©   (2015-10-19 17:23) [9]

Аппрксимация (линейной) функцией, метод наименьших квадратов???
http://www.cleverstudents.ru/articles/mnk.html

---

← →
Twister   (2015-10-20 21:59) [10]

да вроде не оно

---

← →
Dmk ©   (2015-10-22 09:36) [11]

Можно так, только немного доработать надо. В начале 2 варианта массивов.
unit Unit2;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math;

type
 TForm2 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
   procedure FormShow(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;
 Input: array[0..17] of integer = (85,83,81,76,73,82,76,69,62,60,55,50,47,45,34,55,67,88);//Упадок
 //Input: array[0..19] of integer = (85,80,85,90,85,80,85,90,85,80,85,90,85,80,85,90,85,80,85,90);//Стабильность
 //Input: array[0..17] of integer = (85,86,87,85,89,90,76,85,90,91,92,94,97,79,81,87,90,96);//Возрастание
 aMin: array of integer;
 aMax: array of integer;
 MinLen: integer;
 MaxLen: integer;

const
 InputSize: integer = Length(Input);

implementation

{$R *.dfm}

procedure MinMax;
var
 A: integer;
 B: integer;
 Pos: integer;
 __fall: boolean;
 __raise: boolean;
 __stability: boolean;
 arrSize: integer;

begin
 Pos := 0;
 arrSize := (InputSize - 1);
 __stability := false;

 //Считаем первый элемент максимумом
 while Pos <= arrSize do
 begin
   //Текущий элемент
   A := Input[Pos];
   Inc(MaxLen);
   SetLength(aMax, MaxLen);
   aMax[MaxLen - 1] := A;
   Inc(Pos);
   if Pos > arrSize then break;

   //Следующий элемент
   B := Input[Pos];

   //Тенденция стабильна
   if B = A then __stability := True;
   if __stability then Continue;

   //Если на следующем элементе падение
   if B < A then
   begin
     __fall := true;

     while __fall do
     begin
       B := Input[Pos];
       Inc(Pos);
       if Pos > arrSize then
         __fall := false else
         __fall := Input[Pos] < B;
     end;

     //Элемент конца падения
     Inc(MinLen);
     SetLength(aMin, MinLen);
     aMin[MinLen - 1] := B;
   end//Падение
   else
   //Если на следующем элементе возрастание
   if B > A then
   begin
     __raise := true;

     while __raise do
     begin
       B := Input[Pos];
       Inc(Pos);
       if Pos > arrSize then
         __raise := false else
         __raise := Input[Pos] > B;
     end;
   end;//Возрастание
 end;//while Pos
end;//proc

procedure TForm2.Button1Click(Sender: TObject);
var
 x1, y1: integer;
 x2, y2: integer;
 TotalLen: integer;
 Len: integer;
 MinPos, MaxPos: integer;
 sr2: array of integer;
 Tend: array of integer;
 TendSum: integer;
 d1, d2: integer;
 inv: integer;
 gap: integer;

begin
 MinMax;

 Canvas.Pen.Color := clRed;
 Canvas.Pen.Style := psSolid;
 Canvas.Pen.Width := 2;

 TotalLen := MinLen + MaxLen;

 Len := 1;
 MaxPos := 0;
 MinPos := 0;

 while Len <= TotalLen do
 begin
   SetLength(sr2, Len);
   if MinLen <> 0 then
   begin
     if Odd(Len) then
     begin
       sr2[Len - 1] := aMax[MaxPos];
       Inc(MaxPos);
       Inc(Len);
     end
     else
     begin
       sr2[Len - 1] := aMin[MinPos];
       Inc(MinPos);
       Inc(Len);
     end;
   end else
   begin
     //Скорее всего стабильность
     sr2[Len - 1] := aMax[MaxPos];
     Inc(MaxPos);
     Inc(Len);
   end;
 end;

 SetLength(Tend, TotalLen - 1);
 Len := 0;
 while Len <> (TotalLen - 1) do
 begin
   d1 := sr2[Len];
   d2 := sr2[Len + 1];

   if d1 = d2 then
   begin
     Tend[Len] := 0;
     Inc(Len);
   end
   else
   begin
     if odd(Len) then
       Tend[Len] :=  Max(d1, d2) - Min(d1, d2) else
       Tend[Len] :=  Min(d1, d2) - Max(d1, d2);
     Inc(Len);
   end;
 end;

 TendSum := 0;

 for Len := 0 to (Length(Tend) - 1) do
 begin
   TendSum := TendSum + Tend[Len];
 end;

 if TendSum > 0 then Caption := "Возрастание";
 if TendSum = 0 then Caption := "Стабильность";
 if TendSum < 0 then Caption := "Упадок";

//Рисуем график
 Len := 0;
 inv := 200;
 gap := 30;

 MinPos := 0;
 MaxPos := 0;

 while Len <= TotalLen do
 begin

   if MaxPos < MaxLen then
   begin
     x1 := gap + Len * gap;
     y1 := aMax[MaxPos];
     if Len = 0 then
     begin
       if TendSum < 0 then
         Canvas.MoveTo(x1, inv - y1) else
         Canvas.MoveTo(x1, y1);
     end
     else
     begin
       if TendSum < 0 then
       Canvas.LineTo(x1, inv - y1) else
       Canvas.LineTo(x1, y1);
     end;

     Inc(MaxPos);
     Inc(Len);

     if MinPos < MinLen then
     begin
       x2 := gap + Len * gap;
       y2 := aMin[MinPos];
       if TendSum < 0 then
         Canvas.LineTo(x2, inv - y2) else
         Canvas.LineTo(x2, y2);
       Inc(MinPos);
     end;
   end;

   Inc(Len);
 end;//while
end;

procedure TForm2.FormShow(Sender: TObject);
begin
 ClientWidth := 500;
 ClientHeight := 300;
end;

end.


---

← →
Игорь Шевченко ©   (2015-10-22 10:34) [12]

Dmk ©   (22.10.15 09:36) [11]


> только немного доработать надо


Это не надо дорабатывать, это надо выбросить.

---

← →
Dmk ©   (2015-10-22 16:51) [13]

Игорь Шевченко ©   (22.10.15 10:34) [12]

Это работает.

---

← →
Игорь Шевченко ©   (2015-10-22 18:58) [14]

> Это работает.


Все равно, выбросить

---

← →
Dmk ©   (2015-10-22 20:18) [15]

>Все равно, выбросить
И так не годится?

unit Unit2;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math;

type
 TForm2 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;
 Input1: array[0..17] of integer = (85,83,81,76,73,82,76,69,62,60,55,50,47,45,34,55,67,88);//Возрастание
 Input2: array[0..18] of integer = (85,80,85,90,85,80,85,90,85,80,85,90,85,80,85,90,85,80,85);//Стабильность
 Input3: array[0..17] of integer = (85,84,81,80,89,82,76,75,72,80,82,75,74,73,56,50,48,80);//Упадок
 sr2: array of integer;

implementation

{$R *.dfm}

procedure MinMax(const AInput: array of integer);
var
 A: integer;
 B: integer;
 Pos: integer;
 arrEnd: integer;
 sr2End: integer;
 sum: integer;
 sumStr: string;
 d: integer;
 InputSize: integer;

begin
 Pos := 0;
 InputSize := Length(AInput);
 arrEnd := (InputSize - 1);
 sr2End := arrEnd - 1;
 SetLength(sr2, arrEnd);

 for Pos := 0 to sr2End do
 begin
   //Текущий элемент
   A := AInput[Pos];

   //Следующий элемент
   B := AInput[Pos + 1];

   //Идет возрастание
   if B > A then sr2[Pos] := (B - A);

   //Идет убывание
   if A > B then sr2[Pos] := (B - A);
 end;//for

 sum := 0;

 for Pos := 0 to sr2End do
 begin
   d := sr2[Pos];
   sum := sum + d;
   if d > 0 then
     sumStr := SumStr + "+" + IntToStr(d) else
     sumStr := SumStr + IntToStr(d);
   if Pos <> sr2End then sumStr := sumStr + ", ";
 end;

 sumStr := sumStr + ".";

 if Sum > 0 then ShowMessage("Возрастание: " + " " + IntToStr(sum) + #13 + sumStr);
 if Sum = 0 then ShowMessage("Стабильность: " + " " + IntToStr(sum) + #13 + sumStr);
 if Sum < 0 then ShowMessage("Упадок: " + " " + IntToStr(sum) + #13 + sumStr);
end;//proc

procedure TForm2.Button1Click(Sender: TObject);
begin
 MinMax(Input1);
 MinMax(Input2);
 MinMax(Input3);
end;

end.

---

← →
Dmk ©   (2015-10-22 20:25) [16]

Даже еще короче и проще:
unit Unit2;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math;

type
 TForm2 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;
 Input1: array[0..17] of integer = (85,83,81,76,73,82,76,69,62,60,55,50,47,45,34,55,67,88);//Возрастание
 Input2: array[0..18] of integer = (85,80,85,90,85,80,85,90,85,80,85,90,85,80,85,90,85,80,85);//Стабильность
 Input3: array[0..17] of integer = (85,84,81,80,89,82,76,75,72,80,82,75,74,73,56,50,48,80);//Упадок
 sr2: array of integer;

implementation

{$R *.dfm}

procedure MinMax(const AInput: array of integer);
var
 A: integer;
 B: integer;
 Pos: integer;
 arrEnd: integer;
 sr2End: integer;
 sum: integer;
 sumStr: string;
 d: integer;
 InputSize: integer;

begin
 Pos := 0;
 sum := 0;
 InputSize := Length(AInput);
 arrEnd := (InputSize - 1);
 sr2End := arrEnd - 1;
 SetLength(sr2, arrEnd);

 for Pos := 0 to sr2End do
 begin
   A := AInput[Pos];
   B := AInput[Pos + 1];
   d := (B - A);
   sum := sum + d;
   if d > 0 then
     sumStr := SumStr + "+" + IntToStr(d) else
     sumStr := SumStr + IntToStr(d);
   if Pos <> sr2End then sumStr := sumStr + ", ";
 end;//for
 sumStr := sumStr + ".";

 if Sum > 0 then ShowMessage("Возрастание: " + " " + IntToStr(sum) + #13 + sumStr);
 if Sum = 0 then ShowMessage("Стабильность: " + " " + IntToStr(sum) + #13 + sumStr);
 if Sum < 0 then ShowMessage("Упадок: " + " " + IntToStr(sum) + #13 + sumStr);
end;//proc

procedure TForm2.Button1Click(Sender: TObject);
begin
 MinMax(Input1);
 MinMax(Input2);
 MinMax(Input3);
end;

end.

---

← →
Dmk ©   (2015-10-22 21:39) [17]

Вот вариант с Extended:
unit Unit2;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Math;

type
 TForm2 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;
 Input1: array[0..17] of extended = (85.2,83.4,81.9,76.1,73.2,82.9,76.8,69.7,62.1,60.3,55.5,50.1,47.7,45.4,34.3,55.8 ,67.1,88.9);//Возрастание
 Input2: array[0..18] of extended = (85.3,80.1,85.76,90.89,85.43,80.56,85.4,90.1,85.9,80.12,85.76,90.91,85.45,80.0,8 5.45,90.46,85.5,80.21,85.3);//Стабильность
 Input3: array[0..17] of extended = (85.3,84.1,81.89,80.16,89.77,82/35,76.67,75.98,72.9,80.12,82.06,75.01,74.15,73.55,56.89,50.07,48.67,80.22);//Упадок
 sr2: array of extended;

implementation

{$R *.dfm}

function TendStr(const AInput: array of extended): string;
var
 A: extended;
 B: extended;
 Pos: integer;
 arrEnd: integer;
 sr2End: integer;
 sumStr: string;
 d: extended;
 InputSize: integer;

begin
 InputSize := Length(AInput);
 arrEnd := (InputSize - 1);
 sr2End := arrEnd - 1;
 SetLength(sr2, arrEnd);

 for Pos := 0 to sr2End do
 begin
   A := AInput[Pos];
   B := AInput[Pos + 1];
   d := (B - A);
   if d > 0 then
     sumStr := SumStr + "+" + FloatToStrF(d, ffNumber, 18, 2) else
     sumStr := SumStr + FloatToStrF(d, ffNumber, 18, 2);
   if Pos <> sr2End then sumStr := sumStr + ", ";
 end;//for
 sumStr := sumStr + ".";
 Result := sumStr;
end;

procedure SetPixel(x, y: integer; AColor: TColor);
begin
 Form2.Canvas.Pixels[x, y] := AColor;
 Form2.Canvas.Pixels[x - 1, y] := AColor;
 Form2.Canvas.Pixels[x - 1, y - 1] := AColor;
 Form2.Canvas.Pixels[x, y - 1] := AColor;
 Form2.Canvas.Pixels[x + 1, y - 1] := AColor;
 Form2.Canvas.Pixels[x + 1, y] := AColor;
 Form2.Canvas.Pixels[x + 1, y + 1] := AColor;
 Form2.Canvas.Pixels[x, y + 1] := AColor;
 Form2.Canvas.Pixels[x - 1, y + 1] := AColor;
end;

function Tend(const AInput: array of extended): extended;
var
 A: extended;
 B: extended;
 Pos: integer;
 arrEnd: integer;
 sr2End: integer;
 sum: extended;
 d: extended;
 InputSize: integer;
 x,y: integer;
 x1,y1: integer;
 gap: integer;
 inv: integer;

begin
 sum := 0;
 InputSize := Length(AInput);
 arrEnd := (InputSize - 1);
 sr2End := arrEnd - 1;
 SetLength(sr2, arrEnd);

 Form2.canvas.Pen.Style := psSolid;
 Form2.canvas.Pen.Width := 2;
 Form2.canvas.Pen.Color := Rgb(Random($FF), Random($FF), Random($FF));
 Form2.canvas.Pen.Mode := pmCopy;

 gap := 20;
 inv := 200;

 for Pos := 0 to sr2End do
 begin
   A := AInput[Pos];
   B := AInput[Pos + 1];
   d := (B - A);
   sum := sum + d;

   x := gap + (gap * Pos);
   y := Inv - Round(A);

   Form2.Canvas.MoveTo(x, y);

   x1 := gap + (gap * (Pos + 1));
   y1 := Inv - Round(A + d);

   Form2.Canvas.LineTo(x1, y1);
   SetPixel(x, y, clBlack);
 end;//for

Result := sum;
end;//proc

procedure ShowTend(ASum: extended; AStr: string);
begin
 if ASum > 0 then ShowMessage("Возрастание: " + " " + FloatToStrF(ASum, ffNumber, 18, 2) + #13 + AStr);
 if ASum = 0 then ShowMessage("Стабильность: " + " " + FloatToStrF(ASum, ffNumber, 18, 2) + #13 + AStr);
 if ASum < 0 then ShowMessage("Упадок: " + " " + FloatToStrF(ASum, ffNumber, 18, 2) + #13 + AStr);
end;

procedure TForm2.Button1Click(Sender: TObject);
var
 sum: extended;
 str: string;

begin
 sum := Tend(Input1);
 str := TendStr(Input1);
 ShowTend(sum, str);

 sum := Tend(Input2);
 str := TendStr(Input2);
 ShowTend(sum, str);

 sum := Tend(Input3);
 str := TendStr(Input3);
 ShowTend(sum, str);
end;

end.

---

← →
Игорь Шевченко ©   (2015-10-23 10:28) [18]

А вы, друзья, как ни садитесь, все в музыканты не годитесь (с)

Работающий код еще не означает, что его можно советовать.
И вообще, в Excel это уже встроено

---

← →
brother ©   (2015-10-23 11:23) [19]

Хм, Игорь, а Ваш рабочий код где? Dmk хотя бы что-то показывает... а Вы?

---

← →
han_malign ©   (2015-10-23 13:44) [20]

> Хм, Игорь, а Ваш рабочий код где?

- Игорь - как бэ намекает - что код дожен быть реализацией какого то математически обоснованного алгоритма...

Excel statistical functions: TREND
...
The TREND(known_y"s, known_x"s, new_x"s, constant) function is used to perform Linear Regression. A least squares criterion is used and TREND tries to find the best fit under that criterion. Known_y"s represent data on the "dependent variable" and known_x"s represent data on one or more "independent variables". The TREND Help file discusses rare cases where the second or third argument may be omitted.

- см. - han_malign © [9]

А для сигнала с постоянным шагом дискретизации обычно больше подходит:
https://ru.wikipedia.org/wiki/Скользящая_средняя

---

← →
Sha ©   (2015-10-23 14:36) [21]

[1] и [3] - это как раз и есть простейший вариант скользящей средней

---

← →
Twister   (2015-10-24 18:59) [22]

Dmk да и всем спасибо
но эту тенденцию как оказалось 1 в 1 я сделал по своему расчету, ну она почти как у  Dmk, но результат такой же.
НО
не хватает одного ВАЖНОГО параметра как скорость!

т.е. допустим есть 200 цифр в массиве, она скармливается этой функции (каждая из этих цифр получается раз в секнуду, допустим) и нужно получить скорость увеличеня или уменьшения за последние 10 секунд, ну или 5 секунд или 20 секунд

...Просто поделить время на скорость измеенния....просто сократить десятки или сотки

---

← →
Dmk ©   (2015-10-24 21:31) [23]

>получить скорость увеличеня или уменьшения за последние 10 секунд
Суммировать данные только за этот промежуток.
Просто введите временной массив и пишите в него каждую единицу времени значение.
сумма за промежуток времени := n+5 ... n + 14; в итоге 10 секунд начиная с пятой есть то, что вы ищите.

---

← →
Dmk ©   (2015-10-24 22:24) [24]

Короче тут вариант с 3-я независимыми графиками:
http://files.expert-graphics.ru/test/Tendency.zip

у меня Delphi XE6.

---

← →
han_malign ©   (2015-10-28 11:09) [25]

> Sha © [21]
> [1] и [3] - это как раз и есть простейший вариант скользящей средней

- смутил ты меня своей delta[i] - это все таки sample[], ну в крайнем случае f[]...

---

Страницы: 1 вся ветка

Текущий архив: 2017.09.24;
Скачать: CL | DM;

Наверх

Память: 0.56 MB
Время: 0.004 c