برنامه کامل در Wolfram Mathematica برای حل دستگاه n معادله و n مجهول

  • صفحه اول
  • برنامه کامل در Wolfram Mathematica برای حل دستگاه n معادله و n مجهول
image

برنامه کامل در Wolfram Mathematica برای حل دستگاه n معادله و n مجهول

سلام ببخشید می خواستم بدونم برنامه حل دستگاه n مجهول و n معادله را چطور بنویسم با استفاده از ماتریس؟   جواب: بله  

روش ۱: استفاده از توابع داخلی Mathematica (ساده و بهینه)

  
(* ::Package:: *)

SolveLinearSystem[coeffMatrix_, constVector_] := Module[
  {n, augmentedMatrix, solution},
  
  n = Length[coeffMatrix];
  
  (* بررسی سازگاری ابعاد ماتریس و بردار *)
  If[Dimensions[coeffMatrix] != {n, n} || Length[constVector] != n,
    Return["Error: Dimensions mismatch!"];
  ];
  
  (* حل سیستم با استفاده از توابع داخلی متمتیکا *)
  solution = LinearSolve[coeffMatrix, constVector];
  
  Return[solution];
]

(* مثال برای تست برنامه *)
A = {
  {2, 1, -1},
  {-3, -1, 2},
  {-2, 1, 2}
};
b = {8, -11, -3};

(* اجرای برنامه *)
result = SolveLinearSystem[A, b];
Print["Solution: ", result];
Print["Verify: ", A . result == b];​

روش ۲: پیاده‌سازی دستی الگوریتم حذف گاوسی

 
(* ::Package:: *)

GaussianElimination[coeffMatrix_, constVector_] := Module[
  {n, aug, temp, factor, solution, i, j, k},
  
  n = Length[coeffMatrix];
  aug = Join[coeffMatrix, {constVector}\[Transpose], 2];
  
  (* حذف به جلو - تبدیل به ماتریس مثلثی بالا *)
  For[k = 1, k <= n, k++,
    (* پیوتینگ جزئی: پیدا کردن سطر با بزرگترین عنصر در ستون جاری *)
    maxRow = k;
    For[i = k + 1, i <= n, i++,
      If[Abs[aug[[i, k]]] > Abs[aug[[maxRow, k]]],
        maxRow = i;
      ];
    ];
    
    (* جابجایی سطرها *)
    If[maxRow != k,
      temp = aug[[k]];
      aug[[k]] = aug[[maxRow]];
      aug[[maxRow]] = temp;
    ];
    
    (* اگر پیوت صفر باشد، سیستم تکین است *)
    If[aug[[k, k]] == 0,
      Return["System is singular or has no unique solution!"];
    ];
    
    (* حذف عناصر زیر پیوت *)
    For[i = k + 1, i <= n, i++,
      factor = aug[[i, k]] / aug[[k, k]];
      For[j = k, j <= n + 1, j++,
        aug[[i, j]] = aug[[i, j]] - factor * aug[[k, j]];
      ];
    ];
  ];
  
  (* جایگزینی به عقب *)
  solution = Table[0, {n}];
  For[i = n, i >= 1, i--,
    solution[[i]] = aug[[i, n + 1]];
    For[j = i + 1, j <= n, j++,
      solution[[i]] = solution[[i]] - aug[[i, j]] * solution[[j]];
    ];
    solution[[i]] = solution[[i]] / aug[[i, i]];
  ];
  
  Return[solution];
]

(* تابع برای نمایش مراحل حل *)
ShowSolutionSteps[coeffMatrix_, constVector_] := Module[
  {n, aug, steps, stepCounter = 1},
  
  n = Length[coeffMatrix];
  aug = Join[coeffMatrix, {constVector}\[Transpose], 2];
  steps = {"Initial Matrix: " <> ToString[aug // MatrixForm]};
  
  (* مراحل حل *)
  For[k = 1, k <= n, k++,
    (* عملیات سطری *)
    For[i = k + 1, i <= n, i++,
      If[aug[[k, k]] != 0,
        factor = aug[[i, k]] / aug[[k, k]];
        aug[[i]] = aug[[i]] - factor * aug[[k]];
        AppendTo[steps, "Step " <> ToString[stepCounter] <> 
          ": R" <> ToString[i] <> " = R" <> ToString[i] <> 
          " - (" <> ToString[factor] <> ") * R" <> ToString[k]];
        AppendTo[steps, aug // MatrixForm];
        stepCounter++;
      ];
    ];
  ];
  
  Return[steps];
]

(* مثال برای تست برنامه *)
A = {
  {2, 1, -1},
  {-3, -1, 2},
  {-2, 1, 2}
};
b = {8, -11, -3};

(* اجرای برنامه *)
Print["=== Gaussian Elimination Solution ==="];
solution = GaussianElimination[A, b];
Print["Solution: ", solution];

Print["\n=== Verification ==="];
Print["A . x = ", A . solution];
Print["b = ", b];
Print["Residual: ", A . solution - b];

Print["\n=== Solution Steps ==="];
steps = ShowSolutionSteps[A, b];
Do[Print[steps[[i]]], {i, Length[steps]}];​
 
روش ۳: نسخه پیشرفته با قابلیت‌های بیشتر
 
(* ::Package:: *)

AdvancedLinearSolver[coeffMatrix_, constVector_, method_: "Gaussian"] := Module[
  {n, solution},
  
  n = Length[coeffMatrix];
  
  (* بررسی معیارهای ورودی *)
  If[Det[coeffMatrix] == 0,
    Return["Warning: Matrix is singular! Determinant is zero."];
  ];
  
  If[MatrixRank[coeffMatrix] < n,
    Return["Warning: Matrix does not have full rank. Solution may not be unique."];
  ];
  
  (* انتخاب روش حل *)
  Switch[method,
    "Gaussian", solution = LinearSolve[coeffMatrix, constVector],
    "LU", solution = LUDecomposition[{coeffMatrix, constVector}][[2]],
    "Inverse", solution = Inverse[coeffMatrix] . constVector,
    _, solution = LinearSolve[coeffMatrix, constVector]
  ];
  
  (* محاسبه خطا *)
  residual = Norm[coeffMatrix . solution - constVector];
  conditionNumber = LinearAlgebra`MatrixConditionNumber[coeffMatrix];
  
  Return[<|
    "Solution" -> solution,
    "Residual" -> residual,
    "ConditionNumber" -> conditionNumber,
    "Method" -> method
  |>];
]

(* مثال استفاده *)
A = {
  {2, 1, -1},
  {-3, -1, 2},
  {-2, 1, 2}
};
b = {8, -11, -3};

(* حل با روش‌های مختلف *)
results = <||>;
methods = {"Gaussian", "LU", "Inverse"};

Do[
  results[method] = AdvancedLinearSolver[A, b, method],
  {method, methods}
];

(* نمایش نتایج *)
Print["=== Comparison of Methods ==="];
Do[
  Print["Method: ", method];
  Print["Solution: ", results[method]["Solution"]];
  Print["Residual: ", results[method]["Residual"]];
  Print["Condition Number: ", results[method]["ConditionNumber"]];
  Print[""],
  {method, methods}
];​
 
 
نحوه استفاده از برنامه:
  1. کد را در یک Notebook متمتیکا کپی کنید

  2. ماتریس ضرایب و بردار سمت راست خود را تعریف کنید:

    mathematica
    A = {{a11, a12, ..., a1n}, {a21, a22, ..., a2n}, ..., {an1, an2, ..., ann}};
    b = {b1, b2, ..., bn};
  3. تابع مورد نظر را فراخوانی کنید:

    mathematica
    solution = GaussianElimination[A, b];
  4. نتایج را مشاهده کنید

ویژگی‌های برنامه:

  • ✅ پشتیبانی از دستگاه‌های n معادله n مجهول

  • ✅ تشخیص خودکار ابعاد سیستم

  • ✅ بررسی تکین بودن ماتریس

  • ✅ پیوتینگ جزئی برای پایداری عددی

  • ✅ نمایش مراحل حل (اختیاری)

  • ✅ محاسبه خطا و عدد شرطی

  • ✅ پشتیبانی از چندین روش حل

این برنامه به شما امکان می‌دهد دستگاه معادلات خطی را به صورت کارآمد و دقیق در متمتیکا حل کنید.