Messagepar HADJOU ASMA » 15 Fév 2018, 07:29
Bonjour,
J'ai rencontré la même situation où je voulais des droites de régressions plutôt que des courbes lisses.
Ce que j'ai fais est d'afficher la fonction originale chart.Correlation et de faire les retouches que je souhaite.
Il suffit de taper la commande "chart.Correlation" sans parenthèses pour obtenir le code R de cette fonction, le modifier
pour obtenir les options que l'on veut et de lui donner un autre nom (ex. chart.CorrelationCorr).
Je vous donne l'exemple des droites de régressions. J'ai mis en rouge ce que j'ai rajouté pour:
- afficher les panneaux de régression
- changer les couleurs des histogrammes
- modifier la tailles des noms des hist....
chart.CorrelationCorr=function (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, 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(x, 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))
}
hist.panel = function(x, ...) {
par(new = TRUE)
hist(x, col = "darksalmon", probability = TRUE, axes = FALSE, main = "", breaks = 10)
lines(density(x, na.rm = TRUE), col = "red", lwd = 2)
rug(x)
}
LM.panel = function(x,y, ...) {
par(new = TRUE)
plot(x,y,xaxt="n",yaxt="n",pch="+")
abline(lm(y~x),col="red",lwd=1)
}
if (histogram)
pairs(x,cex.labels = 3, labels = c(expression(lambda[a]),"f",expression(S[0]),expression(S[1]),expression(S[2]), expression(alpha[2])),gap = 0, lower.panel =LM.panel , upper.panel = panel.cor,
diag.panel = hist.panel, method = method, ...)
else pairs(x, gap = 0, lower.panel = panel.smooth, upper.panel = panel.cor,
method = method, ...)
}
Et vous utilisez votre nouvelle fonction d'une façon similaire
> chart.CorrelationCorr(data,histogram = TRUE,pch="+",method = "spearman")
Voici la fonction "chart.Correlation" d'origine:
> chart.Correlation
function (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, 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(x, 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))
}
hist.panel = function(x, ...) {
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, method = method, ...)
else pairs(x, gap = 0, lower.panel = panel.smooth, upper.panel = panel.cor,
method = method, ...)
}
<environment: namespace:PerformanceAnalytics>