VPF::[Delphi Console] Метод Гаусса - Форум программистов

Tarantul2007

Дата 5.4.2007, 07:55 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 5.3.2007

Репутация: нет
Всего: нет

Программа для решения систем Методом Гаусса! Две процедуры решение и запись в файл есть и работают, а вот как считать из файла не знаю!
Смысл в том что на диске С находится текстовый файл с коэффицентами. Файл записан в виде:
1;2;3;4;5;
6;7;8;9;10;
и т.д.
Последний элемент в строчке является свободным членом, а все остальное коэффиценты !

Код


program Gauss;
{Метод Гаусса}
{$APPTYPE CONSOLE}

uses
  SysUtils,windows;
const q=4;
type Koef=array [1..q,1..q] of real; {Массив для хранения коэффицентов}
     Svob=array [1..q] of real; {Массив для хранения свободных членов}
     Neiz=array [1..q] of real; {Массив для неизвестных}
var txt1,txt2:text;
    a:Koef;
    b:Svob;
    x:Neiz;
    str:string;
    n:word; {Переменная для определения размера матрицы}

procedure Zapolnenie(var a:koef; var b:Svob; var n:word; str:string);
var i,z,k:integer;
    el:real;
    str1:string;
    pp:boolean;
begin
for i:=1 to length(str) do
if copy(str,i,1)=';' then k:=k+1;

end;

procedure Reshenie(var a:Koef; var b:Svob;var x:Neiz);
var i,j,k:integer;
    h:real;
begin
for j:=i+1 to n do
begin
a[j,i]:=-a[j,i]/a[i,i];
for k:=i+1 to n do a[j,k]:=a[j,k]+a[j,i]*a[i,k];
b[j]:=b[j]+a[j,i]*b[i];
end;
x[n]:=b[n]/a[n,n];
for i:=n-1 downto 1 do
begin
h:=b[i];
for j:=i+1 to n do
h:=h-x[j]*a[i,j];
x[i]:=h/a[i,i];
end;
end;

procedure ZapisVFail(x:Neiz);
var i:integer;
begin
for i:=1 to n do begin
writeln(txt2,'X(',i,')=',x[i]:3:5);
end;
end;

begin
SetconsoleCP(1251);
SetconsoleoutputCP(1251);
assign(txt1,'C:\Input.txt');
assign(txt2,'C:\Output.txt');
reset(txt1);
rewrite(txt2);
n:=0;
while not (eof(txt1)) do begin
                         read(txt1,str);
                         n:=n+1;
                         zapolnenie(a,b,n,str);
                         end;
Reshenie(a,b,x);
ZapisVFail(x);
close(txt1);
close(txt2);
readln;
end.

Это сообщение отредактировал(а) Tarantul2007 - 5.4.2007, 07:55

volvo877

Дата 5.4.2007, 09:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 34
Всего: 116

Tarantul2007, если ты уверен, что данные в файл внесены правильно, то есть, в каждой строке их ровно столько, сколько нужно, и строк тоже хватает, то можно сделать так:

Код


procedure Zapolnenie(var a: koef; var b: Svob; n: word; s: string);
var
  i, p: integer;
  sub_s: string;
begin
  i := 0;
  repeat
    p := pos(';', s);
    if p > 0 then begin
      sub_s := copy(s, 1, p - 1);
      inc(i);
      a[n, i] := strtofloat(sub_s);
      delete(s, 1, p);

      if i = q then break;
    end;
  until p = 0;
  b[n] := strtofloat(copy(s, 1, pred(length(s))));
end;

Вызывать вот так:

Код

...
n := 0;
while not (eof(txt1)) do begin
  readln(txt1, str); // <-- LN не забудь !!!
  n:=n+1;
  zapolnenie(a, b, n, str);
end;
...

Иначе придется добавлять обработку ошибок...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »