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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 15.04.2011, 16:42   #1
NIKITA_777
Новичок
Джуниор
 
Регистрация: 15.04.2011
Сообщений: 2
По умолчанию ошибка в листинге программы симплекс-метод

при расчете выводится ошибка " 'цена' is not a valid floating point value". хотелось бы исправить это ошибку, но никак не получается. помогите пожалуйста. Вот код:

UNIT1

Код:
unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, simplex;


type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    StringGrid1: TStringGrid;
    GroupBox1: TGroupBox;
    Button1: TButton;
    memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
//    procedure StringGrid1Click(Sender: TObject);
    procedure StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    procedure ReadData;
    procedure Results;
    procedure WriteBtnLabel;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CurCol, CurRow: integer;


implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  case key of
    '0'..'9': ; //только цифры (отрицательные значания исключены)
    #8: ; //забой
    '.', ','://точка и запятая
      if Pos(DecimalSeparator, StringGrid1.Cells[CurCol,CurRow]) = 0 then
        Key := DecimalSeparator
      else
        Key := #0;
    else
      key := #0;
  end;
end;




procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
  CurCol:=ACol;
  CurRow:=ARow;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i,j: integer;
    F: TextFile;
begin
  AssignFile(F, ExtractFilePath(Application.ExeName)+'simpex.dat');
  Rewrite(F);
  With StringGrid1 do
  begin
    for i:=1 to RC do
    begin
      for j:=1 to CC do
      begin
        if Cells[i,j]<>'' then Writeln(F,Cells[i,j])
        else Writeln(F,'0');
      end;
    end;
  end;
  CloseFile(F);
  form2.visible:=true;
  end;



procedure TForm1.FormCreate(Sender: TObject);
var i,j: integer;
    F: TextFile;
    s: string;
begin
  Memo1.Lines.Clear;
  R1:=1; //Для чего эта переменная, будет пояснено ниже
  AssignFile(F, ExtractFilePath(Application.ExeName)+'simpex.dat');
  Reset(F);
  With StringGrid1 do
  begin
    for i:=1 to RC do
    begin
      for j:=1 to CC do
      begin
        Readln(F,s);
        Cells[i,j]:=s;
      end;
    end;
  end;
  CloseFile(F);
  WriteBtnLabel;

end;

procedure TForm1.ReadData;
var i,j: integer;
begin
  NC:=CC-2;
  NV:=RC-2;
  for j:=1 to NV do
  begin
    R2:=StrToFloat(StringGrid1.Cells[j,1]);
    TS[1,j+1]:=R2*R1;
  end;
  R2:=StrToFloat(StringGrid1.Cells[CC,1]);
  TS[1,1]:=R2*R1;
  for i:=1 to NC do
  begin
    for j:=1 to NV do
    begin
      R2:=StrToFloat(StringGrid1.Cells[j,i+1]);
      TS[i+1,j+1]:=-R2;
    end;
    TS[i+1,1]:=StrToFloat(StringGrid1.Cells[CC-1,i+1]);
  end;
  for j:=1 to NV do TS[0,j+1]:=j;
  for i:=NV+1 to NV+NC do TS[i-NV+1,0]:=i;
end;


procedure TForm1.Results;
var i,j: Integer;
begin
  Memo1.Lines.Clear;
  if XERR <> 0 then
  begin
    GroupBox1.Caption:='Нет решения!';
    Exit;
  end else
  for I := 1 to NV do
  for J := 2 to NC + 1 do
  begin
    if TS[J, 0] = I then
    Memo1.Lines.Add(StringGrid1.Cells[i,0]+' : '+FormatFloat('##0.00',TS[j,1]));
  end;
  GroupBox1.Caption:='Сумма: '+FormatFloat('##0.00',TS[1, 1])+' руб.';
end;

procedure TForm1.WriteBtnLabel;
begin
  With StringGrid1 do
  begin
    Cells[0,1]:='цена';
    Cells[0,2]:='Белки';
    Cells[0,3]:='Жиры';
    Cells[0,4]:='Витам.';
    Cells[4,0]:='Норма';
    Cells[3,0]:='Шоколад';
    Cells[2,0]:='Хлеб   ';
    Cells[1,0]:='Борщ   ';
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  XERR:=0;
  NOPTIMAL := 0;
  ReadData;
  repeat
    PIVOT;
    FORMULA;
    OPTIMIZE;
  until not (NOPTIMAL = 1);
  Results;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
form1.Close;
form2.visible:=true;
end;



end.
[/SIZE][/SIZE]

Последний раз редактировалось NIKITA_777; 15.04.2011 в 16:48.
NIKITA_777 вне форума Ответить с цитированием
Старый 15.04.2011, 16:43   #2
NIKITA_777
Новичок
Джуниор
 
Регистрация: 15.04.2011
Сообщений: 2
По умолчанию

А ЭТО второй unit

UNIT2

Код:
unit simplex;

interface

uses
  SysUtils, Classes;

type
  TDataModule2 = class(TDataModule)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataModule2: TDataModule2;
  rc, cc: integer;
  NC, NV, NOPTIMAL, P1, P2, XERR: Integer;
  //TS: Array[0..RC-1,0..CC-1] of Double;
  TS: Array[0..4,0..4] of Double;
  R1,R2: double;

procedure Pivot;
procedure Formula;
procedure Optimize; 


implementation

{$R *.dfm}
procedure Pivot; // В этой секции находится центр матрицы
var RAP,V,XMAX: Double;
    I,J: Integer;
begin
  XMAX := 0.0;
  for J := 2 to NV + 1 do
  begin
    if (TS[1, J] > 0) and (TS[1, J] > XMAX) then
    begin
      XMAX := TS[1, J];
      P2 := J
    end
  end;
  RAP := 999999.0;
  for I := 2 to NC + 1 do
  begin
    if Not (TS[I, P2] >= 0) then
    begin
      V := ABS(TS[I, 1] / TS[I, P2]);
      if V < RAP then
      begin
        RAP := V;
        P1 := I
      end;
    end;
  end;
  V := TS[0, P2];
  TS[0, P2] := TS[P1, 0];
  TS[P1, 0] := V
end;

procedure Formula; //Находим опорный базис
Label 60,70,100;
var I,J: Integer;
begin
     for I := 1 to NC + 1 do
     begin
       if I = P1 then GOTO 70;
       for J := 1 to NV + 1 do
       begin
         if J = P2 then GOTO 60;
         TS[I, J] := TS[I, J] - TS[P1, J] * TS[I, P2] / TS[P1, P2];
60:    end;
70:  end;
     TS[P1, P2] := 1.0 / TS[P1, P2];
     for J := 1 to NV + 1 do
     begin
       if J = P2 then GOTO 100;
       TS[P1, J] := TS[P1, J] * ABS(TS[P1, P2]);
100: end;
     for I := 1 to NC + 1 do
     begin
       if I = P1 then Exit;
       TS[I, P2] := TS[I, P2] * TS[P1, P2];
     end
end;


procedure Optimize;// Определяется, закончен ли процесс итерации
var I,J: Integer;
begin
  for I := 2 to NC + 1 do
    if TS[I, 1] < 0 then XERR := 1;
  NOPTIMAL := 0;
  if XERR = 1 then Exit;
  for J := 2 to NV + 1 do
    if TS[1, J] > 0 then NOPTIMAL := 1;
end;


end.
NIKITA_777 вне форума Ответить с цитированием
Старый 15.04.2011, 17:40   #3
Mad_Cat
Made In USSR!
Старожил
 
Аватар для Mad_Cat
 
Регистрация: 01.09.2010
Сообщений: 3,657
По умолчанию

у вас по гриду цикл косячный по строкам он должен быть с 1 а идет с 0! где? я хз!ищите!!
"...В жизни я встречал друзей и врагов.В жизни много всего перевидал.Солнце тело мое жгло, ветер волосы трепал,но я смысла жизни так и не узнал..."
(c) Юрий Клинских aka "Хой"
Mad_Cat вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Симплекс метод BeZone Помощь студентам 1 24.11.2012 18:25
симплекс метод Антонина@com Microsoft Office Excel 1 13.04.2011 18:27
симплекс метод bakir Помощь студентам 3 11.04.2011 16:35
Симплекс метод demaman Помощь студентам 3 29.04.2010 04:26
Симплекс метод bakir Помощь студентам 0 04.12.2009 00:39