任意二维数组矩阵的旋转、转置处理自定义函数

香川群子

在研究 8皇后排列问题时，产生了对结果进行去重复的要求。

即，任一满足条件的结果，需要排除其90度旋转、以及行列转置后产生的镜像对称图形。


于是，扩展到一般的二维矩阵(包括行数、列数不同的矩形矩阵)
对它们进行一共8种不同镜像对称结果的计算。

^_^

请先看附图：

香川群子

以下为自定义函数：

附件为使用例子。（也可用于VBA内存数组的转换）

1. Function JoinTurnArr(Rng_Arr, k&, Optional z& = 0) 'k=4/5,3/6,2/7,1/8
   
2.     Dim i&, j&, l1&, l2&, u1&, u2&, r&, s$, t&
   
3.     If IsObject(Rng_Arr) Then arr = Rng_Arr.Value Else arr = Rng_Arr
   
4.     l1 = LBound(arr): u1 = UBound(arr): l2 = LBound(arr, 2): u2 = UBound(arr, 2)
   
5.     If z Then
   
6.         s = ""
   
7.         If k Mod 2 Then
   
8.             For j = l2 To u2
   
9.                 For i = l1 To u1
   
10.                     r = r + 1
    
11.                     If k = 5 Then t = arr(i, j) 'adcb OK
    
12.                     If k = 3 Then t = arr(i, u2 - j + l2) 'bcda OK
    
13.                     If k = 7 Then t = arr(u1 - i + l1, u2 - j + l2) 'cbad OK
    
14.                     If k = 1 Then t = arr(u1 - i + l1, j) 'dabc OK
    
15.                     If t Then s = s & "," & r
    
16.                 Next
    
17.             Next
    
18.         Else
    
19.             For i = l1 To u1
    
20.                 For j = l2 To u2
    
21.                     r = r + 1
    
22.                     If k = 4 Then t = arr(i, j) 'abcd OK
    
23.                     If k = 6 Then t = arr(i, u2 - j + l2) 'badc OK
    
24.                     If k = 2 Then t = arr(u1 - i + l1, u2 - j + l2) 'cdab OK
    
25.                     If k = 8 Then t = arr(u1 - i + l1, j) 'dcba OK
    
26.                     If t Then s = s & "," & r
    
27.                 Next
    
28.             Next
    
29.         End If
    
30.         JoinTurnArr = Mid(s, 2)
    
31.     Else
    
32.         If k = 4 Then JoinTurnArr = arr: Exit Function
    
33.         If k Mod 2 Then ReDim trr(l2 To u2, l1 To u1) Else ReDim trr(l1 To u1, l2 To u2)
    
34.         For i = l1 To u1
    
35.             For j = l2 To u2
    
36. '                If k = 4 Then trr(i, j) = arr(i, j) 'abcd OK
    
37.                 If k = 5 Then trr(j, i) = arr(i, j) 'adcb OK
    
38.                
    
39.                 If k = 3 Then trr(u2 - j + l2, i) = arr(i, j) 'bcda OK
    
40.                 If k = 6 Then trr(i, u2 - j + l2) = arr(i, j) 'badc OK
    
41.                
    
42.                 If k = 2 Then trr(u1 - i + l1, u2 - j + l2) = arr(i, j) 'cdab OK
    
43.                 If k = 7 Then trr(u2 - j + l2, u1 - i + l1) = arr(i, j) 'cbad OK
    
44.                
    
45.                 If k = 1 Then trr(j, u1 - i + l1) = arr(i, j) 'dabc OK
    
46.                 If k = 8 Then trr(u1 - i + l1, j) = arr(i, j) 'dcba OK
    
47.             Next
    
48.         Next
    
49.         JoinTurnArr = trr
    
50.     End If
    
51. End Function

复制代码

EXCEL江湖

香川裙子老师厉害呀，学习！

lee1892

香川群子 发表于 2014-8-21 17:15
以下为自定义函数：

附件为使用例子。（也可用于VBA内存数组的转换）

建一个一维表，对照2维表按先行后列赋值为1到MxN，其序号为结果矩阵的位置编号，值为原始矩阵的位置编号。

对不同的转换方式，找出原位置和新位置编号之间的数学关系，直接计算得出。

香川群子

lee1892 发表于 2014-8-21 23:44
建一个一维表，对照2维表按先行后列赋值为1到MxN，其序号为结果矩阵的位置编号，值为原始矩阵的位置编号。 ...

这样计算、比直接双层循环效率更低。

…………

当然，说到效率，我应该把8种情况各自写对应的循环代码，
虽然代码增加很多，但是每次循环都要判断模式k值效率影响很大的。
…………虽然数组元素较少时影响不大。

呵呵。

jsxjd

香川群子 发表于 2014-8-22 11:46
这样计算、比直接双层循环效率更低。

…………

双重循环足已，一维循环都能处理
无否是简单的位置关系！

香川群子

jsxjd 发表于 2014-8-22 12:57
双重循环足已，一维循环都能处理
无否是简单的位置关系！

呵呵，任何代码，单独分开来看，也都没有什么了不起……

jsxjd

香川群子 发表于 2014-8-22 13:40
呵呵，任何代码，单独分开来看，也都没有什么了不起……

思路、方法、效率还是有优劣的

lee1892

香川群子 发表于 2014-8-22 11:46
这样计算、比直接双层循环效率更低。

…………

哦，那你一定试过了？对比代码放上来看看？

lee1892

香川群子 发表于 2014-8-22 11:46
这样计算、比直接双层循环效率更低。

…………

哦，那你一定试过了？对比代码放上来看看？