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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 31.01.2012, 19:45   #1
Cosmic_Gate
Новичок
Джуниор
 
Регистрация: 31.01.2012
Сообщений: 3
По умолчанию Не могу создать ПО!!!

Задание курсовой

Программное обеспечение должно иметь такие элементы:

1. Главную форму с указанным названием работы и автора.
2. Меню пользователя, которое позволит выбрать способ ввода данных, просмотр результатов предыдущей задачи, помощь пользователю и выход из программы.
3. Графическую иллюстрацию решения задачи.
4. Вывод результатов в текстовом виде в файл и на экран.
5. Помощь пользователю.

Это все критерии к моей курсовой работе
У меня есть две программы которые решают Системы Линейных Алгоритмических Уравнений разными способами

Помогите пожалуйста обьединить их согласно требованиям
Cosmic_Gate вне форума Ответить с цитированием
Старый 31.01.2012, 19:46   #2
Cosmic_Gate
Новичок
Джуниор
 
Регистрация: 31.01.2012
Сообщений: 3
По умолчанию Программа 1

Код:
Uses CRT;
 
Const
     maxn = 10;
 
Type
    Data = Real;
    Matrix = Array[1..maxn, 1..maxn] of Data;
    Vector = Array[1..maxn] of Data;
 
{ Процедура ввода расширенной матрицы системы }
Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
Var
   i, j, r: Integer;
Begin
     r := WhereY;
     GotoXY(2, r);
     Write('A');
     For i := 1 to n do begin
         GotoXY(i*6+2, r);
         Write(i);
         GotoXY(1, r+i+1);
         Write(i:2);
     end;
     GotoXY((n+1)*6+2, r);
     Write('b');
     For i := 1 to n do begin
         For j := 1 to n do begin
             GotoXY(j * 6 + 2, r + i + 1);
             Read(a[i, j]);
         end;
         GotoXY((n + 1) * 6 + 2, r + i + 1);
         Read(b[i]);
     end;
End;
 
{ Процедура вывода результатов }
Procedure WriteX(n :Integer; x: Vector);
Var
   i: Integer;
Begin
     For i := 1 to n do
         Writeln('x', i, ' = ', x[i]);
End;
 
 
{ Функция, реализующая метод Гаусса }
Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
Var
   i, j, k, l: Integer;
   q, m, t: Data;
Begin
 
     For k := 1 to n - 1 do begin
 
         { Ищем строку l с максимальным элементом в k-ом столбце}
         l := 0;
         m := 0;
         For i := k to n do
             If Abs(a[i, k]) > m then begin
                m := Abs(a[i, k]);
                l := i;
             end;
 
         { Если у всех строк от k до n элемент в k-м столбце нулевой,
                то система не имеет однозначного решения }
         If l = 0 then begin
            Gauss := false;
            Exit;
         end;
 
         { Меняем местом l-ую строку с k-ой }
         If l <> k then begin
            For j := 1 to n do begin
                t := a[k, j];
                a[k, j] := a[l, j];
                a[l, j] := t;
            end;
            t := b[k];
            b[k] := b[l];
            b[l] := t;
         end;
 
         { Преобразуем матрицу }
         For i := k + 1 to n do begin
             q := a[i, k] / a[k, k];
             For j := 1 to n do
                 If j = k then
                    a[i, j] := 0
                 else
                      a[i, j] := a[i, j] - q * a[k, j];
                 b[i] := b[i] - q * b[k];
             end;
 
     end;
 
     { Вычисляем решение }
     x[n] := b[n] / a[n, n];
     For i := n - 1 downto 1 do begin
         t := 0;
         For j := 1 to n-i do
             t := t + a[i, i + j] * x[i + j];
         x[i] := (1 / a[i, i]) * (b[i] - t);
     end;
 
     Gauss := true;
End;
 
Var
    n, i: Integer;
    a: Matrix ;
    b, x: Vector;
Begin
      ClrScr;
      Writeln('Программа решения систем линейных уравнений по методу Гаусса');
      Writeln;
 
      Writeln('Введите порядок матрицы системы (макс. 10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
 
      Writeln('Введите расширенную матрицу системы');
      ReadSystem(n, a, b);
      Writeln;
 
      If Gauss(n, a, b, x) then begin
         Writeln('Результат вычислений по методу Гаусса');
         WriteX(n, x);
      end
      else
          Writeln('Данную систему невозможно решить по методу Гаусса');
      Writeln;
End.


___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 01.02.2012 в 10:46.
Cosmic_Gate вне форума Ответить с цитированием
Старый 31.01.2012, 19:47   #3
Cosmic_Gate
Новичок
Джуниор
 
Регистрация: 31.01.2012
Сообщений: 3
По умолчанию Программа 2

Код:
Uses CRT;
 
Const
     maxn = 10;
 
Type
    Data = Real;
    Matrix = Array[1..maxn, 1..maxn] of Data;
    Vector = Array[1..maxn] of Data;
 
{ Процедура ввода расширенной матрицы системы }
Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
Var
   i, j, r: Integer;
Begin
     r := WhereY;
     GotoXY(2, r);
     Write('A');
     For i := 1 to n do begin
         GotoXY(i * 6 + 2, r);
         Write(i);
         GotoXY(1, r + i + 1);
         Write(i:2);
     end;
     GotoXY((n + 1) * 6 + 2, r);
     Write('b');
     For i := 1 to n do begin
         For j := 1 to n do begin
             GotoXY(j * 6 + 2, r + i + 1);
             Read(a[i, j]);
         end;
         GotoXY((n + 1) * 6 + 2, r + i + 1);
         Read(b[i]);
     end;
End;
 
{ Процедура вывода результатов }
Procedure WriteX(n :Integer; x: Vector);
Var
   i: Integer;
Begin
     For i := 1 to n do
         Writeln('x', i, ' = ', x[i]);
End;
 
 
{ Функция, реализующая метод Зейделя }
Function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Data) :Boolean;
Var
   i, j: Integer;
   s1, s2, s, v, m: Data;
Begin
 
     { Исследуем сходимость }
     For i := 1 to n do begin
 
         s := 0;
         For j := 1 to n do
             If j <> i then
                s := s + Abs(a[i, j]);
 
         If s >= Abs(a[i, i]) then begin
            Seidel := false;
            Exit;
         end;
 
     end;
 
     Repeat
 
         m := 0;
         For i := 1 to n do begin
 
             { Вычисляем суммы }
             s1 := 0;
             s2 := 0;
             For j := 1 to i - 1 do
                 s1 := s1 + a[i, j] * x[j];
             For j := i to n do
                 s2 := s2 + a[i, j] * x[j];
 
             { Вычисляем новое приближение и погрешность }
             v := x[i];
             x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);
 
             If Abs(v - x[i]) > m then
                m := Abs(v - x[i]);
 
         end;
 
     Until m < e;
 
     Seidel := true;
End;
 
Var
    n, i: Integer;
    a: Matrix;
    b, x: Vector;
    e: Data;
Begin
      ClrScr;
      Writeln('Программа решения систем линейных уравнений по методу Зейделя');
      Writeln;
 
      Writeln('Введите порядок матрицы системы (макс. 10)');
      Repeat
             Write('>');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;
 
      Writeln('Введите точность вычислений');
      Repeat
             Write('>');
             Read(e);
      Until (e > 0) and (e < 1);
      Writeln;
 
      Writeln('Введите расширенную матрицу системы');
      ReadSystem(n, a, b);
      Writeln;
 
 
      { Предполагаем начальное приближение равным нулю }
      For i := 1 to n do
          x[i] := 0;
 
      If Seidel(n, a, b, x, e) then begin
         Writeln('Результат вычислений по методу Зейделя');
         WriteX(n, x);
      end
      else
          Writeln('Метод Зейделя не сходится для данной системы');
      Writeln;
End.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 01.02.2012 в 10:47.
Cosmic_Gate вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не могу создать запрос yuliaNa03 Microsoft Office Access 3 22.11.2011 11:45
Не могу создать отчет. GBAXA Общие вопросы Delphi 6 30.06.2010 10:28
Не могу создать триггеры. namburol БД в Delphi 1 20.06.2010 18:28
Не могу создать обьект mrandrey Общие вопросы Delphi 6 04.06.2007 16:04