Wolfram mathematica 在mathematica中创建符号正交矩阵

我需要在Mathematica中创建一个3乘3的实正交符号矩阵。

---

我该怎么做呢？

我不建议这样做，但

m = Array[a, {3, 3}];
{q, r} = QRDecomposition[m];
q2 = Simplify[q /. Conjugate -> Identity]

---

所以q2是一个符号正交矩阵（假设我们在实数上工作）。

我想你似乎想要一些

So（3）

在Mathematica中的群参数化。您将只有3个独立的符号（变量），因为您有6个来自向量相互正交性的约束，且范数等于1。一种方法是围绕3个轴构造独立的旋转，并将这些矩阵相乘。下面是执行此操作的代码（可能太复杂）：

makeOrthogonalMatrix[p_Symbol, q_Symbol, t_Symbol] :=
  Module[{permute, matrixGeneratingFunctions},
    permute =  Function[perm, Permute[Transpose[Permute[#, perm]], perm] &];
    matrixGeneratingFunctions = 
       Function /@ FoldList[
            permute[#2][#1] &,
            {{Cos[#], 0, Sin[#]}, {0, 1, 0}, {-Sin[#], 0, Cos[#]}},
            {{2, 1, 3}, {3, 2, 1}}];
    #1.#2.#3 & @@  MapThread[Compose, {matrixGeneratingFunctions, {p, q, t}}]];

以下是其工作原理：

In[62]:= makeOrthogonalMatrix[x,y,z]
Out[62]= 
{{Cos[x] Cos[z]+Sin[x] Sin[y] Sin[z],Cos[z] Sin[x] Sin[y]-Cos[x] Sin[z],Cos[y] Sin[x]},
 {Cos[y] Sin[z],Cos[y] Cos[z],-Sin[y]},
 {-Cos[z] Sin[x]+Cos[x] Sin[y] Sin[z],Cos[x] Cos[z] Sin[y]+Sin[x] Sin[z],Cos[x] Cos[y]}}

---

您可以通过对各种列（或行）点积使用

Simplify

检查矩阵是否正交。

Marcellus，您必须使用SO（3）的一些参数化，因为您的通用矩阵必须反映。如果没有多值或奇点，任何单个参数化都不会覆盖整个组。维基百科有一个很好的页面，介绍各种各样的信息

也许概念上最简单的一个是李代数so（3）中的指数映射。 定义一个反对称的实数

A

（跨越so（3））

那么

MatrixExp[A]

是

SO（3）

的一个元素。 我们可以使用

Transpose[MatrixExp[A]].MatrixExp[A] == IdentityMatrix[3] // Simplify

如果我们写

t^2=a^2+b^2+c^2

，我们可以将矩阵简化为指数矩阵

{{   b^2 + (a^2 + c^2) Cos[t]  , b c (1 - Cos[t]) + a t Sin[t], a b (1 - Cos[t]) - c t Sin[t]}, 
 {b c (1 - Cos[t]) - a t Sin[t],    c^2 + (a^2 + b^2) Cos[t]  , a c (1 - Cos[t]) + b t Sin[t]}, 
 {a b (1 - Cos[t]) + c t Sin[t], a c (1 - Cos[t]) - b t Sin[t],    a^2 + (b^2 + c^2) Cos[t]}} / t^2

注意，这与给出的参数化基本相同。 与来自的输出进行比较

RotationMatrix[s, {b, c, a}] // ComplexExpand // Simplify[#, Trig -> False] &;
% /. a^2 + b^2 + c^2 -> 1

我找到了一种“直接”的方法来施加特殊的正交性。 见下文

(*DEFINITION OF ORTHOGONALITY AND SELF ADJUNCTNESS CONDITIONS:*) 
MinorMatrix[m_List?MatrixQ] := Map[Reverse, Minors[m], {0, 1}] 
CofactorMatrix[m_List?MatrixQ] := MapIndexed[#1 (-1)^(Plus @@ #2) &, MinorMatrix[m], {2}] 
UpperTriangle[ m_List?MatrixQ] := {m[[1, 1 ;; 3]], {0, m[[2,   2]], m[[2, 3]]}, {0, 0, m[[3, 3]]}}; 
FlatUpperTriangle[m_List?MatrixQ] := Flatten[{m[[1, 1 ;; 3]], m[[2, 2 ;; 3]], m[[3, 3]]}];
Orthogonalityconditions[m_List?MatrixQ] := Thread[FlatUpperTriangle[m.Transpose[m]] == FlatUpperTriangle[IdentityMatrix[3]]]; 
Selfadjunctconditions[m_List?MatrixQ] := Thread[FlatUpperTriangle[CofactorMatrix[m]] == FlatUpperTriangle[Transpose[m]]]; 
SO3conditions[m_List?MatrixQ] := Flatten[{Selfadjunctconditions[m], Orthogonalityconditions[m]}]; 

(*Building of an SO(3) matrix*) 
mat = Table[Subscript[m, i, j], {i, 3}, {j, 3}]; 
$Assumptions = SO3conditions[mat]

然后

给1；。。。及

MatrixForm[Simplify[mat.Transpose[mat]]

给出了单位矩阵； …终于

MatrixForm[Simplify[CofactorMatrix[mat] - Transpose[mat]]]

给出一个零矩阵

========================================================================

当我问我的问题时，这就是我想要的！ 但是，让我知道你对这种方法的想法

---

马塞勒斯

虽然我很喜欢马塞勒斯回答自己问题的想法，但这并不完全正确。不幸的是，他到达的条件也会导致

Simplify[Transpose[mat] - mat]

求零矩阵！这显然是不对的。以下是一种既正确又更直接的方法：

OrthogonalityConditions[m_List?MatrixQ] := Thread[Flatten[m.Transpose[m]] == Flatten[IdentityMatrix[3]]];
SO3Conditions[m_List?MatrixQ] := Flatten[{OrthogonalityConditions[m], Det[m] == 1}];

---

i、 e.将旋转矩阵与其转置相乘得到单位矩阵，旋转矩阵的行列式为1。

什么样的矩阵？Mathematica为旋转矩阵和反射矩阵内置了函数，它们都是正交矩阵。我想建立一个符号矩阵，这样在后续计算中，矩阵将始终被视为正交矩阵。mathematica中的命令旋转矩阵不能做到这一点。科学计算中有一个相关的问题，Leonid，谢谢你的回答。实际上，我想定义一个通用的符号SO（3）矩阵，而不是像你那样从Euler角度开始。基本上，我想设置一个通用矩阵（例如，使用mat=Table[Subscript[m，I，j]，{I，3}，{j，3}]），并强制该矩阵的元素将始终被视为满足正交性条件和行列式=1条件，而无需在后面指定这一条件。Marcello@user1087909那么，丹尼尔的答案应该是正确的。奇怪的是，在回答我的评论/问题时，我想说莱昂尼德的答案是正确的。@Daniel确实很有趣。实际上，我又看了一遍我的代码，意识到与其用

FoldList

等复杂的东西，我应该直接列出所有3个矩阵——我的代码非常混乱，没有什么好的理由。将很快更改为此版本。丹尼尔，谢谢你的回答。你有没有发现任何方法可以“直接”施加正交性的六个条件和det=1的条件，而不涉及qr分解？谢谢马塞罗回答得很好。然而，我更喜欢更直接地定义一个满足SO（3）条件的矩阵……请参阅我上面的答案，并让我知道您的想法。马塞勒斯

Simplify[Transpose[mat] - mat]

OrthogonalityConditions[m_List?MatrixQ] := Thread[Flatten[m.Transpose[m]] == Flatten[IdentityMatrix[3]]];
SO3Conditions[m_List?MatrixQ] := Flatten[{OrthogonalityConditions[m], Det[m] == 1}];