Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.03.2012, 17:39   #1
Necare
Форумчанин
 
Аватар для Necare
 
Регистрация: 22.10.2010
Сообщений: 145
По умолчанию Не могу увеличить количество точек.

1. Построить тригонометрический многочлен аппроксимирующий заданную функцию по первым N точкам вектора Y
Считать значение функции Y из внешнего файла.
2. Построить графики зависимости Y(x) и аппроксимирующей функции.
3. Метод для решения СУ и количество точек N выбрать согласно варианту.
4. Не использовать стандартные обработчики событий, а организовать их на основе обработчиков сообщений Windows. Использовать обработчики сообщений Windows для всех визуальных компонентов, применяемых в программе(StrinGgid, Chart, Button, Form,….)
5. Создать метод решения системы линейных уравнений и назначить его свойству OnClick, той кнопки по нажатию на которую будет происходить решение СУ.


Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Chart, ExtCtrls, StdCtrls, Grids,
  Series, TeEngine, TeeFunci, TeeProcs;

type
{Описание функций и компонентов}
  TForm1 = class(TForm)
    Panel1: TPanel;
    Chart1: TChart;
    Button1: TButton;
    Button2: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    OpenDialog1: TOpenDialog;
    Series1: TLineSeries;
    Series2: TLineSeries;
    TeeFunction1: TCustomTeeFunction;
    TeeFunction2: TCustomTeeFunction;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
      procedure Solve(Sender: TObject);
  public
    { Public declarations }
    procedure OnClick();
  end;

  TArray = array of array of Extended;

  TMatrix = class
    private
      size: integer;
      Data: TArray;

      function GetItem(Col, Row: integer): Extended;
      procedure SetItem(Col, Row: integer; Value: Extended);
      function GetItemEx(Col: integer): Extended;
      procedure SetItemEx(Col: integer; Value: Extended);
    public
      constructor Create(Col: integer);
      property Item[Col, Row: integer]: Extended read GetItem write SetItem; default;
      property Item[Col: integer]: Extended read GetItemEx write SetItemEx; default;
      function GetGaussMatrix(var Bm: TMatrix): TMatrix;
      function Det(Bm: TMatrix): Extended;
      function Inverse(Bm: TMatrix): TMatrix;
      function Solve (Bm: TMatrix): TMatrix;
  end;
{$IFDEF WIN32}
  WParameter = LongInt;
{$ELSE}
  WParameter = Word;
{$ENDIF}
  LParameter = LongInt;

var
  Form1: TForm1;
  X, Y: array of Extended;
  aa, bb: TMatrix;
  nn: integer = 5;//Задаем количество точек
  MaxX: Extended;
  {Declare a variable to hold the window procedure we are replacing}
  OldWindowProc: Pointer;

implementation

{$R *.dfm}

function F_x(xx: Extended): Extended;
var
  i, n: integer;
begin
  result:=aa[0];
  n:=(nn-1) div 2;
  for i:=1 to n do
    result:=result+aa[i]*cos(i*xx)+bb[i-1]*sin(i*xx);//Тригонометрический
end;                       //многочлен, необхожимый для аппроксимации

function NewWindowProc(WindowHandle: hWnd;
  TheMessage: WParameter;
  ParamW: WParameter;
  ParamL: LParameter): LongInt
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
  if TheMessage=WM_LBUTTONUP then
  begin
    Form1.OnClick();
  end;
  { Call the old Window procedure to }
  { allow processing of the message. }
  NewWindowProc := CallWindowProc(OldWindowProc,
    WindowHandle,
    TheMessage,
    ParamW,
    ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i, n: integer;
  strs: TStringList;
begin
  Button2.OnClick:=Solve;
  SetLength(X, nn);
  SetLength(Y, nn);
  StringGrid1.Cells[0,0]:='x';
  StringGrid1.Cells[0,1]:='y';
  StringGrid2.Cells[0,0]:='x';
  StringGrid2.Cells[0,1]:='y';
  { Set the new window procedure for the control }
  { and remember the old window procedure. }
  OldWindowProc := Pointer(SetWindowLong(Button1.Handle,
    GWL_WNDPROC,
    LongInt(@NewWindowProc)));
  //Вычисляем x[i]
  for i:=0 to nn-1 do
  begin
    n:=i+1;
    X[i]:=(2*PI*(n-1))/(2*9+1);// Вычисление x
  end;
  MaxX:=X[nn-1];
end;

procedure TForm1.OnClick();
var
  i: integer;
  strs: TStringList;
begin
  if OpenDialog1.Execute(Handle) then
  begin
    strs:=TStringList.Create();
   //Считываем данные из файла
    strs.LoadFromFile(OpenDialog1.FileName);
    for i:=0 to nn-1 do
      Y[i]:=StrToFloat(strs[i]);
    strs.Free;
    Chart1.Series[0].Clear;
    StringGrid1.ColCount:=nn+1;
    for i:=0 to nn-1 do
    begin
      StringGrid1.Cells[i+1,0]:=FloatToStr(X[i]);
      StringGrid1.Cells[i+1,1]:=FloatToStr(Y[i]);
      Chart1.Series[0].AddXY(X[i], Y[i]);
    end;
    Button2.Enabled:=true;
  end;
end;
До последней точки с запятой в коде...
Necare вне форума Ответить с цитированием
Старый 03.03.2012, 17:40   #2
Necare
Форумчанин
 
Аватар для Necare
 
Регистрация: 22.10.2010
Сообщений: 145
По умолчанию

Код:
procedure TForm1.Solve(Sender: TObject);
var
  A, B, C: TMatrix;
  i, j, n: integer;
  s: string;
  nx, ny: Extended;
begin
  A:=TMatrix.Create(nn);
  B:=TMatrix.Create(nn);
  for i:=0 to nn-1 do
  begin
    for j:=0 to nn-1 do
    begin
      if (i=1) or (i=2) then n:=1
        else n:=2;
      if i=0 then A[0,j]:=1
        else
      if i mod 2=0 then
      begin
        if j mod 2=0 then A[i,j]:=sin(n*X[j])
          else A[i,j]:=cos(n*X[j]);
      end
        else
      begin
        if j mod 2=0 then A[i,j]:=cos(n*X[j])
          else A[i,j]:=sin(n*X[j]);
      end;
    end;
    B[i]:=Y[i];
  end;
  C:=A.Solve(B);
  A.Free;
  B.Free;
  n:=(nn-1) div 2;
  aa:=TMatrix.Create(n+1);
  bb:=TMatrix.Create(n);
  aa[0]:=C[0];
  for i:=0 to n-1 do
  begin
    aa[i+1]:=C[i*2+1];
    bb[i]:=C[i*2+2];
  end;
  Chart1.Series[1].Clear();
  nx:=X[0];
  i:=0;
  StringGrid2.ColCount:=Trunc((X[nn-1]-X[0]) / 0.1);//Целая часть от числа
  while nx<X[nn-1] do                      //Задает количество столбцов
  begin
    ny:=F_x(nx);
    StringGrid2.Cells[i+1,0]:=FloatToStr(nx);
    StringGrid2.Cells[i+1,1]:=FloatToStr(ny);
    Chart1.Series[1].AddXY(nx, ny);
    nx:=nx+0.1;
    inc(i);
  end;
end;
constructor TMatrix.Create(Col: integer);
var
  i: integer;
begin
  size:=Col;
  SetLength(Data, Col, Col);
end;

function TMatrix.GetItem(Col, Row: integer): Extended;
begin
  result:=Data[Row, Col];
end;
procedure TMatrix.SetItem(Col, Row: integer; Value: Extended);
begin
  Data[Row, Col]:=Value;
end;
function TMatrix.GetItemEx(Col: integer): Extended;
begin
  result:=Data[Col,0];
end;
procedure TMatrix.SetItemEx(Col: integer; Value: Extended);
begin
  Data[Col,0]:=Value;
end;
// преобразует матрицу в треугольную
function TMatrix.GetGaussMatrix(var Bm: TMatrix): TMatrix;
var
  i, j, k: integer;
  res: TMatrix;
  m: Extended;
begin
  result:=nil;
  // проверка на возможность решения
  for i:=0 to size-1 do
    if self[i,i]=0 then
      Exit;
  res:=TMatrix.Create(size);
  for i:=0 to size-1 do
    for j:=0 to size-1 do
      res[i,j]:=self[i,j];
  // прямой проход
  for k:=0 to size-1 do
    for i:=k+1 to size-1 do
    begin
      if res[k,k]=0 then
        Exit;
      m:=res[k,i]/res[k,k];
      for j:=k to size-1 do
        res[j,i]:=res[j,i]-res[j,k]*m;
      Bm[i]:=Bm[i]-m*Bm[k];
    end;
  result:=res;
end;
// вычисление определителя треугольной матрицы
function TMatrix.Det(Bm: TMatrix): Extended;
var
  tr: TMatrix;
  i: integer;
  res: Extended;
begin
  tr:=GetGaussMatrix(Bm);
  res:=1;
  for i:=0 to size-1 do
    res:=res*tr[i,i];
  result:=res;
end;
procedure MultString(var a, b: TMatrix; i1: integer; r: Extended);
var
  j: integer;
begin
  for j:=0 to a.size-1 do
  begin
    a[i1,j]:=a[i1,j]*r;
    b[i1,j]:=b[i1,j]*r;
  end;
end;
procedure AddStrings(var a, b: TMatrix; i1, i2 :integer; r: Extended);
{ Процедура прибавляет к i1 строке матрицы a i2-ю умноженную на r}
var
  j: integer;
begin
  for j:=0 to a.size-1 do
  begin
    a[i1,j]:=a[i1,j]+r*a[i2,j];
    b[i1,j]:=b[i1,j]+r*b[i2,j];
  end;
end;

procedure MultMatr(a, b: TMatrix; var c: TMatrix);
var
  i, j, k: byte;
  s: Extended;
begin
  for i:=0 to a.size-1 do
    for j:=0 to a.size-1 do
    begin
      s:=0;
      for k:=0 to a.size-1 do
        s:=s+a[i,k]*b[k,j];
      c[i,j]:=s;
    end;
end;
function sign(r: real): shortint;
begin
 if (r>=0) then sign:=1
  else sign:=-1;
end;
// преобразуем матрицу в обратную
function TMatrix.Inverse(Bm: TMatrix): TMatrix;
var
  i, j, k, s: integer;
  res, tr, m1, X: TMatrix;
begin
  result:=nil;
  res:=TMatrix.Create(size);
  for i:=0 to size-1 do
    for j:=0 to size-1 do
      res[i,j]:=self[i,j];
  m1:=TMatrix.Create(size);
  for i:=0 to size-1 do
  begin
    for j:=0 to size-1 do
      m1[i,j]:=0;
    m1[i,i]:=1;
  end;
  for i:=0 to size-1 do
  begin
    for j:=i+1 to size-1 do
      AddStrings(res, m1, i, j, sign(res[i,i])*sign(res[j,i]));
    if (abs(res[i, i])>0.001) then
    begin
      MultString(res, m1, i, 1/res[i,i]);
      for j:=i+1 to size-1 do
        AddStrings(res, m1, j, i, -res[j,i]);
    end
      else
    begin
      MessageBox(Form1.Handle, 'Невозможно получить обратную матрицу!', 'Ошибка:', MB_ICONERROR);
      halt;
    end;
  end;
  //обратный проход
  if (res[size-1,size-1]>0.001) then
  begin
    for i:=size-1 downto 1 do
      for j:=0 to i-1 do
        AddStrings(res, m1, j, i, -res[j,i]);
  end
    else MessageBox(Form1.Handle, 'Невозможно получить обратную матрицу!', 'Ошибка:', MB_ICONERROR);
  result:=m1;
end;
function TMatrix.Solve(Bm: TMatrix): TMatrix;
var
  res, o: TMatrix;
  i, j: integer;
  x: Extended;
begin
  result:=nil;
  res:=TMatrix.Create(size);
  o:=GetGaussMatrix(Bm);
  // обратный ход
  for i:=size-1 downto 0 do
  begin
    x:=0;
    for j:=i to size-1 do
      x:=x+o[j,i]*res[j];
    res[i]:=(Bm[i]-x)/o[i,i];
  end;
  result:=res;
end;
end.
До последней точки с запятой в коде...
Necare вне форума Ответить с цитированием
Старый 03.03.2012, 17:40   #3
Necare
Форумчанин
 
Аватар для Necare
 
Регистрация: 22.10.2010
Сообщений: 145
По умолчанию

Когда я задаю:
Код:
  nn: integer = 5;//Задаем количество точек
то всё нормально, когда хочу задать 9 точек, то на стадии вычисления многочлена - вылазит:



Вопрос: в чем ошибка или что исправить?
До последней точки с запятой в коде...
Necare вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задаnm n точек. Найти m=3,4... точек и построить на них m-угольник: количество точек , лежащих внутри и вне его мин. различается L.Rain Помощь студентам 0 11.12.2011 22:19
Не могу увеличить деньги в кс gufon Общие вопросы Delphi 12 05.06.2011 22:33
Определить количество точек Артур22 Общие вопросы Delphi 17 21.02.2011 11:09
Увеличить количество таблиц подключаемых к EXCEL Thunder Horse Microsoft Office Access 3 30.10.2010 11:40