- Clear["Global`*"];
- (*四面体体积公式,a,b,c分别是从一个顶点出发的三条棱,x,y,z分别是对棱*)
- fun[input_]:=Module[{a,b,c,x,y,z},{a,b,c,x,y,z}=input;Det[{{0,1,1,1,1},{1,0,a^2,b^2,c^2},{1,a^2,0,z^2,y^2},{1,b^2,z^2,0,x^2},{1,c^2,y^2,x^2,0}}]]
- aaa=fun[{a,b,c,x,y,z}]
- (*列出所有的排列*)
- bbb=Permutations[{a, b, c, x, y, z}];
- (*对所有的排列,计算“体积”,并且找出体积等于aaa的*)
- ccc=Select[{#,fun[#]}&/@bbb,#[[2]]==aaa&];
- (*只保留第一个元素,去掉体积,看看哪些保持体积不变了*)
- ddd=#[[1]]&/@ccc;
- eee=ddd/.{a->1,b->2,c->3,x->4,y->5,z->6}
- fff=PermutationCycles[#]&/@eee
复制代码
生成结果告诉我们:交换一组棱,不可能保持体积不变,
还有啥结论呢?
{{1,2,3,4,5,6},{1,3,2,4,6,5},{1,5,6,4,2,3},{1,6,5,4,3,2},{2,1,3,5,4,6},{2,3,1,5,6,4},{2,4,6,5,1,3},{2,6,4,5,3,1},{3,1,2,6,4,5},{3,2,1,6,5,4},{3,4,5,6,1,2},{3,5,4,6,2,1},{4,2,6,1,5,3},{4,3,5,1,6,2},{4,5,3,1,2,6},{4,6,2,1,3,5},{5,1,6,2,4,3},{5,3,4,2,6,1},{5,4,3,2,1,6},{5,6,1,2,3,4},{6,1,5,3,4,2},{6,2,4,3,5,1},{6,4,2,3,1,5},{6,5,1,3,2,4}}
{Cycles[{}], Cycles[{{2, 3}, {5, 6}}], Cycles[{{2, 5}, {3, 6}}],
Cycles[{{2, 6}, {3, 5}}], Cycles[{{1, 2}, {4, 5}}],
Cycles[{{1, 2, 3}, {4, 5, 6}}], Cycles[{{1, 2, 4, 5}, {3, 6}}],
Cycles[{{1, 2, 6}, {3, 4, 5}}], Cycles[{{1, 3, 2}, {4, 6, 5}}],
Cycles[{{1, 3}, {4, 6}}], Cycles[{{1, 3, 5}, {2, 4, 6}}],
Cycles[{{1, 3, 4, 6}, {2, 5}}], Cycles[{{1, 4}, {3, 6}}],
Cycles[{{1, 4}, {2, 3, 5, 6}}], Cycles[{{1, 4}, {2, 5}}],
Cycles[{{1, 4}, {2, 6, 5, 3}}], Cycles[{{1, 5, 4, 2}, {3, 6}}],
Cycles[{{1, 5, 6}, {2, 3, 4}}], Cycles[{{1, 5}, {2, 4}}],
Cycles[{{1, 5, 3}, {2, 6, 4}}], Cycles[{{1, 6, 2}, {3, 5, 4}}],
Cycles[{{1, 6}, {3, 4}}], Cycles[{{1, 6, 5}, {2, 4, 3}}],
Cycles[{{1, 6, 4, 3}, {2, 5}}]} |