内容详情 您现在的位置是: 首页> PHP
PHP及Excel实现梅花易起卦算法
发布时间:2022-05-21 07:25 已围观:2915
摘要PHP及Excel实现梅花易起卦算法
1.前言
周易学了一段时间了,今天来分享一个针对梅花易起卦的辅助小算法。前提是,读者需要有一定的周易业务知识。
2.六十四卦的介绍
直奔主题,下面是我整理消化总结的一张图:
3.卦象的解释
4.梅花易起卦算法介绍
参考地址:http://www.quanxue.cn/QT_XiaoYa/YiJing/YiJing06.html
5. PHP版梅花易起卦算法实现
$keys = [ [ "坤为地", "地天泰", "地泽临", "地火明夷", "地雷复", "地风升", "地水师", "地山谦" ], [ "天地否", "乾为天", "天泽履", "天火同人", "天雷无妄", "天风姤", "天水讼", "天山遁" ], [ "泽地萃", "泽天夬", "兑为泽", "泽火革", "泽雷随", "泽风中孚", "泽水困", "泽山咸" ], [ "火地晋", "火天大有", "火泽睽", "离为火", "火雷噬嗑", "火风鼎", "火水未济", "火山旅" ], [ "雷地豫", "雷天大壮", "雷泽归妹", "雷火丰", "震为雷", "雷风恒", "雷水解", "雷山小过" ], [ "风地观", "风天小畜", "风泽中孚", "风火家人", "风雷益", "巽为风", "风水涣", "风山渐" ], [ "水地比", "水天需", "水泽节", "水火既济", "水雷屯", "水风井", "坎为水", "水山旅" ], [ "山地剥", "山天大畜", "山泽损", "山火贲", "山雷颐", "山风蛊", "山水蒙", "艮为山" ]]; $binary_keys = [0x0, 0x7, 0x3, 0x5, 0x1, 0x6, 0x2, 0x4]; function validate($value) { return true; } function generateDiagrams($a, $b, $c) { global $keys, $binary_keys; $diagrams = $sDiagrams = $hDiagrams = $bDiagrams = ''; if (validate([$a, $b, $c])) { $a %= 8; $b %= 8; $c = $c % 6 === 0 ? 6 : $c % 6; //本卦 $sDiagrams = $keys[$a][$b]; /** * 互卦 * 上卦 3 4 5 爻 * 下卦 2 3 4 爻 */ $diagrams = $binary_keys[$a] << 3 | $binary_keys[$b]; $upDiagramsKey = (0x1C & $diagrams) >> 2; $downDiagramsKey = ($diagrams & 0xE) >> 1; list($up_key, $down_key) = findKeyFromBinaryKeys($upDiagramsKey, $downDiagramsKey); if ($up_key && $down_key) { $hDiagrams = $keys[$up_key][$down_key]; } //变爻 $diagrams = $diagrams ^ (0x1 << ($c - 1)); $upDiagramsKey = $diagrams >> 3; $downDiagramsKey = $diagrams & 0x7; list($up_key, $down_key) = findKeyFromBinaryKeys($upDiagramsKey, $downDiagramsKey); if ($up_key && $down_key) { $bDiagrams = $keys[$up_key][$down_key]; } } return [$sDiagrams, $hDiagrams, $bDiagrams]; } function findKeyFromBinaryKeys($upKey, $downKey) { global $binary_keys; return [array_search($upKey, $binary_keys), array_search($downKey, $binary_keys)]; } var_dump(generateDiagrams(43, 82, 56));
6. Excel宏实现
Sub 梅花易起卦() Dim keys(8, 8) As String keys(0, 0) = "坤为地" keys(0, 1) = "地天泰" keys(0, 2) = "地泽临" keys(0, 3) = "地火明夷" keys(0, 4) = "地雷复" keys(0, 5) = "地风升" keys(0, 6) = "地水师" keys(0, 7) = "地山谦" keys(1, 0) = "天地否" keys(1, 1) = "乾为天" keys(1, 2) = "天泽履" keys(1, 3) = "天火同人" keys(1, 4) = "天雷无妄" keys(1, 5) = "天风姤" keys(1, 6) = "天水讼" keys(1, 7) = "天山遁" keys(2, 0) = "泽地萃" keys(2, 1) = "泽天夬" keys(2, 2) = "兑为泽" keys(2, 3) = "泽火革" keys(2, 4) = "泽雷随" keys(2, 5) = "泽风中孚" keys(2, 6) = "泽水困" keys(2, 7) = "泽山咸" keys(3, 0) = "火地晋" keys(3, 1) = "火天大有" keys(3, 2) = "火泽睽" keys(3, 3) = "离为火" keys(3, 4) = "火雷噬嗑" keys(3, 5) = "火风鼎" keys(3, 6) = "火水未济" keys(3, 7) = "火山旅" keys(4, 0) = "雷地豫" keys(4, 1) = "雷天大壮" keys(4, 2) = "雷泽归妹" keys(4, 3) = "雷火丰" keys(4, 4) = "震为雷" keys(4, 5) = "雷风恒" keys(4, 6) = "雷水解" keys(4, 7) = "雷山小过" keys(5, 0) = "风地观" keys(5, 1) = "风天小畜" keys(5, 2) = "风泽中孚" keys(5, 3) = "风火家人" keys(5, 4) = "风雷益" keys(5, 5) = "巽为风" keys(5, 6) = "风水涣" keys(5, 7) = "风山渐" keys(6, 0) = "水地比" keys(6, 1) = "水天需" keys(6, 2) = "水泽节" keys(6, 3) = "水火既济" keys(6, 4) = "水雷屯" keys(6, 5) = "水风井" keys(6, 6) = "坎为水" keys(6, 7) = "水山旅" keys(7, 0) = "山地剥" keys(7, 1) = "山天大畜" keys(7, 2) = "山泽损" keys(7, 3) = "山火贲" keys(7, 4) = "山雷颐" keys(7, 5) = "山风蛊" keys(7, 6) = "山水蒙" keys(7, 7) = "艮为山" Dim binary_keys(8) As Integer binary_keys(0) = &H0 binary_keys(1) = &H7 binary_keys(2) = &H3 binary_keys(3) = &H5 binary_keys(4) = &H1 binary_keys(5) = &H6 binary_keys(6) = &H2 binary_keys(7) = &H4 A = Sheet1.Range("H16").Value Mod 8 B = Sheet1.Range("I16").Value Mod 8 C = Sheet1.Range("J16").Value Mod 6 If (Not (CBool(C Xor 0))) Then C = 6 End If '本卦 Sheet1.Range("H21").Value = keys(A, B)'互卦'下卦 2 3 4 爻'上卦 3 4 5 爻 diagrams = binary_keys(A) * 2 ^ 3 Or binary_keys(B) upDiagramsKey = (&H1C And diagrams) / 2 ^ 2 downDiagramsKey = (diagrams And &HE) / 2 ^ 1 For i = 0 To UBound(binary_keys) - 1If (Not (CBool(binary_keys(i) Xor upDiagramsKey))) Then up_key = i End IfIf (Not (CBool(binary_keys(i) Xor downDiagramsKey))) Then down_key = i End IfNext i Sheet1.Range("I21").Value = keys(up_key, down_key) '变爻 diagrams = diagrams Xor (&H1 * 2 ^ (C - 1)) upDiagramsKey = diagrams / 2 ^ 3 downDiagramsKey = diagrams And &H7 For i = 0 To UBound(binary_keys) - 1If (Not (CBool(binary_keys(i) Xor upDiagramsKey))) Then up_key = i End IfIf (Not (CBool(binary_keys(i) Xor downDiagramsKey))) Then down_key = i End IfNext i Sheet1.Range("J21").Value = keys(up_key, down_key) End Sub
声明:本文内容摘自网络,版权归原作者所有。如有侵权,请联系处理,谢谢~
转发:淙淙溪流--https://www.cnblogs.com/pitmanhuang/p/16186983.html
赞一个 (388)
上一篇: PHP原生图片验证码转base64格式