R软件读入外部程序问题

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

bw.fun <- function (x, nb = 1000,lower=0,upper=0){
  n <- length(x)
  hmax <- 1.144 * sqrt(var(x)) * n^(-1/5)
  if(upper==0)upper <- hmax;  
  if(lower==0)lower <- 0.1*hmax
  fucv <- function(h, x, n, d) .C("band_ucv_bin", as.integer(n),
        as.integer(length(x)), as.double(d), x, as.double(h),
        u = double(1), PACKAGE = "base")$u
  if (!is.numeric(x) || !length(x)) stop("invalid x")
  storage.mode(x) <- "double"
  Z <- .C("band_den_bin", as.integer(n), as.integer(nb), d = double(1),
        x, cnt = integer(nb), PACKAGE = "base")
  d <- Z$d
  cnt <- as.integer(Z$cnt)
  h <- optimize(fucv, c(lower, upper), tol = 0.1 * lower, x = cnt,
        n = n, d = d)$minimum
  if (h < 1.1 * lower | h > upper - 0.1 * lower)
      warning("minimum occurred at one end of the range")
    h.vec <- seq(lower, upper, length=200)
    u.vec <- rep(NA, 200)
    for(i in 1:200)  u.vec <- fucv(h.vec, x=cnt, n, d)
    list(h.optimal=h, bandwidths=h.vec, risk=u.vec)
    }
x=c(1,2,3,4,5,6,7,8,9)
library(MASS)
temp  <- bw.fun(x)
错误在于：程序包"base"里"band_den_bin"不适用于.C()

请教各位老师这个问题怎么解决啊。

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：r软件 Fun function invalid double 程序 软件

这段function修改一下，你看这么跑有问题没
  
bw.fun <- function (x, nb = 1000, lower = 0.1 * hmax, upper = hmax) {

  fucv <- function(h, x, n, d) .C("band_ucv_bin", as.integer(n),
        as.integer(length(x)), as.double(d), x, as.double(h),
        u = double(1), PACKAGE = "base")$u

  if (!is.numeric(x) || !length(x))
        stop("invalid x")

  n <- length(x)
  
  hmax <- 1.144 * sqrt(var(x)) * n^(-1/5)
  
  storage.mode(x) <- "double"

  Z <- .C("band_den_bin", as.integer(n), as.integer(nb), d = double(1),
        x, cnt = integer(nb), PACKAGE = "base")
  
  d <- Z$d
  
  cnt <- as.integer(Z$cnt)
  
  h <- optimize(fucv, c(lower, upper), tol = 0.1 * lower, x = cnt,
        n = n, d = d)$minimum

  if (h < 1.1 * lower | h > upper - 0.1 * lower)
      warning("minimum occurred at one end of the range")

    h.vec <- seq(lower, upper, length=200)
    u.vec <- rep(NA, 200)
    for(i in 1:200)  u.vec <- fucv(h.vec, x=cnt, n, d)

   list(h.optimal=h, bandwidths=h.vec, risk=u.vec)
}

DM小菜鸟 发表于 2015-2-16 12:21
这段function修改一下，你看这么跑有问题没
  
bw.fun

谢谢，非常谢谢你的帮助.