Hi everybody I am trying to solve a little problem with a lattice graphic in R. I build a double y axis plot with lattice. It works awesome. I add the code and dput version of my data (xx list of data frames in the final part):
library(lattice)
library(latticeExtra)
#First graph
#Format
comma_fomatter <- function (lim, logsc = FALSE, at = NULL, ...)
{
ans <- yscale.components.default(lim = lim, logsc = logsc,
at = at, ...)
xx = as.numeric(ans$left$labels$labels)
ans$left$labels$labels <- formatC(xx, format="fg",big.mark = ",")
ans
}
#Plot
DD=barchart(a1 ~ a5,xx, yscale.components =comma_fomatter)
#Second graph
#Format
percent1 <- function(x, digits = 2, format = "f", ...)
{
paste(formatC(100 * x, format = format, digits = digits, ...), "%", sep = "")
}
percent <- function (lim, logsc = FALSE, at = NULL, ...)
{
ans <- yscale.components.default(lim = lim, logsc = logsc,
at = at, ...)
xx = as.numeric(ans$left$labels$labels)
ans$left$labels$labels <- percent1(xx)
ans
}
#Second plot
D3=xyplot(a3+a4 ~ a5, xx, type = "b",yscale.components=percent)
#Final graph
DF=doubleYScale(DD, D3,style1 = 3, style2 = 0, add.ylab2 = FALSE,text = c("a3", "a4","a1"),main="Nuevo Gráfico")
All works perfect but when I plot DF I got this:
How you can see the left side y axis doesn't show its values and I think this fact is due to the size of square that has all plots. My question is if it is any way to reduce the size of that square and showing the complete values inside of y axis scale. The dput() version of my list of data frames is the next:
xx=structure(list(a1 = c(560492.29, 1433973.37, 3016748.66, 4241217.73,
6251742.27, 6757161.24, 7408081.05, 7899980.33), a2 = 1:8, a3 = c(0,
0.00793734405263048, 0.0129172080248807, 0.0324335034787285,
0.0397094648625047, 0.0555107413716237, 0.0521541081141384, 0.0515512600016815
), a4 = c(0.0142731668976214, 0.010460445301017, 0.0928151568317925,
0.0707344020275045, 0.0303915279604129, 0.0517968992552855, 0.0202481585970229,
0.0253165187311296), a5 = structure(1:8, .Label = c("abr 2013",
"may 2013", "jun 2013", "jul 2013", "ago 2013", "sep 2013", "oct 2013",
"nov 2013"), class = "factor")), .Names = c("a1", "a2", "a3",
"a4", "a5"))
I have looked for any advice at lattice graphics book but I can't solve this element. Many thanks for your help.
Not sure why it didn't work for you. I've taken the liberty to reformat your code, other than that nothing important has changed. Anyway, here's the plot:
EDIT: The problem seems to be related to the settings of lattice (see ?trellis.par.get). I've updated the source accordingly, that should solve the problem.
And here's the source:
library(lattice)
library(latticeExtra)
# xx <- ... paste your dataset here
# Adapt these to your needs:
parSettings <- list(layout.widths=list(left.padding=5))
#First graph
comma_formatter <- function (lim, logsc = FALSE, at = NULL, ...) {
ans <- yscale.components.default(lim = lim, logsc = logsc, at = at, ...)
xxPrime <- as.numeric(ans$left$labels$labels)
ans$left$labels$labels <- formatC(xxPrime, format = "fg", big.mark = ",")
ans
}
#Plot
DD <- barchart(a1 ~ a5, xx, yscale.components = comma_formatter, par.settings = parSettings)
#Second graph
percent <- function (lim, logsc = FALSE, at = NULL, ...) {
# Helper function (never needed elsewhere, so we can declare it here)
percent1 <- function(x, digits = 2, format = "f", ...)
paste(formatC(100 * x, format = format, digits = digits, ...), "%", sep = "")
ans <- yscale.components.default(lim = lim, logsc = logsc, at = at, ...)
xxPrime <- as.numeric(ans$left$labels$labels)
ans$left$labels$labels <- percent1(xxPrime)
ans
}
#Plot
D3 <- xyplot(a3+a4 ~ a5, xx, type = "b", yscale.components = percent, par.settings = parSettings)
#Final graph
DF <- doubleYScale(DD, D3, style1 = 3, style2 = 0, add.ylab2 = FALSE,
text = c("a3", "a4", "a1"), main = "Nuevo Gráfico")
plot(DF)
Related
I am trying to make plots using a function in which arguments are values of dataframes.
seniorPlot <- function(validityDate, seniorTotal, color){
par(new = T)
plot(validityDate,seniorTotal,
type = "l",
lwd = 2.5,
xlim = c(date_debut$validityDate,date_fin$validityDate),
ylim = c(1,nmax$seniorTotal),
col = color,
xlab = "",
ylab = "",
xaxt = "n",
yaxt = "n",
bty = "n",
)
}
For the purpose, the threee arguments of the function are results several dataframes 'seniorList' and the seniors df named with the senior initials ('AM', 'FB', 'GM'…)
To describe, you can see the senior dataframes below:
seniorList <- data.frame(seniorValidation=c('AM', 'FB', 'GM'),seniorTotal=c(72, 154, 137))
AM <- data.frame(validationDate=c('2022-01-25', '2022-01-26'), color=c('brown','brown')
FB <- data.frame(validationDate=c('2022-01-20', '2022-01-30'), color=c('green','green')
GM <- data.frame(validationDate=c('2022-01-24', '2022-01-28'), color=c('blue','blue')
Obviously, there is more than 3 lines in the seniorList, so I want to do a loop, using the value of the first column of seniorList (ie. the senior name) to call the write dataframe.
And, here is the issue : how can I convert the result of noquote(paste(noquote(seniorList[i,1]),'$validityDate', sep = '')) to the result '2022-01-25' (if i = 1)
for (i in 1:nrow(seniorList)) {
seniorPlot(validityDate = noquote(paste(noquote(seniorList[i,1]),'$validityDate', sep = '')),
seniorTotal = noquote(paste(noquote(seniorList[i,1]),'$seniorTotal', sep = '')),
color = noquote(paste(noquote(seniorList[i,1]),'$color', sep = '')))
}
Thank you for your help, I hope my english is easy to understand.
noquote(paste(noquote(seniorList[i,1]),'$validityDate', sep = '')) give AM$validityDate and not its result
It's unclear what exactly the plot should look like but this shows how use "tidy" data easily with ggplot2.
DF <- rbind(cbind(AM, data.frame(seniorTotal = 72, seniorValidation = "AM")),
cbind(FB, data.frame(seniorTotal = 154, seniorValidation = "GB")),
cbind(GM, data.frame(seniorTotal = 137, seniorValidation = "GM")))
DF$validationDate <- as.Date(DF$validationDate)
#this is how your data should look like:
print(DF)
library(ggplot2)
ggplot(data = DF, aes(x = validationDate, y = seniorTotal, color = seniorValidation)) +
geom_line()
Error in RStudio barplot
I work for a research lab and last worker left without explaining how her RStudio programs work, I have to adapt one to get the data of participants in the month of September, but I get 2 errors, it should be an easy fix but I can't see it.
I have the parameter days:
dias <- c("01","02","05","06","07","08","09","12","13","14","16","19","20","21","22","23","26","27","28","29","30")
and a part that reads data from an excel and then makes a barplot but I get the error:
Error in barplot.default(Volun_citados_dias_mes, ylim = c(0, 100), names.arg = dias, :
incorrect number of names
In this part for the barplot:
jpeg("x.jpeg", width = 800, height = 800)
text(barplot(Volun_citados_dias_mes, ylim = c(0, 100), names.arg = dias, cex.names = 0.9, col = "khaki", xlab = "Días",
ylab = "Voluntarios", main = "Número de voluntarios citados en Septiembre de 2022"),
Volun_citados_dias_mes + 4, labels = round(Volun_citados_dias_mes, 1))
dev.off()
And here when putting that data on an excel i get this other error:
Error in data.frame(dias, Volun_citadosSep) :
arguments imply differing number of rows: 21, 2
write.xlsx(data.frame(dias, Volun_citadosSep), "X:/Cohorte Cantabria/2. PROYECTO/INFORMES/Exito reclutamiento/Asistencia/Septiembre/Tablas/VolunCitadosDiasMes.xlsx", row.names = FALSE)
on.exit(par(opar))
dev.off()
I tried changing that 4 (Volun_citados_dias_mes + 4) to a 21... but not really sure what else to change, i was expecting a graph with at least 2 days added 01 and 02 that are the ones added by now, I prefer fixing this before adding 20 more.
CODE resumed:
#"..." is parts that are omitted
#libraries
library(readxl)
library("stringr")
library("xlsx")
dir <- "**...**"
#days
dias <- c("01","02","05","06","07","08","09","12","13","14","16","19","20","21","22","23","26","27","28","29","30")
#Redcap
df <- file.info(list.files("**...**", pattern = "**...**", full.names = TRUE))
lastFileCallcenter <- rownames(df)[which.max(df$mtime)]
ccList <- read.csv2(lastFileCallcenter, header = TRUE, sep = ",", quote = "\"",
dec = ",", stringsAsFactors = FALSE, encoding = "UTF-8")
colnames(ccList)[[which(str_detect(colnames(ccList), "codigo_registro"))]] <- "codigo_registro"
ccList <- unified_df(ccList)
ccList$codigo_registro <- toupper(ccList$codigo_registro)
ccList$dni_nie <- toupper(ccList$dni_nie)
septiembre_22 <- read.csv2(file.path(dir, "**...**.csv"), header = TRUE, sep = ",",
quote = "\"", dec = ",", stringsAsFactors = FALSE, encoding = "UTF-8")
colnames(septiembre_22)[[which(str_detect(colnames(septiembre_22), "codigo_registro"))]] <- "codigo_registro"
septiembre_22 <- unified_df(septiembre_22)
septiembre_22$codigo_registro <- toupper(septiembre_22$codigo_registro)
septiembre_22$dni_nie <- toupper(septiembre_22$dni_nie)
#-------------------Volunteers days of the month ---------------------------------------------------
septiembre_22_01 <- dim(septiembre_22[which(septiembre_22$fecha_extraccion == "01/09/2022"),])[1] + dim(septiembre_22[which(septiembre_22$fecha_extraccion_vt == "01/09/2022"),])[1]
septiembre_22_02 <- dim(septiembre_22[which(septiembre_22$fecha_extraccion == "02/09/2022"),])[1] + dim(septiembre_22[which(septiembre_22$fecha_extraccion_vt == "02/09/2022"),])[1]
**#...TODO, other days**
Volun_citadosSep <- c(septiembre_22_01, septiembre_22_02,**#...TODO**)
jpeg("x.jpeg", width = 800, height = 800)
text(barplot(Volun_citadosSep, ylim = c(0, 100), names.arg = dias, cex.names = 0.9, col = "khaki", xlab = "Días",
ylab = "Voluntarios", main = "Número de voluntarios citados en Septiembre de 2022"),
Volun_citadosSep + 4, labels = round(Volun_citadosSep, 1))
dev.off()
write.xlsx(data.frame(dias, Volun_citadosSep), "VolunCitadosDiasMes.xlsx", row.names = FALSE)
on.exit(par(opar))
dev.off()
library(zoo)
dat<-data.frame(
prec<-rnorm(650,mean=300),
temp<-rnorm(650,mean = 22),
pet<-rnorm(650,mean = 79),
bal<-rnorm(650,mean = 225))
colnames(dat)<-c("prec","temp","pet","bal")
dat<-ts(dat,start = c(1965,1),frequency = 12)
plot.zoo(dat)
rect(xleft=1975,xright = 1982,ybottom=0,ytop=800,col= '#FFFF0022',border = "transparent")
rect(xleft=1990,xright = 2000,ybottom=0,ytop=800,col= '#00BFFF22',border = "transparent")
rect(xleft=2010,xright = 2015,ybottom=0,ytop=500,col= '#FF000022',border = "transparent")
But I only get something either out of boundaries or not in the proper x axis This is my result so far
Use a panel function. Also using xblocks can simplify this further:
plot.zoo(dat, panel = function(x, y, ...) {
lines(x, y, ...)
year <- as.integer(x)
xblocks(x, year %in% 1975:1982, col = '#FFFF0022')
xblocks(x, year %in% 1990:2000, col = '#00BFFF22')
xblocks(x, year %in% 2010:2015, col = '#FF000022')
})
I am developing an interactive scatterplot so that when the user rolls over a data point, a label is displayed. However, I would also like to add edges between certain data points.
I am successful at developing the interactive scatterplot using several libraries, including grid, gridSVG, lattice, and adegraphics. Below is a MWE:
library(grid)
library(gridSVG)
library(lattice)
library(adegraphics)
x = rnorm(10)
y = rnorm(10)
dat = data.frame(label = letters[1:10], x, y)
customPanel2 <- function(x, y, ...) {
for (j in 1:nrow(dat)) {
grid.circle(x[j], y[j], r = unit(.5, "mm"),
default.unit = "native",
name = paste("point", j, sep = "."))
}
}
xyplot(y ~ x, panel = customPanel2, xlab = "x variable", ylab=NULL, scales=list(tck = c(1,0), y=list(at=NULL)))
for (i in 1:nrow(dat)) {
grid.text(as.character(dat$label)[i], x = 0.1, y = 0.01, just = c("left", "bottom"), name = paste("label", i, sep = "."), gp = gpar(fontface = "bold.italic"))
}
for (i in 1:nrow(dat)) {
grid.garnish(paste("point", i, sep = "."), onmouseover = paste('highlight("', i, '.1.1")', sep = ""), onmouseout = paste('dim("', i, '.1.1")', sep = ""))
grid.garnish(paste("label", i, sep = "."), visibility = "hidden")
}
grid.script(filename = "aqm.js", inline = TRUE)
grid.export("interactiveScat.svg")
The resulting .svg file accomplishes everything I am aiming for - except that I also wish to add certain non-interactive edges. I tried to do this by incorporating the adeg.panel.edges method from the adegraphics library after defining the edges and the coordinates to be mapped. So, basically my xplot(...) function from before is replaced with:
edges = matrix(c(1, 2, 3, 2, 4, 1, 3, 4), byrow = TRUE, ncol = 2)
coords <- matrix(c(x[1], y[1], x[2], y[2], x[3], y[3], x[4], y[4]), byrow = TRUE, ncol = 2)
xyplot(y ~ x, panel = function(customPanel2){adeg.panel.edges(edges, coords, lty = 1:4, cex = 5)}, xlab = "x variable", ylab=NULL, scales=list(tck = c(1,0), y=list(at=NULL)))
It seems that this simply erases the interactive scatterplot made from the original xyplot, and simply outputs the static edge and coordinate image.
I tried to follow the example as seen in (http://finzi.psych.upenn.edu/library/adegraphics/html/adeg.panel.nb.html). Specifically, this example:
edges <- matrix(c(1, 2, 3, 2, 4, 1, 3, 4), byrow = TRUE, ncol = 2)
coords <- matrix(c(0, 1, 1, 0, 0, -1, -1, 0), byrow = TRUE, ncol = 2)
xyplot(coords[,2] ~ coords[,1],
panel = function(...){adeg.panel.edges(edges, coords, lty = 1:4, cex = 5)})
I am a bit at a loss as to how to troubleshoot this problem, especially as I am mimicking the example code. Any suggestions are greatly appreciated!
If what you are trying to produce is a node-link diagram of a network an alternate solution is to coerce your data into a network object and use the ndtv package to generate svg/htmlwidget interactive plots for your network. The ndtv package is designed for dynamic networks, but will generate interactive plots for static nets as well.
library(ndtv)
data(emon) # load a list of example networks
render.d3movie(emon[[5]]) # render network 5 in the browser
Much more detail is in the tutorial http://statnet.csde.washington.edu/workshops/SUNBELT/current/ndtv/ndtv-d3_vignette.html
However, this does not use grid/lattice graphics at all
I am making a scatterplot matrix using lattice and plotting the correlation coefficients of 12 variables in the upper half of the panel. I would also like to add the p values beneath the correlation coeffiecients or stars indicating their level of significance. Here is my R code. How can I achieve this? Many thanks in advance!
Here is a sample of my data
d.corr1 = structure(list(maxt1.res = c(-0.944678376630112, 0.324463929632583,
-1.18820341118942, -0.656600399095673, 0.332432965913295, 0.696656683837386
), maxt2.res = c(1.81878373188327, -0.437581385609662, 0.305933316224282,
-3.20946216261864, 0.629812177862245, -1.49044366233353), maxt3.res = c(-1.21422295698813,
-1.31516252550763, 0.570370111383564, 1.73177495368256, 2.18742200139099,
0.413531254505875), mint1.res = c(0.783488332204165, 0.35387082927864,
-0.528584845400234, 0.772682308165534, 0.421127289975828, 1.06059010003109
), mint2.res = c(0.262876147753049, 0.588802881606123, 0.745673830291112,
-1.22383100619312, -1.01594162784602, -0.135018034667641), mint3.res = c(0.283732674541107,
-0.406567031719476, 0.390198644741853, 0.860359703924238, 1.27865614582901,
0.346477970454206), sr1.res = c(1.7258974480523, -1.71718783477085,
3.98573602228491, -4.42153098079411, 0.602511156003456, -3.07683756735513
), sr2.res = c(9.98631829246284, -6.91757809846195, 0.418977023594041,
-6.10811634134865, 14.6495418067316, 2.44365146778955), sr3.res = c(-3.8809447886743,
2.35230122374257, 2.8673756880306, 7.1449786041902, 2.07480997224678,
4.93316979213985), rain1.res = c(0.112986181584307, 0.0445969189874017,
-0.446757191502526, 1.76152475011467, -0.395540856161192, -0.175756810329735
), rain2.res = c(-0.645121126413379, 1.74415111794381, -0.122876137090066,
1.68048850848576, -0.570490345329031, 0.00308540146622738), rain3.res = c(-0.202762644577954,
0.0528174267822909, -0.0616752465852931, -0.167769364680304,
-0.152822027502996, -0.139253335052929)), .Names = c("maxt1.res",
"maxt2.res", "maxt3.res", "mint1.res", "mint2.res", "mint3.res",
"sr1.res", "sr2.res", "sr3.res", "rain1.res", "rain2.res", "rain3.res"
), row.names = c(NA, 6L), class = "data.frame")
attach(d.corr1)
library(lattice)
library(RColorBrewer)
splom(~d.corr1[seq(1:12)], lower.panel = panel.splom,
upper.panel = function(x, y, ...) {
panel.fill(col = brewer.pal(9, "RdBu")[ round(cor(x, y) * 4 + 5)])
cpl <- current.panel.limits()
panel.text(mean(cpl$xlim), mean(cpl$ylim), round(cor(x, y),2), font=2)
},
scales = list(x = list( draw = TRUE, cex=0.1)), type = c("g", "p", "smooth"),layout = c(1, 1), pscales=0, pch=".",
main="correlation between the weather variables after removing district F.E and yearly trends")
dev.off()
detach(d.corr1)
Another option is to use panel.text twice , with different adj parameter.
For example :
splom(~d.corr1[seq(1:12)], lower.panel = panel.splom,
upper.panel = function(x, y, ...) {
panel.fill(col = brewer.pal(9, "RdBu")[ round(cor(x, y) * 4 + 5)])
cpl <- current.panel.limits()
## translate upward
panel.text(mean(cpl$xlim), mean(cpl$ylim), round(cor(x, y),2), font=2,
adj=c(0.5,-0.6))
## translate downward
panel.text(mean(cpl$xlim), mean(cpl$ylim), round( cor.test(x,y)$p.value, 2), font=1,
adj=c(0.5,0.6),col='blue')
},
Base graphics solution for your question is given below.
panel.cor <- function(x, y, digits = 2, cex.cor, ...)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
# correlation coefficient
r <- cor(x, y)
txt <- format(c(r, 0.123456789), digits = digits)[1]
txt <- paste("r= ", txt, sep = "")
text(0.5, 0.6, txt)
# p-value calculation
p <- cor.test(x, y)$p.value
txt2 <- format(c(p, 0.123456789), digits = digits)[1]
txt2 <- paste("p= ", txt2, sep = "")
if(p<0.01) txt2 <- paste("p= ", "<0.01", sep = "")
text(0.5, 0.4, txt2)
}
pairs(iris, upper.panel = panel.cor)
I made this by modifying example provide for `pairs' function.
Given that you have offered no data, I will assume you plan to do these calculations external to the plot. Let's assume your p-values are in a vector named p_vals. The instead of round(cor(x, y),2) as the third argument to text, use:
paste( round(cor(x, y),2), "\n", p_vals)
With data you could do it all within lattice using the same strategy:
paste( round(cor(x, y),2) ,"\n", round( cor.test(x,y)$p.value, 2) )