欢迎光临外链建设网站快速建站提升流量与权重!

外链建设

外链建设网站,帮助您快速打造排名!

六种方法查看R函数源代码,为啥第三种最惹人喜欢?

作者:jcmp      发布时间:2021-04-26      浏览量:0
所谓:操千曲而后晓声,观千剑而后识器。当

所谓:操千曲而后晓声,观千剑而后识器。

当然,在开始的开始,你需要知道R函数是怎样的一个结构。也就是说你至少要有一点R的基础,最少吧,你需要一颗上劲的心。本文的末尾给出了R函数的文章,基本上看看就会了。我们就不从最基本的什么是函数这种问题开始了。

#install.packages("PerformanceAnalytics") 没有安装的安装一下。> library(PerformanceAnalytics)> chart.Correlationfunction (R, histogram = TRUE, method = c("pearson", "kendall", "spearman"), ...) { x = checkData(R, method = "matrix") if (missing(method)) method = method[1] panel.cor <- function(x, y, digits = 2, prefix = "", use = "pairwise.complete.obs", method = "pearson", cex.cor, ...) { usr <- par("usr") on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) r <- cor(x, y, use = use, method = method) txt <- format(c(r, 0.123456789), digits = digits)[1] txt <- paste(prefix, txt, sep = "") if (missing(cex.cor)) cex <- 0.8/strwidth(txt) test <- cor.test(as.numeric(x), as.numeric(y), method = method) Signif <- symnum(test$p.value, corr = FALSE, na = FALSE, cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) text(0.5, 0.5, txt, cex = cex * (abs(r) + 0.3)/1.3) text(0.8, 0.8, Signif, cex = cex, col = 2) } f <- function(t) { dnorm(t, mean = mean(x), sd = sd.xts(x)) } dotargs <- list(...) dotargs$method <- NULL rm(method) hist.panel = function(x, ... = NULL) { par(new = TRUE) hist(x, col = "light gray", probability = TRUE, axes = FALSE, main = "", breaks = "FD") lines(density(x, na.rm = TRUE), col = "red", lwd = 1) rug(x) } if (histogram) pairs(x, gap = 0, lower.panel = panel.smooth, upper.panel = panel.cor, diag.panel = hist.panel) else pairs(x, gap = 0, lower.panel = panel.smooth, upper.panel = panel.cor)}

当然呢,在Rstudio里面,我们可以把光标放在函数名上按F2,Rstudio会打开一个新的窗口来显示这个函数:

优点:直接简单。 缺点:并非所有的函数都能通过此方法得到。 原因:R是面向对象设计的程序语言。

> page(chart.Correlation)

data(managers)chart.Correlation(managers[,1:8], histogram=T,pch="+",col="black")。

1、做出来的图是这样的:

但是我想把相关系数的字体都搞成一致,然后小圆圈的空心点变成“+”,但是pch=这个参数不顶用。怎么办?查看了帮助文档help(chart.Correlation)也没有参数可调,看来修改函数是一个不错的选择了。

2、于是我就:

> mychart.Correlation<-edit(chart.Correlation)。

我把它设置字体的部分和调整散点图形状的部分稍作了修改,点击Save,这样一个新的函数mychart.Correlation就生成了。现在,我用同样的数据和参数来绘制这个图,达到了我的要求:

data(managers)mychart.Correlation(managers[,1:8], histogram=T,pch="+",col="black")。

3、修改后的函数是这样的:

函数edit()不仅可以修改包中的函数作为急用,也可以用来修改自己正在写的函数,可以说很实用了在我们写函数的时候。

> meanfunction (x, ...) UseMethod("mean")

此时要有methods()来查找mean具体的对象:

methods(mean) [1] mean.Date mean.default mean.difftime mean.geometric mean.LCL mean.POSIXct mean.POSIXlt mean.stderr mean.UCL [10] mean.yearmon* mean.yearqtr* mean.zoo* see '?methods' for accessing help and source code。

要查看具体名称,如mean.default的代码,直接用代码

> mean.defaultfunction (x, trim = 0, na.rm = FALSE, ...) { if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) { warning("argument is not numeric or logical: returning NA") return(NA_real_) } if (na.rm) x <- x[!is.na(x)] if (!is.numeric(trim) || length(trim) != 1L) stop("'trim' must be numeric of length one") n <- length(x) if (trim > 0 && n) { if (is.complex(x)) stop("trimmed means are not defined for complex data") if (anyNA(x)) return(NA_real_) if (trim >= 0.5) return(stats::median(x, na.rm = FALSE)) lo <- floor(n * trim) + 1 hi <- n + 1 - lo x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi] } .Internal(mean(x))}

如chart.Correlation()就不能用这方法:

> methods(chart.Correlation)no methods found> chart.Correlation.defaultError: object 'chart.Correlation.default' not found。

> methods(predict) [1] predict.ar* predict.Arima* predict.arima0* predict.glm predict.HoltWinters* [6] predict.lm predict.loess* predict.mlm* predict.nls* predict.poly* [11] predict.ppr* predict.prcomp* predict.princomp* predict.smooth.spline* predict.smooth.spline.fit*[16] predict.StructTS* see '?methods' for accessing help and source code> getAnywhere(predict.Arima)A single object matching ‘predict.Arima’ was foundIt was found in the following places registered S3 method for predict from namespace stats namespace:statswith valuefunction (object, n.ahead = 1L, newxreg = NULL, se.fit = TRUE, ...) { myNCOL <- function(x) if (is.null(x)) 0 else NCOL(x) rsd <- object$residuals xr <- object$call$xreg xreg <- if (!is.null(xr)) eval.parent(xr) else NULL ncxreg <- myNCOL(xreg) if (myNCOL(newxreg) != ncxreg) stop("'xreg' and 'newxreg' have different numbers of columns") class(xreg) <- NULL xtsp <- tsp(rsd) n <- length(rsd) arma <- object$arma coefs <- object$coef narma <- sum(arma[1L:4L]) if (length(coefs) > narma) { if (names(coefs)[narma + 1L] == "intercept") { xreg <- cbind(intercept = rep(1, n), xreg) newxreg <- cbind(intercept = rep(1, n.ahead), newxreg) ncxreg <- ncxreg + 1L } xm <- if (narma == 0) drop(as.matrix(newxreg) %*% coefs) else drop(as.matrix(newxreg) %*% coefs[-(1L:narma)]) } else xm <- 0 if (arma[2L] > 0L) { ma <- coefs[arma[1L] + 1L:arma[2L]] if (any(Mod(polyroot(c(1, ma))) < 1)) warning("MA part of model is not invertible") } if (arma[4L] > 0L) { ma <- coefs[sum(arma[1L:3L]) + 1L:arma[4L]] if (any(Mod(polyroot(c(1, ma))) < 1)) warning("seasonal MA part of model is not invertible") } z <- KalmanForecast(n.ahead, object$model) pred <- ts(z[[1L]] + xm, start = xtsp[2L] + deltat(rsd), frequency = xtsp[3L]) if (se.fit) { se <- ts(sqrt(z[[2L]] * object$sigma2), start = xtsp[2L] + deltat(rsd), frequency = xtsp[3L]) list(pred = pred, se = se) } else pred}

再复杂的包也是由基本的R函数构成的,所以从基础学起总是不错的。基础决定高度。有了这六个查看R函数的方法,是不是清楚了很多呢。函数是完成某项具体任务的程序,能看R函数,学习R就不再是到处粘代码了也不再是只会调参数了,可以自己定义参数,自己来写函数了。

参考: 查看R源代码的六种方法 怎么才能查看R语言某个包某函数源码? R查看各函数的源代码 查看R函数源代码 R语言-函数源代码查看 【r<-高级|理论】R的函数 第五节 R语言函数function。