精 彩 论 坛已经更名为百强频道,迁新地址www.bqpd.cn

亲爱的朋友,首先为给您带来的不便深表歉意,现因发展的需要,精彩论坛迁到新的地址http://www.bqpd.cn,还望您一如既往地支持精彩论坛,谢谢
精 彩 论 坛已经更名为百强频道,迁新地址www.bqpd.cn

论坛因发展的需要现已经迁址www.bqpd.cn,等待您的到来。谢谢


    奇 偶 分 析

    分享
    avatar
    一品明灯
    Admin

    帖子数 : 292
    积分 : 720
    威望 : 4
    注册日期 : 10-03-02
    年龄 : 8

    普通 奇 偶 分 析

    帖子 由 一品明灯 于 2010-03-11, 14:37

    ==========================================================
    ' 奇 偶 分 析 (3D奇偶形态二进制转十进制)
    '==========================================================
    CpParam.Add "偏差期数", 5,"{1}{2}{3}{4}{5}{6}{7}{8}{9}{10}"

    Function Main
    '===============申明或定义变量=============
    CpRowCount = CpData.RowCount '开奖期数
    CpColCount = CpData.ColCount '开奖号码个数
    CpMaxCode = CpData.MaxCode '最大号码
    CpMinCode = CpData.MinCode '最小号码
    CpCodeCount = CpData.CodeCount '号码数量
    Pub_QS = CInt(CpParam.Value("偏差期数"))

    '=================建表=================
    CpAna.AddField "期号",8
    CpAna.AddField "开奖号码",CpColCount*3
    CpAna.AddField "奇号个数",4
    CpAna.AddField "偶号个数",4
    CpAna.AddField "奇偶比",4
    CpAna.AddField "奇数和",6
    CpAna.AddField "偶数和",6
    CpAna.AddField "奇偶形态",10
    CpAna.AddField "奇偶形态(十)",14
    For i = 1 to CpColCount
    CpAna.AddField "基"&i,4
    Next
    CpAna.AddField "偏差",4

    CpAna.RowCount = CpData.RowCount
    CpAna.CreateTable()

    '==============算法主体============================
    PC = 0'偏差
    For row = 0 to CpRowCount - 1
    OuCount = 0 '偶号个数
    JiCount = 0 '奇号个数
    OuSum = 0 '偶数和
    JiSum = 0 '奇数和
    JiOuXT = ""

    For col = 0 to CpColCount - 1
    Code = CpData.Code(row,col)
    If Code mod 2 = 0 then
    OuCount = OuCount + 1
    OuSum = OuSum + Code
    JiOuXT = JiOuXT & "0"
    CpAna.Cell(row, "基"&(col+1)) = "0偶"
    CpAna.BkColor(row, "基"&(col+1)) = CpColor.Blue
    Else
    JiCount = JiCount + 1
    JiSum = JiSum + Code
    JiOuXT = JiOuXT & "1"
    CpAna.Cell(row, "基"&(col+1)) = "1奇"
    CpAna.BkColor(row, "基"&(col+1)) = CpColor.Red
    End If
    Next


    CpAna.Cell(row, "期号") = CpData.Seq(row)
    CpAna.Cell(row, "开奖号码") = CpData.CodeStr(row)
    CpAna.Cell( row, "偶号个数") = OuCount
    CpAna.Cell(row, "奇号个数") = JiCount
    CpAna.Cell(row, "偶数和") = OuSum
    CpAna.Cell(row, "奇数和") = JiSum
    CpAna.Cell(row, "奇偶形态") = JiOuXT
    CpAna.Cell(row, "奇偶形态(十)") = 4*(JiOuXT\100)+2*(((JiOuXT\10) mod 10))+(JiOuXT mod 10)
    CpAna.Cell(row, "奇偶比") = JiCount & ":" & OuCount

    '求偏差
    PC = PC + JiCount - OuCount
    PreRow = row - Pub_QS
    If (PreRow >= 0) Then
    PC = PC - CpAna.Cell(PreRow,"奇号个数") + CpAna.Cell(PreRow,"偶号个数")
    End If
    If row >= Pub_QS-1 Then
    CpAna.Cell(row, "偏差") = PC
    End If
    Next
    End Function


    _________________
    一流的条件 精彩的论坛
    avatar
    一品明灯
    Admin

    帖子数 : 292
    积分 : 720
    威望 : 4
    注册日期 : 10-03-02
    年龄 : 8

    普通 质 数 分 析 本程序由后羿之箭升级

    帖子 由 一品明灯 于 2010-03-11, 14:38

    ==================================================================
    ' 质 数 分 析 本程序由后羿之箭升级 改编:By tkltkl7676
    '==================================================================
    CpParam.Add "比较期数", 3'用户设置参数

    Function Main
    '===============申明或定义变量=============
    CpRowCount = CpData.RowCount
    CpColCount = CpData.ColCount
    CpMaxCode = CpData.MaxCode
    CpMinCode = CpData.MinCode

    Pub_QS = CInt(CpParam.Value("比较期数"))
    ReDim BJArr(Pub_QS,CpColCount)

    '=================建表=================
    CpAna.AddField "期号",8
    CpAna.AddField "开奖号码",CpColCount*3
    CpAna.AddField "质数个数",8
    CpAna.AddField "质数列表",16
    CpAna.AddField "质合形态",CpColCount*2+2
    CpAna.AddField "质数和",6
    CpAna.AddField "质和均值",8
    For i=1 to CpColCount
    CpAna.AddField "基" & i,4
    Next

    For i=1 to Pub_QS
    CpAna.AddField "与前第" & i & "同" ,9
    Next



    CpAna.RowCount = CpRowCount
    CpAna.CreateTable()


    '==============算法主体============================
    For row = 0 to CpRowCount - 1

    '解决排列玩法的号码显示问题
    KJHM = ""
    If CpMinCode = 0 AND CpMaxCode = 9 Then
    For i = 0 to CpColCount - 1
    KJHM = KJHM & CpData.Code(row, i) & " "
    Next
    Else
    KJHM = CpData.CodeStr(row)
    End If
    ZSJZ= 0 '质数均值
    ZSSum = 0 '质数和
    ZSGS = 0 '质数个数
    ZSLB = "" '质数列表
    ZHXT = ""

    For col = 0 to CpColCount - 1
    OpenNum = CpData.Code(row, col)
    If IsZS(OpenNum) then

    ZSGS = ZSGS + 1
    ZSSum = ZSSum+OpenNum
    ZSJZ = ZSSum\ZSGS
    ZSLB = ZSLB & OpenNum & " "

    ZHXT = ZHXT & 1
    CpAna.Cell(row, "基" & col+1) = 1
    Else
    ZHXT = ZHXT & 0
    CpAna.Cell(row, "基" & col+1) = 0
    End If
    Next

    For i=0 to Pub_QS
    For j=0 to CpColCount - 1
    OpenNum = CpData.Code(row-i, j)
    If IsZS(OpenNum) then
    BJArr(i,j) = 1
    Else
    BJArr(i,j) = 0
    End If
    Next
    Next

    If row > Pub_QS Then
    XTsum=0
    For i=1 to Pub_QS
    For j=0 to CpColCount - 1
    If BJArr(0,j)=BJArr(i,j) then
    XTsum=XTsum+1
    End If
    Next
    CpAna.Cell(row, "与前第" & i & "同") = XTsum
    XTsum=0
    Next
    End If

    CpAna.Cell(row, "期号") = CpData.Seq(row)
    CpAna.Cell(row, "开奖号码") = KJHM

    CpAna.Cell(row, "质合形态") = ZHXT
    CpAna.Cell(row, "质数个数") = ZSGS
    CpAna.Cell(row, "质数列表") = ZSLB
    CpAna.Cell(row, "质数和") =ZSSum
    CpAna.Cell(row, "质和均值") =ZSJZ
    Next
    End Function

    '==============辅助函数============================
    '一些质数
    ZS = Array(2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71)
    '是否为质数
    Function IsZS(Num)
    b = False
    For i = 0 to 19
    If ZS(i) = Num Then
    b = True
    Exit For
    End If
    Next
    IsZS = b
    End Function


    _________________
    一流的条件 精彩的论坛

      目前的日期/时间是2018-04-25, 02:08