请选择 进入手机版 | 继续访问电脑版
楼主: Intelligencey
1205 0

[问答] R语言代码报错 [推广有奖]

  • 4关注
  • 1粉丝

博士生

44%

还不是VIP/贵宾

-

威望
0
论坛币
2392 个
通用积分
34.0508
学术水平
0 点
热心指数
5 点
信用等级
1 点
经验
12000 点
帖子
177
精华
0
在线时间
274 小时
注册时间
2016-8-6
最后登录
2024-4-12

+2 论坛币
k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群
赵安豆老师微信:zhaoandou666

经管之家联合CDA

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

感谢您参与论坛问题回答

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

+2 论坛币
car_DF<-read.csv("E:/stock/Car_DF.csv",header=T,stringsAsFactors = FALSE)
car_DF.Date<-as.Date(car_DF$X,format = "%Y-%m-%d")
library(zoo)
library(xts)

car_DF.zoo<-zoo(car_DF$X600006.SS.Close,car_DF.Date)
car_DF.xts<-as.xts(car_DF.zoo)
plot(car_DF.xts)

#wcar_DF<-window(car_DF.xts,start=as.Date("2015-01-01"),end="2016-12-15")
wcar_DF<-window(car_DF.xts,start=as.Date("2014-10-01"))
plot(wcar_DF)
Hu<-RoverS(DF_Vec)
最后这部代码报错Error in lsfit(xvar, yvar) : NA/NaN/Inf in 'y'
下面是lsfit的源代码
function (x, y, wt = NULL, intercept = TRUE, tolerance = 1e-07,
    yname = NULL)
{
    x <- as.matrix(x)
    y <- as.matrix(y)
    xnames <- colnames(x)
    if (is.null(xnames)) {
        if (ncol(x) == 1L)
            xnames <- "X"
        else xnames <- paste0("X", 1L:ncol(x))
    }
    if (intercept) {
        x <- cbind(1, x)
        xnames <- c("Intercept", xnames)
    }
    if (is.null(yname) && ncol(y) > 1)
        yname <- paste0("Y", 1L:ncol(y))
    good <- complete.cases(x, y, wt)
    dimy <- dim(as.matrix(y))
    if (any(!good)) {
        warning(sprintf(ngettext(sum(!good), "%d missing value deleted",
            "%d missing values deleted"), sum(!good)), domain = NA)
        x <- as.matrix(x)[good, , drop = FALSE]
        y <- as.matrix(y)[good, , drop = FALSE]
        wt <- wt[good]
    }
    nrx <- NROW(x)
    ncx <- NCOL(x)
    nry <- NROW(y)
    ncy <- NCOL(y)
    nwts <- length(wt)
    if (nry != nrx)
        stop(sprintf(paste0(ngettext(nrx, "'X' matrix has %d case (row)",
            "'X' matrix has %d cases (rows)"), ", ", ngettext(nry,
            "'Y' has %d case (row)", "'Y' has %d cases (rows)")),
            nrx, nry), domain = NA)
    if (nry < ncx)
        stop(sprintf(paste0(ngettext(nry, "only %d case", "only %d cases"),
            ", ", ngettext(ncx, "but %d variable", "but %d variables")),
            nry, ncx), domain = NA)
    if (!is.null(wt)) {
        if (any(wt < 0))
            stop("negative weights not allowed")
        if (nwts != nry)
            stop(gettextf("number of weights = %d should equal %d (number of responses)",
                nwts, nry), domain = NA)
        wtmult <- sqrt(wt)
        if (any(wt == 0)) {
            xzero <- as.matrix(x)[wt == 0, ]
            yzero <- as.matrix(y)[wt == 0, ]
        }
        x <- x * wtmult
        y <- y * wtmult
        invmult <- 1/ifelse(wt == 0, 1, wtmult)
    }
    z <- .Call(C_Cdqrls, x, y, tolerance, FALSE)
    resids <- array(NA, dim = dimy)
    dim(z$residuals) <- c(nry, ncy)
    if (!is.null(wt)) {
        if (any(wt == 0)) {
            if (ncx == 1L)
                fitted.zeros <- xzero * z$coefficients
            else fitted.zeros <- xzero %*% z$coefficients
            z$residuals[wt == 0, ] <- yzero - fitted.zeros
        }
        z$residuals <- z$residuals * invmult
    }
    resids[good, ] <- z$residuals
    if (dimy[2L] == 1 && is.null(yname)) {
        resids <- drop(resids)
        names(z$coefficients) <- xnames
    }
    else {
        colnames(resids) <- yname
        colnames(z$effects) <- yname
        dim(z$coefficients) <- c(ncx, ncy)
        dimnames(z$coefficients) <- list(xnames, yname)
    }
    z$qr <- as.matrix(z$qr)
    colnames(z$qr) <- xnames
    output <- list(coefficients = z$coefficients, residuals = resids)
    if (z$rank != ncx) {
        xnames <- xnames[z$pivot]
        dimnames(z$qr) <- list(NULL, xnames)
        warning("'X' matrix was collinear")
    }
    if (!is.null(wt)) {
        weights <- rep.int(NA, dimy[1L])
        weights[good] <- wt
        output <- c(output, list(wt = weights))
    }
    rqr <- list(qt = drop(z$effects), qr = z$qr, qraux = z$qraux,
        rank = z$rank, pivot = z$pivot, tol = z$tol)
    oldClass(rqr) <- "qr"
    output <- c(output, list(intercept = intercept, qr = rqr))
    return(output)
}
大佬给看看,这是不是个BUG啊

二维码

扫码加我 拉你入群

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

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

关键词:R语言 CAR

您需要登录后才可以回帖 登录 | 我要注册

本版微信群
加好友,备注cda
拉您进交流群

京ICP备16021002-2号 京B2-20170662号 京公网安备 11010802022788号 论坛法律顾问:王进律师 知识产权保护声明   免责及隐私声明

GMT+8, 2024-4-19 08:13