الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

برمجه سلسه

مغلق
بدأه عرفه في 21 يونيو 2004 · 32 رد · 2,742 مشاهدة · في لغة Delphi
مشاركة: واتساب X فيسبوك تيليجرام
#26

السلام عليكم ورحمه الله وبركاته

احي الكريم

شكرا لحسن تعاونك معي

بالنسبه للمصفوفه

بعد الحصول علي مصفوفه الجمع المعقده (الاولي) يتم ضربها في المصفوفه الاحاديه التي تمثل مصفوفه المجاهيل ولكن قبل عمليه الضرب نستخدم طريقه جاوس للحدف او جاكوبي او جاوس سيدل ودلك لغرض لحساب قيمه المجاهيل

اما بخصوص احد هده الطرق فادا كنت ليس لك علما مسبقا بها فسوف احاول انزال البرنامج الخاص بها .

سلام

#27

السلام عليكم

بالنسبه للطرق اعلمتك بها وهي جاكوبي او جاوس سيدل او جاوس للحدف

وان شاء الله سوف تفهم وظيفتهم بعد انزال البرامج الخاصه بيهم

و يتم استدعائهم في البرنامج الحالي بعد حساب مصفوفه الجمع المعقده(الاولي)

فعن طريق هده الطرق يتم حساب قيم المجاهيل

سلامات

#28 
السلام عليكم ورحمه الله وبركاته
اخواني الكرام هدا احدي البرامج تاتي اخبرتكم عنها ولها وطيفه معينه في برنامجي المطلوب .
برنامج طريقه جاوس:
                                                    
                                   
 ; program aa
#29

program hanan;

uses crt;

const n=3;

procedure mat;

var a,a1:array [1..n,1..n+1] of real;

b,x,x1:array[1..n] of real;

i,j,k:integer;

det,sum,m:real;

begin

writeln('this matrix is the conficients matrix ':10);

for i:= 1 to n do

for j:= 1 to n do

begin

write('a[',i,',',j,']=');

readln(a[i,j]);

end;

writeln(' this matrix is the right hand side vector':10);

for k:= 1 to n do

begin

write('b[',k,']=');

read(b[k]);

end;

writeln('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');

writeln('*** the matrix after augument ***');

k:=1;

for i:= 1 to n do

begin

a[i,n+1]:=b[k];

for j:= 1 to n+1 do

write(a[i,j]:4:0);

writeln;

k:=k+1;

end;

for k:= 1 to n-1 do

begin

for i:=k+1 to n do

begin

m:=a[i,k]/a[k,k];

for j:=k to n+1 do

a[i,j]:=a[i,j]-m*a[k,j];

end;

end;

writeln('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');

writeln('*** the matrix after zeroing ****');

for i:= 1 to n do

begin

for j:= 1 to n do

write(a[i,j]:7:2);

writeln;

end;

det:=1;

for i:= 1 to n do

det:=det*a[i,i];

writeln(' the determinant of the matrix is =',det:6:3);

writeln('^^^^^^ the unknown vector ^^^^^^');

x[n]:=a[n,n+1]/a[n,n];

for i:=n downto 1 do

begin

sum:=0;

for j:=1+i to n do

sum:=sum+a[i,j]*j+x;

x:=(a[i,n+1]-sum)/a[i,i];

writeln('x[',i,']=',x:6:3);

end;

end;

begin

clrscr;

mat;

end.


      
      

      
    

  

    
    

      
#30
        
        

      
[
program  hanan;
uses crt;
const  n=3;
procedure mat;
var  a,a1:array [1..n,1..n+1]  of  real;
      b,x,x1:array[1..n]  of  real;
 i,j,k:integer;
   det,sum,m:real;
begin
   writeln('this matrix is the conficients matrix ':10);
   for  i:=  1 to  n  do
    for j:= 1  to  n do
     begin
       write('a[',i,',',j,']=');
       readln(a[i,j]);
     end;
    writeln('   this matrix is the right  hand side  vector':10);
    for k:= 1  to n do
     begin
      write('b[',k,']=');
      read(b[k]);
     end;
    writeln('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
    writeln('*** the matrix  after  augument ***');
    k:=1;
    for i:=  1  to  n do
     begin
       a[i,n+1]:=b[k];
       for j:=  1 to  n+1 do
       write(a[i,j]:4:0);
       writeln;
       k:=k+1;
     end;
    for k:= 1  to  n-1  do
     begin
      for i:=k+1  to  n do
       begin
        m:=a[i,k]/a[k,k];
        for j:=k to  n+1 do
        a[i,j]:=a[i,j]-m*a[k,j];
       end;
    end;
   writeln('%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%');
   writeln('*** the matrix  after  zeroing ****');
   for i:=  1  to  n do
    begin
      for j:= 1  to  n  do
       write(a[i,j]:7:2);
       writeln;
    end;
    det:=1;
    for i:=  1  to n do
     det:=det*a[i,i];
      writeln('   the determinant   of the matrix  is =',det:6:3);
      writeln('^^^^^^  the unknown vector ^^^^^^');
       x[n]:=a[n,n+1]/a[n,n];
       for i:=n downto  1 do
         begin
           sum:=0;
           for j:=1+i  to  n do
             sum:=sum+a[i,j]*j+x;
             x:=(a[i,n+1]-sum)/a[i,i];
             writeln('x[',i,']=',x:6:3);
        end;
end;
 begin
     clrscr;
     mat;
  end.

      
      

      
    

  

    
    

      
#31
        
        

      
السلام عليكم 
والبرنامج الثاني وهو طريقه جاكوبي:


uses crt;
const n=3;
var i,j,k:integer;
    t,sum:real;
    l,u,d,a:array[1..10,1..10]of real;
      xo,x,b:array[1..10]of real;
procedure r;
begin
     for i:=1 to n-1 do
     begin
         for j:=i+1 to n do
              if(abs(a[i,i])<abs(a[j,i]))then
        begin
             for k:=1 to n do
             begin
                  t:=a[i,k];
                  a[i,k]:=a[j,k];
                  a[j,k]:=t;
             end;
        end;
     end;
     for i:= 1 to n do
        begin
             for j:= 1 to n do
              write(a[i,j]:3:2);
              writeln;
         end;
         writeln;writeln;
         end;
procedure jakoby;
begin
     for i:= 1 to n do
      for j:= 1 to n+1 do
      begin
           writeln('a[',i,j,']:=');
            readln(a[i,j]);
      end;
      r;
          for i:=1 to n do
       for j:= 1 to n do
       begin
            if(i<j)then
                l[i,j]:=0
            else
                 l[i,j]:=a[i,j];
       end;
        for i:= 1 to n do
        begin
             for j:= 1 to n do
              write(l[i,j]:3:2);
              writeln;
         end;
         writeln;writeln;
          for i:=1 to n do
          for j:= 1 to n do
          begin
                if(i=j)then
                d[i,j]:=a[i,j]
                       else
                d[i,j]:=0;
         end;
        for i:= 1 to n do
        begin
             for j:= 1 to n do
              write(d[i,j]:3:2);
              writeln;
         end;
         writeln;writeln;
       for i:=1 to n do
         for j:=1 to n do
          begin
           if(i<j)then
             u[i,j]:=a[i,j]
                 else
             u[i,j]:=0;
          end;
       for i:= 1 to n do
        begin
             for j:= 1 to n do
              write(u[i,j]:3:2);
              writeln;
         end;
         writeln;writeln;
         for i:= 1 to n do
         begin
          writeln('enter the value of xo');
          readln(xo);
         end;
      for k:=1 to 5 do
      begin
        for i:=1 to n do
        begin
           sum:=0;
           for j:=1 to n do
           begin
              if(i<>j)then
              begin
                sum:=sum+a[i,j]*xo[j];
                x:=1/a[i,i]*(a[i,n+1]-sum);
             end;
           end;
              writeln(x:3:2);
        end;
        for i:=1 to n do
              xo:=x;
       end;
end;

begin
    clrscr;
    textcolor(11);
    jakoby;
end.

      
      

      
    

  

    
    

      
#32
        
        

      
[CODE]
PROGRAM LEAST_SQUARES;
{USES CRT;}
CONST ROW=40;
TYPE MATRIX=AR
RAY[1..ROW] OF REAL;
var  MAT:ARRAY[1..ROW,1..ROW] OF REAL;
     X,Y,Q:MATRIX;
     L,R,D,D1,I,J,JJ,K,K1,N,S,H,T,M:INTEGER;
     C,F,SUM,SUMS,F1,E:REAL;
PROCEDURE GAUSS_ELIMINTION;
BEGIN
        M:=N+1;
        FOR I:=1 TO M-1 DO
        BEGIN
        FOR J:=I+1 TO M DO
        IF(MAT[I,I]<MAT[J,I]) THEN
        FOR K:=1 TO M+1 DO
               BEGIN
                 C:=MAT[I,K];
                 MAT[I,K]:=MAT[J,K];
                 MAT[J,K]:=C;
               END;
               FOR T:=1 TO N DO
                   BEGIN
                   FOR K:=1 TO M+1 DO
                   WRITE(MAT[T,K]:9:4);
                   WRITELN;
                   END;
                   WRITELN;
                   READLN;
                   END;
    FOR I:=1 TO M-1 DO
    BEGIN
         FOR J:=I+1 TO M DO
         BEGIN
         E:=MAT[J,I]/MAT[I,I];
         FOR K:=1 TO M+1 DO
         MAT[J,K]:=MAT[J,K]-E*MAT[I,K];
         END;
              FOR K:=1 TO M DO
              BEGIN
                FOR T:=1 TO M+1 DO
                WRITE(MAT[K,T]:9:4);
                WRITELN;
              END;
              WRITELN;
  END;
  X[M]:=MAT[M,M+1]/MAT[M,M];
  FOR I:=M-1 DOWNTO 1 DO
   BEGIN
     SUM:=0;
     FOR J:=I+1 TO M DO
     SUM:=SUM+MAT[I,J]*X[J];
     X:=(MAT[I,M+1]-SUM)/MAT[I,I];
   END;

   FOR I:=1 TO M DO
    WRITELN(' X[',I,']:=',X:2:3);
    WRITELN;
    END;
              BEGIN           {MAIN PROGRAM}
           {   CLRSCR;}
              {TEXTCOLOR(12);}
             { TEXTBACKGROUND(1);}
              {WINDOW(10,6,70,20);}
              WRITELN('  -------ENTER  DEGREE M OF VALUE PLEASE-------');
              READ(M);
              FOR I:=1 TO M DO
                BEGIN
                WRITE('       [X',I,']=');
                READLN(X);
                END;
        FOR I:=1 TO M DO
        BEGIN
        WRITE('                   [Y',I,']=');
        READLN(Y);
        END;
    WRITELN('    --------ENTER NUMBER POINTS N PLEASE--------');
    READ(N);
     L:=2*N;
     FOR R:=1 TO M DO
      BEGIN
        FOR I:=1 TO N+1 DO
         BEGIN
            S:=(1+(2*N))-R;
            SUM:=0;
            FOR J:=1 TO M DO
            BEGIN
                 F:=1;
                 FOR K:=1 TO (1+S)-I do
                 F:=F*X[J];
                 SUM:=SUM+F;
            END;
                MAT[I,R]:=SUM;
                SUMS:=0;
                FOR JJ:=1 TO M DO
                BEGIN
                   F1:=1;
                   FOR K1:=1 TO (1+N)-R DO
                   F1:=F1*X[JJ];
                   SUMS:=SUMS+(F1*Y[JJ]);
                END;
              Q[R]:=SUMS;
            END;
        END;
         FOR D:=1 TO N+1 DO
         MAT[D,N+1]:=Q[D];
         READLN;
         GAUSS_ELIMINTION;
END.

      
      

      
    

  

    
    

      
#33
        
        

      
السلام عليكم
اخواني انا اشكر كم علي  محاولاتكم الجباره لمساعدتي
وان شاء الله ان تحسب في ميزان حسناتكم
وطبعا البرنامج السابق او الدي اضفته الاخير هو الحل لهدا البرنامج
فقد احببت تنزيله للافاده والمعلوميه
وشكرا

      
      

      
    

  

    
    
 هذا الموضوع مغلق.

    
 مواضيع مشابهة





  

    
عدد الزوار حالياً
المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

    
—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

    
جارٍ التحقق من المتواجدين…