PHP及Excel实现梅花易起卦算法

1.前言

周易学了一段时间了,今天来分享一个针对梅花易起卦的辅助小算法。前提是,读者需要有一定的周易业务知识。

2.六十四卦的介绍

直奔主题,下面是我整理消化总结的一张图:

3.卦象的解释

4.梅花易起卦算法介绍

参考地址:http://www.quanxue.cn/QT_XiaoYa/YiJing/YiJing06.html

5.PHP版梅花易起卦算法实现

<?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) - 1
If (Not (CBool(binary_keys(i) Xor upDiagramsKey))) Then
up_key = i
End If
If (Not (CBool(binary_keys(i) Xor downDiagramsKey))) Then
down_key = i
End If
Next 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) - 1
If (Not (CBool(binary_keys(i) Xor upDiagramsKey))) Then
up_key = i
End If
If (Not (CBool(binary_keys(i) Xor downDiagramsKey))) Then
down_key = i
End If
Next i

Sheet1.Range("J21").Value = keys(up_key, down_key)

End Sub

7.参考

网络资料

http://www.quanxue.cn
如无特殊说明,文章均为本站原创,转载请注明出处。如发现有什么不对的地方,希望得到您的指点。

发表评论

电子邮件地址不会被公开。 必填项已用*标注