Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Fakeoke
314 / 314 / 201
Регистрация: 28.07.2011
Сообщений: 1,849
#1

Метод Гаусса. Учесть множество решений и когда нет решений - Turbo Pascal

23.09.2013, 21:43. Просмотров 742. Ответов 2
Метки нет (Все метки)

Вообщем есть сама прога, которая решает методом гаусса, но она не разделяет системы с множеством решений и без решений... надо это как-то учесть... и вывести через свободные, если множество...

http://www.cyberforum.ru/turbo-pascal/thread1465444.html

сама программа

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
uses crt;
type mat=array [1..20,1..21] of real;
     vec=array [1..20] of real;
var a:mat; x:vec; i,n:integer; s:real;
 
procedure matr(n:integer; var a:mat);
var i,j:integer;
begin
        for i:=1 to n Do
        for j:=1 to n+1 Do
                begin
                       if j<>n+1 then write('A[',i:2,j:2,'] = ')
                       else write('B[ ',i,' ] = ');
                        readln(a[i,j]);
                end;
end;
 
procedure matr1(n:integer;var a:mat);
var i,j:integer;
begin
     a[1,1]:=22.3;
     a[1,2]:=-1;
     a[1,3]:=0;
     a[1,4]:=2;
     a[1,5]:=67.9;
     a[2,1]:=3;
     a[2,2]:=24.3;
     a[2,3]:=4;
     a[2,4]:=1;
     a[2,5]:=62.3;
     a[3,1]:=2;
     a[3,2]:=-1;
     a[3,3]:=26.3;
     a[3,4]:=2;
     a[3,5]:=191.1;
     a[4,1]:=3;
     a[4,2]:=-2;
     a[4,3]:=1;
     a[4,4]:=28.3;
     a[4,5]:=42.3;
     writeln('Rashirennaya matrica sistemi:');
     for i:=1 to n do
     begin
     for j:=1 to n+1 do
     write(a[i,j]:5:1,' ');
     writeln;
     end;
end;
procedure gauss(n:integer; var a:mat; var x:vec; var s:real);
var i,j,k,l,k1,n1:integer;
r:real;
begin
        n1:=n+1;
        for k:=1 to n Do
                begin
                        k1:=k+1;
                        s:=a[k,k];
                        j:=k;
                        for i:=k1 to n Do
                                begin
                                        r:=a[i,k];
                                        if (abs(r))>(abs(s)) then
                                        begin
                                                s:=r;
                                                j:=i;
                                        end;
                                end;
                if s=0.0 then exit;
                if j<>k then
                        for i:=k to n1 Do
                                begin
                                r:=a[k,i];
                                a[k,i]:=a[j,i];
                                a[j,i]:=r;
                                end;
                for j:=k1 to n1  Do
                        a[k,j]:=a[k,j]/s;
                for i:=k1 to n do
                begin
                        r:=a[i,k];
                        for j:=k1 to n1 Do
                                a[i,j]:=a[i,j]-a[k,j]*r;
                end;
                end;
        if s<>0.0 then
        for i:=n downto 1 Do
                begin
                s:=a[i,n1];
                for j:=i+1 to n Do
                        s:=s-a[i,j]*x[j];
                        x[i]:=s;
                end;
end;
 
BEGIN
clrscr;
  write('Poryadok sistemi = ');
  readln(n);
  matr(n,a);
 { matr1(n,a);}
  gauss(n,a,x,s);
if s<>0.0 then
        begin
        writeln('Otvet:');
        for i:=1 to n Do
        writeln('x',i,' = ',x[i]:0:3)
        end
        else writeln('det=0');
writeln('Nazhmite lubuu klavishy dlya vihoda iz progr..');
readkey;
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
23.09.2013, 21:43
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Метод Гаусса. Учесть множество решений и когда нет решений (Turbo Pascal):

Ввожу числа ответ получается нет решений, почему?
Program PR3; Var A, x, b, z: integer; Y:real; Begin; Write(‘a=’);...

множество решений системы
составить программу, определяющую какой характер имеет множество решений...

Решение СЛАУ система решений алгебраических уравненийметодм гаусса
Program Gauss; uses crt; const e=0.000001; const f=4; type yy=array of real;...

Определить, имеет ли система бесконечное множество решений
ax+by=c dx+ey=f Определить, имеет ли система ...

надо решить задачу: a*b=x,надо вывести х, а когда a и b равны 0, то написать что корней множество, а когда a или b равен 0, то вывести что корней нет
Здравствуйте господа... У меня вот такая проблема, на завтра надо решить...

2
Fakeoke
314 / 314 / 201
Регистрация: 28.07.2011
Сообщений: 1,849
26.09.2013, 15:19  [ТС] #2
аппп
0
Fakeoke
314 / 314 / 201
Регистрация: 28.07.2011
Сообщений: 1,849
06.10.2013, 21:47  [ТС] #3
никто не знает, да?
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
06.10.2013, 21:47
Привет! Вот еще темы с решениями:

Количество решений
Вводятся 5 чисел: a, b, c, d и e. Найдите все целые решения уравнения ( ax3 +...

Принятия решений,паскаль!
Определить, имеется ли среди заданных целых чисел A, B, C хотя бы одно...

Ограничение количества решений
У программы следующий код: Program tabl; const x1=-7; x2=11; {интервал} var...

Ребус, найти количество решений
Здравствуйте, ребят, помогите,пожалуйста с задачкой! Буду очень презнателен!!!!...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru