Pascal/Turbo Pascal - metodo de jacobi y gauss-seidel

 
Vista:
sin imagen de perfil

metodo de jacobi y gauss-seidel

Publicado por elias (45 intervenciones) el 08/02/2015 23:26:46
Posibilidad de ver implementacion practica en pascal de eso métodos para calcular matrices...gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

metodo de jacobi y gauss-seidel

Publicado por ramon (2158 intervenciones) el 09/02/2015 23:33:06
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
112
113
114
115
116
117
118
{Mira esta parte}
 
program calculo_matricial_jacovi;
 uses
    crt;
  const
     max = 9;
     intentos = 51;
  type
     matriz = array[1..max,1..max] of real;
     arrais = array[1..max] of real;
     valormax = 1..max;
   var
     ma, mc, md, mp : matriz;
     ab, aq, ar, ax, ay : arrais;
     ri, rn, rj, doferencia : valormax;
     ik : 1..intentos;
 
 
  procedure entrada_datos(var a : matriz; var b : arrais; var n : valormax);
  var
    ii, jj : valormax;
   begin
      clrscr;
      write('   N. Ecuaciones De 1 A ',max,' : ');
      readln(n);
      writeln;
      for ii := 1 to n do
      begin
         writeln('  Ecuacion N. ',ii:1);
         writeln('  Coeficientes de ..');
         for jj := 1 to n do
         begin
            write('  X ',jj:1,' : ');
            readln(a[ii,jj]);
         end;
         write('  Termino Independiente : ');
         readln(b[ii]);
         writeln;
       end;
     end;
 
  procedure preparar_matriz(a : matriz; var c, d : matriz);
  var
    mw, mv : arrais;
    i, j, h : valormax;
    begin
        for h := 1 to rn - 1 do
         if a[h,h] = 0 then
           for i := h + 1 to rn do
            if a[i,h] <> 0 then
              for j := 1 to rn do
              begin
                  mv[j] := a[i,j];
                  mw[j] := a[h,j];
                  a[i,j] := mw[j];
                  a[h,j] := mv[j];
              end;
         for i := 1 to rn do
           for j := 1 to rn do
           begin
               if i = j then
               begin
                  c[i,i] := 0;
                  d[i,i] := a[i,i];
                end;
               if i <> j then
               begin
                  c[i,j] := a[i,j];
                  d[i,j] := 0;
               end;
            end;
          end;
 
  procedure resultados(s : arrais);
  var
    z : valormax;
    begin
       for z := 1 to rn do
       writeln(' X ',ri:1,' = ',S[z]:10:3);
       writeln;
    end;
 
 
  begin
    entrada_datos(ma, ab, rn);
    preparar_matriz(ma, mc, md);
    ik := 1;
    for ri := 1 to rn do
    ay[ri] := 1;
    writeln('  ***** Los Resultados Son *****');
    writeln;
  repeat
      for ri := 1 to rn do
        for rj := 1 to rn do
        mp[ri,rj] := - mc[ri,rj] / md[ri,ri];
        for ri := 1 to rn do
        aq[ri] := 0;
        for ri := 1 to rn do
          for rj := 1 to rn do
          aq[ri] := aq[ri] + mp[ri,rj] * ay[rj];
          for ri := 1 to rn do
          ar[ri] := ab[ri] / md[ri,ri];
          for ri := 1 to rn do
          ax[ri] := aq[ri] + ar[ri];
          doferencia := 1;
          for ri := 1 to rn do
           if abs(ax[ri] - ay[ri]) < 0.01 then
           doferencia := doferencia + 1;
           ay := ax;
           writeln('  Iteracion N. : ',ik);
           resultados(ax);
           ik := ik + 1;
       until (ik = intentos) or (doferencia = rn);
       writeln;
       writeln('   Pulse Una Tecla');
       readkey;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

metodo de jacobi y gauss-seidel

Publicado por elias (45 intervenciones) el 10/02/2015 00:18:51
Estupendo, Gracias! ahora bien, entiendo que es Jacobi únicamente, correcto? un par de dudas, como puedo ver los 3 primeros términos de la sucesión generada en por ejemplo P0= 4,10,6,2, hay una manera en la que pueda desplazarme por los resultados? solo veo las ultimas iteraciones y pide presionar tecla, luego me expulsa del programa...
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

metodo de jacobi y gauss-seidel

Publicado por ramon (2158 intervenciones) el 10/02/2015 22:13:49
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
{ A qui lo tienes}
program calculo_matricial;
 uses
    crt;
  const
     max = 9;
     intentos = 51;
  type
     matriz = array[1..max,1..max] of real;
     arrais = array[1..max] of real;
     valormax = 1..max;
   var
     ma, mc, md, mp : matriz;
     ab, aq, ar, ax, ay : arrais;
     ri, rn, rj, doferencia : valormax;
     ik : 1..intentos;
 
 
  procedure entrada_datos(var a : matriz; var b : arrais; var n : valormax);
  var
    ii, jj : valormax;
   begin
      clrscr;
      write('   N. Ecuaciones De 1 A ',max,' : ');
      readln(n);
      writeln;
      for ii := 1 to n do
      begin
         writeln('  Ecuacion N. ',ii:1);
         writeln('  Coeficientes de ..');
         for jj := 1 to n do
         begin
            write('  X ',jj:1,' : ');
            readln(a[ii,jj]);
         end;
         write('  Termino Independiente : ');
         readln(b[ii]);
         writeln;
       end;
     end;
 
  procedure preparar_matriz(a : matriz; var c, d : matriz);
  var
    mw, mv : arrais;
    i, j, h : valormax;
    begin
        for h := 1 to rn - 1 do
         if a[h,h] = 0 then
           for i := h + 1 to rn do
            if a[i,h] <> 0 then
              for j := 1 to rn do
              begin
                  mv[j] := a[i,j];
                  mw[j] := a[h,j];
                  a[i,j] := mw[j];
                  a[h,j] := mv[j];
              end;
         for i := 1 to rn do
           for j := 1 to rn do
           begin
               if i = j then
               begin
                  c[i,i] := 0;
                  d[i,i] := a[i,i];
                end;
               if i <> j then
               begin
                  c[i,j] := a[i,j];
                  d[i,j] := 0;
               end;
            end;
          end;
 
  procedure resultados(s : arrais);
  var
    z : valormax;
    begin
       for z := 1 to rn do
       writeln(' X ',ri:1,' = ',S[z]:10:3);
       writeln;
    end;
 
  var
    cont : integer;
  begin
    cont := 1;
    entrada_datos(ma, ab, rn);
    preparar_matriz(ma, mc, md);
    ik := 1;
    for ri := 1 to rn do
    ay[ri] := 1;
    writeln('  ***** Los Resultados Son *****');
    writeln;
  repeat
      for ri := 1 to rn do
        for rj := 1 to rn do
        mp[ri,rj] := - mc[ri,rj] / md[ri,ri];
        for ri := 1 to rn do
        aq[ri] := 0;
        for ri := 1 to rn do
          for rj := 1 to rn do
          aq[ri] := aq[ri] + mp[ri,rj] * ay[rj];
          for ri := 1 to rn do
          ar[ri] := ab[ri] / md[ri,ri];
          for ri := 1 to rn do
          ax[ri] := aq[ri] + ar[ri];
          doferencia := 1;
          for ri := 1 to rn do
           if abs(ax[ri] - ay[ri]) < 0.01 then
           doferencia := doferencia + 1;
           ay := ax;
           writeln('  Iteracion N. : ',ik);
           resultados(ax);
           cont := cont + 1;
           if cont > 8 then
           begin
              writeln('  Pulse Una Tecla Para Segir');
              readkey;
              cont := 1;
              clrscr;
              writeln;
           end;
           ik := ik + 1;
       until (ik = intentos) or (doferencia = rn);
       writeln;
       writeln('   Pulse Una Tecla');
       readkey;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

metodo de jacobi y gauss-seidel

Publicado por ramon (2158 intervenciones) el 10/02/2015 22:01:49
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{Esto de gauss}
 
program metodo_de_gauss;
 uses
   crt;
 
 const
   max = 51;
 
  type
     lamatriz = array[1..max,1..max] of real;
     contador = 1..max;
     nombre = string[50];
 
  var
  matriz : lamatriz;
  opci, dim : Contador;
  determinado : boolean;
 
  procedure presentamatriz(mat : lamatriz);
  var
    c, d : contador;
  begin
    for c := 1 to dim do
    begin
      for d := 1 to dim + 1 do
       write('   ',mat[c,d]:0:2);
       writeln;
    end;
    writeln
  end;
 
  procedure entravalores(var matr : lamatriz; var di : contador);
  var
    c, d : contador;
  begin
    writeln;
    write('Introduzca El Tama¤o de la matriz : ');
    readln(di);
    clrscr;
      for c := 1 to di do
        for d := 1 to di do
        begin
          writeln;
          write('Introduzca el Valor (',c,',',d,') : ');
          readln(matr[c,d]);
          clrscr;
        end;
      for c := 1 to di do
      begin
        writeln;
        write('Introduzca el valor independiente b(',c,') : ');
        readln(matr[c,di + 1]);
        clrscr
      end;
       writeln;
       writeln('Los Datos Entrados Son Los Siguiente');
       writeln;
       presentamatriz(matr);
   end;
 
  procedure prepararmatriz(var matr : lamatriz; di : integer; var correcto : boolean);
  var
    pas, c, d : contador;
    corre : boolean;
    te, aux : real;
  begin
    for pas := 1 to di do
    begin
      corre := false;
      c := pas;
      while (not corre) and (c <= di) do
      begin
        If abs(matr[c,pas]) > 0.00001 then
        corre := true;
        c := c + 1;
      end;
      c := c - 1;
      If corre = true then
      begin
        te := matr[c,pas];
        for d := pas to di + 1 do
        begin
          if c <> pas then
          begin
            aux := matr[pas,d];
            matr[pas,d] := matr[pas,d] / te;
            matr[c,d] := aux;
          end
      else
            matr[pas,d] := matr[pas,d] / te;
        end;
      end;
     for c := pas + 1 to di do
     begin
       aux := matr[c,pas];
       for d := pas to di + 1 do
         matr[c,d] := matr[c,d] - aux * matr[pas,d];
      end;
    end;
    correcto := true;
    writeln(' *** Los Resultados Son ***');
    writeln;
    for c := 1 to di do
      if abs(matr[c,c]) < 0.00001 then
        correcto := false;
    if correcto = true then
    begin
      presentamatriz(matr);
      for pas := di downto 1 do
      begin
        te := matr[pas,pas];
        matr[pas,pas] := 1;
        matr[pas,di + 1] := matr[pas,di + 1] / te;
        for c := pas - 1 downto 1 do
        begin
          aux := matr[c,pas];
          matr[c,pas] := 0;
          matr[c,di + 1] := matr[c,di + 1] - matr[pas,di + 1] * aux;
        end;
      end;
      presentamatriz(matr);
    end;
  end;
 
  procedure presenta_operacion(matr : lamatriz);
  var
    c : contador;
   begin
    writeln('Las Operaciones Son');
    writeln;
    for c := 1 to dim do
    writeln('  Matriz ',c,' = ',matr[c,dim + 1]:0:10);
  end;
 
  begin
  clrscr;
  writeln;
  writeln('    ***** Metodo De Gauss *****');
  writeln;
  entravalores(matriz,dim);
  writeln;
   prepararmatriz(matriz,dim,determinado);
   writeln;
    If determinado = true then
    begin
      presenta_operacion(matriz);
    end;
    readkey;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar