[原创] 间 距 相 似 统 计
'==========================================================
' 间 距 相 似 统 计
' by-小混(chinamen668)
'==========================================================
CpParam.Add "显示","相似下期形态","{相似上期形态}{相似下期形态}"
CpParam.Add "间距", 10'用户自行输入格式"01 01 01"
CpParam.Add "间隔", 0'用户设置参数
Function Main
'===============申明或定义变量=============
CpRowCount = CpData.RowCount '开奖期数
CpColCount = CpData.ColCount '开奖号码个数
CpMaxCode = CpData.MaxCode '最大号码
CpMinCode = CpData.MinCode '最小号码
CpCodeCount = CpData.CodeCount '号码数量
ub_JJXT = CpParam.Value("间距")
ub_JGQS = CINT(CpParam.Value("间隔"))+1
ub_FirstCodeIndex = 1 '第一个号码的位置
ub_SecondCodeIndex = CpColCount '第二个号码的位置
'=================建表=================
CpAna.AddField "期号",8
CpAna.AddField "开奖号码",CpColCount*3
CpAna.AddField "间距形态",CpColCount*2.5
CpAna.AddField "最小",4
CpAna.AddField "最大",4
CpAna.AddField "平均",4
CpAna.AddField "全距",4
CpAna.AddField "相似期号",8
for i=CpMinCode to CpMaxCode
CpAna.AddField i,2
next
CpAna.AddField "相似间距形态",CpColCount*2.5
CpAna.RowCount = CpData.RowCount+1
CpAna.CreateTable
'==============算法主体============================
ReDim HamaFlagsq(CpMaxCode)
ReDim HamaFlag(CpMaxCode)
ReDim HamaFlagxq(CpMaxCode)
ReDim xt(CpRowCount )
d1=2
if CpParam.Value("显示")="相似下期形态" then
a=CpRowCount - 1
b=0
c=-1
else
a=0
b=CpRowCount - 1
c=1
end if
For row = a to b step c
JJXT = "" '间距形态
MaxJJ = -99999 '最大间距
MinJJ = 99999 '最小间距
MaxCode = -9999 '最大号码
MinCode = 9999 '最小号码
MaxCodeWZ = -9999 '两位置间最大号码
MinCodeWZ = 9999 '两位置间最小号码
JJSum = 0 '间距和
CpAna.Cell( row, "期号") = CpData.Seq(row)
CpAna.Cell( row, "开奖号码") = CpData.CodeStr(row)
For i = 0 To CpMaxCode - 1
HamaFlagsq(i) = 0
HamaFlag(i) = 0
HamaFlagxq(i) = 0
Next
For col = 0 to CpColCount - 1
NextCol = col + 1
Code = CpData.Code(row,col)
If NextCol < CpColCount then
JJ0 = abs(Code - CpData.Code(row,NextCol))
JJSum = JJSum + JJ0
jj=jj0
if JJ<10 then JJ="0"&JJ
JJXT = JJXT & JJ & " "
'找最大最小间距
If JJ0 > MaxJJ then MaxJJ = JJ0
If JJ0 < MinJJ then MinJJ = JJ0
End If
'找最大最小号码
If Code > MaxCode then MaxCode = Code
If Code < MinCode then MinCode = Code
Next
xt(row)=JJXT
CpAna.Cell( row, "间距形态") = JJXT
CpAna.Cell( row, "最小") = MinJJ
CpAna.Cell( row, "最大") = MaxJJ
CpAna.Cell( row, "平均") = JJSum \ (CpColCount-1)
CpAna.Cell( row, "全距") = MaxCode - MinCode
If InStr(jjxt,Pub_JJXT)>0 then
xtqs=xtqs+1
For col1 = 0 To CpColCount - 1
if row-Pub_JGQS>=0 then
sq = CpData.Code(row-Pub_JGQS, col1)
If sq - CpMinCode >= 0 And CpMaxCode - sq >= 0 Then
HamaFlagsq(sq - 1) = 1
End If
End If
i = CpData.Code(row, col1)
If i - CpMinCode >= 0 And CpMaxCode - i >= 0 Then
HamaFlag(i - 1) = 1
End If
if row+Pub_JGQS< CpRowCount then
xq = CpData.Code(row+Pub_JGQS, col1)
If xq - CpMinCode >= 0 And CpMaxCode - xq >= 0 Then
HamaFlagxq(xq - 1) = 1
End If
End If
Next
For i = 0 To CpMaxCode - 1
if d1>CpRowCount-1 then exit for
If HamaFlagsq(i) = 1 Then
CpAna.Cell( CpRowCount-d1-1, "相似期号") = CpData.Seq(row-Pub_JGQS)
CpAna.Cell( CpRowCount-d1-1, "相似间距形态") = XT(row-Pub_JGQS)
If i < 9 Then
CpAna.Cell(CpRowCount-d1-1, i + 1&"") = "0" & i + 1
Else
CpAna.Cell(CpRowCount-d1-1, i + 1&"") = i + 1
End If
End If
If HamaFlag(i) = 1 Then
CpAna.Cell( CpRowCount-d1, "相似期号") = CpData.Seq(row)
CpAna.Cell( CpRowCount-d1, "相似间距形态") = XT(row)
If i < 9 Then
CpAna.Cell(CpRowCount-d1, i + 1&"") = "0" & i + 1
Else
CpAna.Cell(CpRowCount-d1, i + 1&"") = i + 1
End If
CpAna.Color(CpRowCount-d1, i + 1&"") =255
End If
If HamaFlagxq(i) = 1 Then
CpAna.Cell( CpRowCount-d1+1, "相似期号") = CpData.Seq(row+Pub_JGQS)
CpAna.Cell( CpRowCount-d1+1, "相似间距形态") = XT(row+Pub_JGQS)
If i < 9 Then
CpAna.Cell(CpRowCount-d1+1, i + 1&"") = "0" & i + 1
Else
CpAna.Cell(CpRowCount-d1+1, i + 1&"") = i + 1
End If
CpAna.Color(CpRowCount-d1+1, i + 1&"") =CpColor.blue
End If
Next
CpAna.Color( row, "间距形态") = CpColor.red
CpAna.Color( row, "开奖号码") = CpColor.red
d1=d1+4
End if
Next
CpAna.Cell(CpRowCount,"相似间距形态") = Pub_JJXT
CpAna.Color(CpRowCount,"相似间距形态") = CpColor.red
CpAna.Cell(CpRowCount,"相似期号") = "共"&xtqs&"期"
CpAna.Color(CpRowCount,"相似期号") = CpColor.red
End Function
'------------说明---------
'在各种彩票中大家经常查找某种间距格式下期出球情况
'本分析就是按照自己意愿输入间距状态,查找历史出球分布
'在“间距”内输入格式"02 02 03",再按这种间距,历史中包含的显示出走势图
'在“间隔”里输入间隔“1”就是找到“间距”相似的,间隔“1”期的出球分布
'即“2006010”期间距形态相似后,上下间隔1期,“2006008”“ 2006012”
'因为要完整显示"相似间距形态",总有上下期不能一起显示,增加一个"显示"选择阀,
'当然由于查找顺序的变化,显示出来的相似期号排序也跟着变化.
'需要注意一点,当“间距”找到历史数据太多期相似的时候,为避免出错,
'设计参数中设置了d1大于建表行数就取消显示,所以自己注意输入“间距”个数和分析范围
'或者选择显示阀门改变查找顺序也是一种办法.
'或者要是你要让走势图紧凑不隔行显示,更改 "d1=d1+4"为 "d1=d1+3"
'==========================================================
' 间 距 相 似 统 计
' by-小混(chinamen668)
'==========================================================
CpParam.Add "显示","相似下期形态","{相似上期形态}{相似下期形态}"
CpParam.Add "间距", 10'用户自行输入格式"01 01 01"
CpParam.Add "间隔", 0'用户设置参数
Function Main
'===============申明或定义变量=============
CpRowCount = CpData.RowCount '开奖期数
CpColCount = CpData.ColCount '开奖号码个数
CpMaxCode = CpData.MaxCode '最大号码
CpMinCode = CpData.MinCode '最小号码
CpCodeCount = CpData.CodeCount '号码数量
ub_JJXT = CpParam.Value("间距")
ub_JGQS = CINT(CpParam.Value("间隔"))+1
ub_FirstCodeIndex = 1 '第一个号码的位置
ub_SecondCodeIndex = CpColCount '第二个号码的位置
'=================建表=================
CpAna.AddField "期号",8
CpAna.AddField "开奖号码",CpColCount*3
CpAna.AddField "间距形态",CpColCount*2.5
CpAna.AddField "最小",4
CpAna.AddField "最大",4
CpAna.AddField "平均",4
CpAna.AddField "全距",4
CpAna.AddField "相似期号",8
for i=CpMinCode to CpMaxCode
CpAna.AddField i,2
next
CpAna.AddField "相似间距形态",CpColCount*2.5
CpAna.RowCount = CpData.RowCount+1
CpAna.CreateTable
'==============算法主体============================
ReDim HamaFlagsq(CpMaxCode)
ReDim HamaFlag(CpMaxCode)
ReDim HamaFlagxq(CpMaxCode)
ReDim xt(CpRowCount )
d1=2
if CpParam.Value("显示")="相似下期形态" then
a=CpRowCount - 1
b=0
c=-1
else
a=0
b=CpRowCount - 1
c=1
end if
For row = a to b step c
JJXT = "" '间距形态
MaxJJ = -99999 '最大间距
MinJJ = 99999 '最小间距
MaxCode = -9999 '最大号码
MinCode = 9999 '最小号码
MaxCodeWZ = -9999 '两位置间最大号码
MinCodeWZ = 9999 '两位置间最小号码
JJSum = 0 '间距和
CpAna.Cell( row, "期号") = CpData.Seq(row)
CpAna.Cell( row, "开奖号码") = CpData.CodeStr(row)
For i = 0 To CpMaxCode - 1
HamaFlagsq(i) = 0
HamaFlag(i) = 0
HamaFlagxq(i) = 0
Next
For col = 0 to CpColCount - 1
NextCol = col + 1
Code = CpData.Code(row,col)
If NextCol < CpColCount then
JJ0 = abs(Code - CpData.Code(row,NextCol))
JJSum = JJSum + JJ0
jj=jj0
if JJ<10 then JJ="0"&JJ
JJXT = JJXT & JJ & " "
'找最大最小间距
If JJ0 > MaxJJ then MaxJJ = JJ0
If JJ0 < MinJJ then MinJJ = JJ0
End If
'找最大最小号码
If Code > MaxCode then MaxCode = Code
If Code < MinCode then MinCode = Code
Next
xt(row)=JJXT
CpAna.Cell( row, "间距形态") = JJXT
CpAna.Cell( row, "最小") = MinJJ
CpAna.Cell( row, "最大") = MaxJJ
CpAna.Cell( row, "平均") = JJSum \ (CpColCount-1)
CpAna.Cell( row, "全距") = MaxCode - MinCode
If InStr(jjxt,Pub_JJXT)>0 then
xtqs=xtqs+1
For col1 = 0 To CpColCount - 1
if row-Pub_JGQS>=0 then
sq = CpData.Code(row-Pub_JGQS, col1)
If sq - CpMinCode >= 0 And CpMaxCode - sq >= 0 Then
HamaFlagsq(sq - 1) = 1
End If
End If
i = CpData.Code(row, col1)
If i - CpMinCode >= 0 And CpMaxCode - i >= 0 Then
HamaFlag(i - 1) = 1
End If
if row+Pub_JGQS< CpRowCount then
xq = CpData.Code(row+Pub_JGQS, col1)
If xq - CpMinCode >= 0 And CpMaxCode - xq >= 0 Then
HamaFlagxq(xq - 1) = 1
End If
End If
Next
For i = 0 To CpMaxCode - 1
if d1>CpRowCount-1 then exit for
If HamaFlagsq(i) = 1 Then
CpAna.Cell( CpRowCount-d1-1, "相似期号") = CpData.Seq(row-Pub_JGQS)
CpAna.Cell( CpRowCount-d1-1, "相似间距形态") = XT(row-Pub_JGQS)
If i < 9 Then
CpAna.Cell(CpRowCount-d1-1, i + 1&"") = "0" & i + 1
Else
CpAna.Cell(CpRowCount-d1-1, i + 1&"") = i + 1
End If
End If
If HamaFlag(i) = 1 Then
CpAna.Cell( CpRowCount-d1, "相似期号") = CpData.Seq(row)
CpAna.Cell( CpRowCount-d1, "相似间距形态") = XT(row)
If i < 9 Then
CpAna.Cell(CpRowCount-d1, i + 1&"") = "0" & i + 1
Else
CpAna.Cell(CpRowCount-d1, i + 1&"") = i + 1
End If
CpAna.Color(CpRowCount-d1, i + 1&"") =255
End If
If HamaFlagxq(i) = 1 Then
CpAna.Cell( CpRowCount-d1+1, "相似期号") = CpData.Seq(row+Pub_JGQS)
CpAna.Cell( CpRowCount-d1+1, "相似间距形态") = XT(row+Pub_JGQS)
If i < 9 Then
CpAna.Cell(CpRowCount-d1+1, i + 1&"") = "0" & i + 1
Else
CpAna.Cell(CpRowCount-d1+1, i + 1&"") = i + 1
End If
CpAna.Color(CpRowCount-d1+1, i + 1&"") =CpColor.blue
End If
Next
CpAna.Color( row, "间距形态") = CpColor.red
CpAna.Color( row, "开奖号码") = CpColor.red
d1=d1+4
End if
Next
CpAna.Cell(CpRowCount,"相似间距形态") = Pub_JJXT
CpAna.Color(CpRowCount,"相似间距形态") = CpColor.red
CpAna.Cell(CpRowCount,"相似期号") = "共"&xtqs&"期"
CpAna.Color(CpRowCount,"相似期号") = CpColor.red
End Function
'------------说明---------
'在各种彩票中大家经常查找某种间距格式下期出球情况
'本分析就是按照自己意愿输入间距状态,查找历史出球分布
'在“间距”内输入格式"02 02 03",再按这种间距,历史中包含的显示出走势图
'在“间隔”里输入间隔“1”就是找到“间距”相似的,间隔“1”期的出球分布
'即“2006010”期间距形态相似后,上下间隔1期,“2006008”“ 2006012”
'因为要完整显示"相似间距形态",总有上下期不能一起显示,增加一个"显示"选择阀,
'当然由于查找顺序的变化,显示出来的相似期号排序也跟着变化.
'需要注意一点,当“间距”找到历史数据太多期相似的时候,为避免出错,
'设计参数中设置了d1大于建表行数就取消显示,所以自己注意输入“间距”个数和分析范围
'或者选择显示阀门改变查找顺序也是一种办法.
'或者要是你要让走势图紧凑不隔行显示,更改 "d1=d1+4"为 "d1=d1+3"