ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: Moneky

生成所有符合条件的四阶幻方

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-2-8 14:58 | 显示全部楼层
我的计算速度要快的多。

4x4=34.zip

231.48 KB, 下载次数: 24

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-2-8 15:10 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 Moneky 于 2017-2-8 15:19 编辑
香川群子 发表于 2017-2-8 14:58
我的计算速度要快的多。

好像有些是等于35的,还有些等于40,42的——位于对角线

TA的精华主题

TA的得分主题

发表于 2017-2-8 20:26 | 显示全部楼层
本帖最后由 香川群子 于 2017-2-8 20:51 编辑
Moneky 发表于 2017-2-8 15:10
好像有些是等于35的,还有些等于40,42的——位于对角线

是的,最后一组竖的以及反斜线这2组没有检查验证。

所以最后结果少了很多!

含镜像有3328组,不含镜像旋转只有416组了。
经检查算法有遗漏。

TA的精华主题

TA的得分主题

发表于 2017-2-8 22:21 | 显示全部楼层
修改了一下程序,把1的3个不同位置代码合并统一了。

另外增加了最后2组的检查语句,经测试可以正确运行了。

最后结果,(1,1)位置和(2,2)位置都是208种,(1,2)位置较多有464种(含2,1旋转对称)
总共是880个不重复解(排除旋转镜像对称)。

如果含旋转镜像对称,那就是7040个。

递归算4阶幻方.rar

108.28 KB, 下载次数: 42

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-2-8 22:24 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
我的算法,对1的位置进行限定,可以大大减少递归计算量。所以速度较快。

等到计算出满足条件解时,再进行旋转镜像 X 8 就可以了。效率很高。

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-2-9 12:25 | 显示全部楼层
香川群子 发表于 2017-2-8 22:24
我的算法,对1的位置进行限定,可以大大减少递归计算量。所以速度较快。

等到计算出满足条件解时,再进 ...

你的速度是比较快,是求出一个基本的,然后经过变换得到其他的。

我的代码是直接穷举列出,速度是会慢很多。

TA的精华主题

TA的得分主题

发表于 2017-2-9 14:04 | 显示全部楼层
Moneky 发表于 2017-2-9 12:25
你的速度是比较快,是求出一个基本的,然后经过变换得到其他的。

我的代码是直接穷举列出,速度是会慢 ...

你的算法也很有意思。理论上是无懈可击的。

不过如果能够进行优化,应该可以提高速度。

TA的精华主题

TA的得分主题

发表于 2017-2-9 16:43 | 显示全部楼层
对一个行已经凑齐的数组进行列凑数的递归算法,比全排列24*24*24肯定要快。

  1. Dim ar, h&, z&, cnt&
  2. Sub test()
  3.     h = 34
  4.     ar = [a1].Resize(4, 4)
  5.     z = 0: cnt = 0: Call dg(h - ar(1, 1), ",", 2, 1, 0)
  6.     Debug.Print cnt
  7. End Sub
  8. Sub dg(r&, s$, i&, j1&, t&)
  9. '    cnt = cnt + 1
  10.     If z Then Exit Sub
  11.     If i = 5 Then
  12.         If r = 0 Then
  13.             sr = Split(s, ",")
  14.             t = ar(2, j1): ar(2, j1) = ar(2, sr(2)): ar(2, sr(2)) = t
  15.             t = ar(3, j1): ar(3, j1) = ar(3, sr(3)): ar(3, sr(3)) = t
  16.             t = ar(4, j1): ar(4, j1) = ar(4, sr(4)): ar(4, sr(4)) = t
  17.             [a1].Resize(4, 4) = ar
  18.             If j1 < 3 Then Call dg(h - ar(1, j1 + 1), ",", 2, j1 + 1, 0) Else z = 1: Debug.Print cnt: Exit Sub
  19.         End If
  20.         If s = ",,4,4,4" Then If j1 > 1 Then Call dg(h - ar(1, j1 - 1) - ar(2, j1 - 1), ",,1", 3, j1 - 1, 1) Else Stop
  21.         Exit Sub
  22.     Else
  23.         For j = j1 + t To 4
  24.             cnt = cnt + 1
  25.             Call dg(r - ar(i, j), s & "," & j, i + 1, j1, 0)
  26.         Next
  27.     End If
  28. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2017-2-9 23:11 | 显示全部楼层
Moneky 发表于 2017-2-8 14:50
我的代码列出来是7040,没有排除旋转的情况,7040÷4=1760(与你上面的数据有出入,不确定是我漏掉了一些 ...

按你的思路我也写了个排列凑数的代码,计算速度至少比你快一倍。


排列算4阶幻方.rar

23.57 KB, 下载次数: 38

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-2-9 23:33 | 显示全部楼层
本帖最后由 Moneky 于 2017-2-9 23:37 编辑
香川群子 发表于 2017-2-9 23:11
按你的思路我也写了个排列凑数的代码,计算速度至少比你快一倍。

佩服的你精力,我这代码写了就扔在那里了,对于这种只需要运行一次的代码,你还有心思写各种版本,精力旺盛啊。
我电脑上我的代码9.5s左右,你的是7.2s左右。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 09:14 , Processed in 0.049218 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表