برنامه کامل در 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}
];
-
کد را در یک Notebook متمتیکا کپی کنید
-
ماتریس ضرایب و بردار سمت راست خود را تعریف کنید:
mathematicaA = {{a11, a12, ..., a1n}, {a21, a22, ..., a2n}, ..., {an1, an2, ..., ann}}; b = {b1, b2, ..., bn}; -
تابع مورد نظر را فراخوانی کنید:
mathematicasolution = GaussianElimination[A, b];
-
نتایج را مشاهده کنید
ویژگیهای برنامه:
-
✅ پشتیبانی از دستگاههای n معادله n مجهول
-
✅ تشخیص خودکار ابعاد سیستم
-
✅ بررسی تکین بودن ماتریس
-
✅ پیوتینگ جزئی برای پایداری عددی
-
✅ نمایش مراحل حل (اختیاری)
-
✅ محاسبه خطا و عدد شرطی
-
✅ پشتیبانی از چندین روش حل
این برنامه به شما امکان میدهد دستگاه معادلات خطی را به صورت کارآمد و دقیق در متمتیکا حل کنید.