VPF::[VBA/VB6] Решение СЛАУ методом итераций [?]

Pitbul

Дата 13.5.2008, 21:49 (ссылка)

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

Загрузка ...

Fruzenshtein

Профиль
Группа: Участник
Сообщений: 231
Регистрация: 30.4.2008
Где: Киев

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

Добрый день, помогите пожалуйста найти програму написаную на VBA/VB6, которая могла бы в Экселе решать СЛАУ(Системы линейных алгебраических уровнений) методом итераций smile

Огромное спасибо

--------------------

### JAVA ###### programming ###

Pitbul

Дата 14.5.2008, 18:00 (ссылка)

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

Загрузка ...

Fruzenshtein

Профиль
Группа: Участник
Сообщений: 231
Регистрация: 30.4.2008
Где: Киев

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

Знающие люди, помогите плиз, а то совсем не знаю как реализовать ее=)
smile

--------------------

### JAVA ###### programming ###

Pitbul

Дата 17.5.2008, 08:20 (ссылка)

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

Загрузка ...

Fruzenshtein

Профиль
Группа: Участник
Сообщений: 231
Регистрация: 30.4.2008
Где: Киев

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

Специалисты, помогите пожалуйста с этой загвосткой. Как я понял, эта лаба является стандартной по курсу информатики по всему СНД пространству. Наверняка у коо то есть готовый образец smile

--------------------

### JAVA ###### programming ###

kapbepucm

Дата 23.5.2008, 13:04 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 993
Регистрация: 14.6.2007
Где: Латвия

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

Как было обещано мною в привате, я попробывал превести ваш PAS код в VBA. Ваш код:

Код

Program metod_iteracia;
uses crt;
const
   maxn=10;
type
   matrix=array [1..maxn,1..maxn] of real;
   vector=array [1..maxn] of real;
var
   a:matrix;
   b,x:vector;
   i,n,k:integer;

procedure DiaG(a:matrix; b:vector; var x:vector);
{процедура пошуку початкового наближення}
var
   i:integer;
begin

   for i:=1 to n do
      x[i]:=b[i]/abs(a[i,i]);
end;

procedure SymmA(a:matrix; b:vector; var t:vector);
{процедура пошуку суми елементів рівняння }
var
   i,j:integer;
begin
   for i:=1 to n do  begin
      t[i]:=0;
      for j:=1 to n do
         t[i]:=t[i]+(a[i,j]*b[j]);
   end;
end;

procedure MinusveC(a:vector; b:vector; var t:vector);
{процедура пошуку різниці вектора і знайденого значення}
var
   i:integer;

begin
   for i:=1 to n do
      t[i]:=a[i]-b[i]
end;

procedure IteraciA(a:matrix; b:vector; var y:vector);
{процедура розрахунків методом ітерації}
const
   m=100;
var
   i,j:integer;
   d:matrix;
   buf,buf1 : vector;
begin
   for i:= 1 to n do
    begin
      for j:=1 to n do
        d[i,j]:=0;
      d[i,i]:=a[i,i];
     y[i]:=0
   end;
   for i:= 1 to m do
    begin
       SymmA(a,y,buf);
       MinusveC(buf,b,buf);

       SymmA(d,y,buf1);

       MinusveC(buf1,buf,buf);

       DiaG(d,buf,y);
    end;
end;
procedure RivN(A: Matrix; b: Vector);
{процедура виводу на екран системи заданих рівнянь}
var
   i,j:integer;
begin
 writeln('zadana systema rivnan');
 writeln('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
   for i:=1 to N do
    begin
      for j:=1 to N do
       begin
         write('+','(',A[i,j]:2:2,')',' * X[',j,'] ');
       end;
      writeln(' = ',b[i]:2:2);
    end;
  writeln('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
  writeln;
           end;

procedure VvodMatriX(var A: Matrix; var b: Vector);
{процедура введення коефіцієнтів системи рівнянь}
  var
   i,j:integer;
begin
   for i:=1 to N do
   begin
      for j:=1 to N do
      begin
         write('A[',i,'.',j,'] =  ');
         read(A[i,j]);
      end;
      write('b[',i,'] = ');
      readln(b[i]);
   end;
end;

{основна програма}
begin
clrscr;
writeln('vvedit n-rozmirnist matruci');
readln(n);
   VvodMatriX(a,b);
   RivN(a,b);
   writeln('pochatkove nabligina');
   for i:=1 to n do
    begin
     x[i]:=b[i]/abs(a[i,i]);
     writeln('   x[',i,']=',x[i]:3:4);
     x[i]:=0;
    end;
    writeln;
   IteraciA(a,b,x);
   writeln('Rishenie metodom iteracii');
   for i:=1 to n do
    writeln('   X[',I,']=',x[i]:3:3,' ');
writeln;
readln;
end.

То, что получилось. Только есть подозрение, что подсчёты выполняются неверно :( Может кто ещё подключится. smile

Код

Private Const MAXN As Long = 10
Private Type MATRIX
  arr(1 To MAXN, 1 To MAXN) As Double
End Type
Private Type VECTOR
  arr(1 To MAXN) As Double
End Type
Private A As MATRIX
Private B As VECTOR
Private X As VECTOR
Private I As Long
Private N As Long
Private K As Long
Private Sub DiaG(A As MATRIX, B As VECTOR, ByRef X As VECTOR)
  Dim I As Long
  For I = 1 To N
    X.arr(I) = B.arr(I) / Abs(A.arr(I, I))
  Next I
End Sub
Private Sub SymmA(A As MATRIX, B As VECTOR, ByRef T As VECTOR)
  Dim I As Long, J As Long
  For I = 1 To N
    T.arr(I) = 0
    For J = 1 To N
      T.arr(I) = T.arr(I) + (A.arr(I, J) * B.arr(J))
    Next J
  Next I
End Sub
Private Sub MinusveC(A As VECTOR, B As VECTOR, ByRef T As VECTOR)
  Dim I As Long
  For I = 1 To N
    T.arr(I) = A.arr(I) - B.arr(I)
  Next I
End Sub
Private Sub IteraciA(A As MATRIX, B As VECTOR, ByRef Y As VECTOR)
  Const M = 100
  Dim I As Long, J As Long
  Dim D As MATRIX
  Dim BUF As VECTOR, BUF1 As VECTOR
  For I = 1 To N
    For J = 1 To N
      D.arr(I, J) = 0
    Next J
    D.arr(I, I) = A.arr(I, I)
    Y.arr(I) = 0
  Next I
  For I = 1 To M
    SymmA A, Y, BUF
    MinusveC BUF, B, BUF
    SymmA D, Y, BUF1
    MinusveC BUF1, BUF, BUF
    DiaG D, BUF, Y
  Next I
End Sub
Private Sub RivN(A As MATRIX, B As VECTOR)
  Dim I As Long, J As Long
  Dim STROKA As String
  STROKA = "zadana systema rivnan" & Chr(13) & Chr(10)
  STROKA = STROKA & "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" & Chr(13) & Chr(10)
  For I = 1 To N
    For J = 1 To N
      STROKA = STROKA & "+(" & A.arr(I, J) & ") * X[" & J & "] "
    Next J
    STROKA = STROKA & " = " & B.arr(I) & Chr(13) & Chr(10)
  Next I
  MsgBox STROKA & "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-="
End Sub
Private Sub VvodMatriX(ByRef A As MATRIX, ByRef B As VECTOR)
  Dim I As Long, J As Long
  For I = 1 To N
    For J = 1 To N
      A.arr(I, J) = InputBox("A[" & I & "." & J & "] =  ")
    Next J
    B.arr(I) = InputBox("b[" & I & "] = ")
  Next I
End Sub
Public Sub Main()
  N = InputBox("vvedit n-rozmirnist matruci")
  VvodMatriX A, B
  RivN A, B
  For I = 1 To N
    X.arr(I) = B.arr(I) / Abs(A.arr(I, I))
    MsgBox "   x[" & I & "]=" & X.arr(I), , "pochatkove nabligina"
    X.arr(I) = 0
  Next I
  IteraciA A, B, X
  For I = 1 To N
    MsgBox "   X[" & I & "]=" & X.arr(I) & " ", , "Rishenie metodom iteracii"
  Next I
End Sub

Добавлено через 12 минут и 15 секунд
А я и не заметил, что есть ещё темаhttp://forum.vingrad.ru/forum/topic-212751.html

Это сообщение отредактировал(а) kapbepucm - 23.5.2008, 13:05

--------------------

(С) kapbepucm

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