参考Wilmott论坛的this问题,我刚刚写了以下函数:
Public Function KmeansPrice(ByVal priceArray As Range, _
ByVal clustersNumber As Integer) As Double
' Following rows are reproducible only if RExcel has been installed
' on your Excel!
Dim y() As Double
RInterface.StartRServer
RInterface.PutArrayFromVBA "x", priceArray
RInterface.PutArrayFromVBA "n", clustersNumber
RInterface.RRun "x = as.numeric(x)"
RInterface.RRun "cluster = kmeans(x, n)$cluster"
RInterface.RRun "bestBid = rep(NA, n)"
RInterface.RRun "for(i in 1:n)" & _
"{" & _
" assign(paste('group.', i, sep = ''), " & _
" x[cluster == i]);" & _
" bestBid[i] = max(get(paste('group.', i, sep = '')))" & _
"}"
RInterface.RRun "y = min(bestBid) + 0.01"
y = RInterface.GetArrayToVBA("y")
KmeansPrice = y(0, 0)
End Function
当然我之前已经在R
中对其进行了原型设计并且工作正常,然后我猜这个错误的原因是:
Error -2147220501
in Module RExcel.RServer
Error in variable assignment
与RInterface.GetArrayToVBA()
的错误用法有关,涉及从R
到VBA的数组的维度和索引。
是否有人能够使上面的代码工作?一个只有五个或十个元素的数组的工作示例priceArray
和clustersNumber
等于2或3就足够了。
答案 0 :(得分:1)
我不熟悉群集功能,但这会在不中断的情况下返回结果。
我更喜欢在R编辑器中创建我的函数然后获取代码,所以我在R中执行了此操作,然后获取了我的R函数。
kmeansPrice <- function(priceArray,clustersNumber)
{
`[` <- function(...) base::`[`(...,drop=FALSE) #in case we have a 1 dimensional table
x<-priceArray
n<- clustersNumber
x<-matrix(as.numeric(x),nrow=dim(x)[1],ncol=dim(x)[2])
cluster = kmeans(x, n)$cluster
bestBid = rep(NA, n)
for(i in 1:n)
{
assign(paste('group.', i, sep = ''),
x[cluster == i])
bestBid[i] = max(get(paste('group.', i, sep = '')))
}
return(min(bestBid) + 0.01)
}
然后你可以
Public Function KmeansPrice(ByVal priceArray As Range, _
ByVal clustersNumber As Integer) As Double
rinterface.PutArrayFromVBA "priceArray", priceArray.Value 'I think this ".Value" was your problem'
rinterface.PutArrayFromVBA "clustersNumber", clustersNumber
rinterface.RRun "theResult <- kmeansPrice(priceArray,clustersNumber)"
y = rinterface.GetRExpressionValueToVBA("theResult") 'preferred to GetArrayToVBA for single-value results'
KmeansPrice = y
End Function
并使用示例数据运行它:一个评估为
的2x4表 [,1] [,2]
[1,] 5 9
[2,] 6 10
[3,] 7 11
[4,] 8 12
使用3&#34;群集&#34;
Sub runkmeans()
theResult = KmeansPrice(Range("BH2:BI5"), 3)
MsgBox (theResult)
End Sub
,产生6.01