精 彩 论 坛已经更名为百强频道,迁新地址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:39

    ==================================================================
    ' 质 数 分 析 本程序由后羿之箭升级 改编: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:10