I want to use the i variable to loop over this piece of code, each iteration changing FAQ$q1 to FAQ$q2, FAQ$q3. How can I do this?
for(i in 1: 19){
yes <- table(FAQ$q1)[1]
no <- table(FAQ$q1)[2]
b <- barplot(table(FAQ$q1),
main="Did you have any difficulties using the chatbot?",
ylab="Count",
names.arg = c("yes", "no"),
col="blue",
ylim = c(0,28))
abline(v=c(1.3) , col="grey")
text(b, y=c(yes+1,no+1), paste("n: ", c(yes,no) , sep=""), cex=1, col = "red")
}
We can use paste to create a string for the column name and extract with [[ (as $ will try to match literally). If we want to redirect the plots to a single pdf, then write the plots to pdf. In the code, table function was applied on the same column multiple times, instead, do it once and create an object ('tbl1') which is reused as necessary
pdf("path/to/file.pdf")
for(i in 1:19){
colnm <- paste0("q", i)
tbl1 <- table(FAQ[[colnm]])
yes <- tbl1[1]
no <- tbl1[2]
b <- barplot(tbl1,
main="Did you have any difficulties using the chatbot?",
ylab="Count",
names.arg = c("yes", "no"),
col="blue",
ylim = c(0,28))
abline(v=c(1.3) , col="grey")
text(b, y=c(yes+1,no+1), paste("n: ", c(yes,no) , sep=""), cex=1, col = "red")
}
dev.off()
The difference in paste0 and paste is in the sep. By default paste uses sep = " " where as it is "" in paste0
Related
I'm importing a df and then running hist() on the df:
df <- read.table("https://leicester.figshare.com/ndownloader/files/23581310", sep = ",", header = TRUE, stringsAsFactors = FALSE)
hist(df)
but it doesn't show the histograms of all 124 columns - only a subset. I'm not sure why? How do I get a histogram of all the columns in a df? I want to be able to run hist() on the entire data frame because it also shows the number of values/missing values at the bottom of each histogram.
I wonder how you could at all use hist in a data frame without Vectorizeing it. Best would be you use a different device such as the png.
png('foo.png', 2560, 1440)
par(mfrow=c(12, 11))
Vectorize(hist)(df)
dev.off()
Update
We can get nice titles and labels with nobs and missings using lapply and a misfun for convenience.
misfun <- \(z) paste(
paste(c('n', 'm'), table(factor(as.double(is.na(z)), levels=0:1)), sep=':'),
collapse=' ')
png('foo2.png', 2560, 1440)
par(mfrow=c(12, 11))
lapply(names(df), \(x) hist(df[[x]], main=x, xlab=misfun(df[x])))
dev.off()
Data:
df <- read.table("https://leicester.figshare.com/ndownloader/files/23581310", sep = ",", header = TRUE, stringsAsFactors = FALSE)
If all you are only looking for are the number of missing values in each column but don't really need the histograms, you can do:
colSums(sapply(df, is.na))
If you need this as an image, then it will be much clearer to draw it with text rather than hist:
df2 <- data.frame(col = paste(names(df), colSums(sapply(df, is.na)),
sep = '\n \nMissing = '),
x = (seq(ncol(df)) - 1) %% 12,
y = 12 - (seq(ncol(df)) - 1) %/% 12)
plot(df2$x, df2$y, type = 'n', xaxt = 'n', yaxt = 'n', xlab = '', ylab = '',
bty = 'n')
text(df2$x, df2$y, label = df2$col, cex = 0.5)
I need help to barplot multiple files in a loop. I have created a function to barplot these different files for only two columns out of 5 columns input file contains and then call the function
bar.plot <- function( col_name1, col_name2,input_file, lable1, lable2) {
barplot(col_name1, names.arg = col_name2, xlab = "label1", ylab = "lable2",
col= "blue", main = "bar plot of average", border = "red")
box()
}
#call the function for 10 files
i <- 1
for (i in 1:10) {
filename <- paste("C:/Users/admin/GoogleDrive/Vidya/R/document/Group_",
i, ".csv", sep = "")
group <- read.csv(filename)
lablex <- "average"
labley <- "master id"
bar.plot(group$total_pause_time, group$employee_id, group, lablex, labley)
}
output plot shows xlable as label1 and ylable as label2, even though I have entered "average" in lablex and "master id" in labley.
Also tell me how to save these different plots with 10 diffrent names e.g. plot1.jpg to plot10.jpg
This will create a pdf file of your ten individual plots
bar.plot <- function( col_name1, col_name2,input_file, lable1, lable2)
{
barplot(col_name1,names.arg = col_name2,xlab=label1,ylab=label2,
col= "blue",main = "bar plot of average",border = "red")
box()
}
#call the function for 10 files
label1 <- "average"
label2 <- "master id"
setwd("C:/Users/admin/GoogleDrive/Vidya/R/document/Group_/")
filename <- list.files(pattern = ".csv")
myfiles <- lapply(filename, read.csv)
for (i in myfiles)
{
group <- data.frame(myfiles[i])
jpeg(paste(i,".jpg"))
bar.plot(group$total_pause_time,group$employee_id,label1,label2)
dev.off()
}
Try this:
bar.plot <- function( col_name1, col_name2,input_file, lable1, lable2) {
barplot(col_name1,names.arg = col_name2, xlab = lable1, ylab = lable2,
col= "blue",main = "bar plot of average",border = "red")
box()
}
#call the function for 10 files
for (i in 1:10){
filename <-paste("C:/Users/admin/GoogleDrive/Vidya/R/document/Group_",i,".csv",sep = "")
group <- read.csv(filename)
lable1 <- "average"
lable2 <- "master id"
bar.plot(group$total_pause_time,group$employee_id, group, lable1, lable2)
dev.copy(jpg,paste("C:/Users/admin/GoogleDrive/Vidya/R/document/plot",i,".jpg)
dev.off()
}
I have made a loop for making multiply plots, however i have no way of saving them, my code looks like this:
#----------------------------------------------------------------------------------------#
# RING data: Mikkel
#----------------------------------------------------------------------------------------#
# Set working directory
setwd()
#### Read data & Converting factors ####
dat <- read.table("Complete RING.txt", header =TRUE)
str(dat)
dat$Vial <- as.factor(dat$Vial)
dat$Line <- as.factor(dat$Line)
dat$Fly <- as.factor(dat$Fly)
dat$Temp <- as.factor(dat$Temp)
str(dat)
datSUM <- summaryBy(X0.5_sec+X1_sec+X1.5_sec+X2_sec+X2.5_sec+X3_sec~Vial_nr+Concentration+Sex+Line+Vial+Temp,data=dat, FUN=sum)
fl<-levels(datSUM$Line)
colors = c("#e41a1c", "#377eb8", "#4daf4a", "#984ea3")
meltet <- melt(datSUM, id=c("Concentration","Sex","Line","Vial", "Temp", "Vial_nr"))
levels(meltet$variable) <- c('0,5 sec', '1 sec', '1,5 sec', '2 sec', '2,5 sec', '3 sec')
meltet20 <- subset(meltet, Line=="20")
meltet20$variable <- as.factor(meltet20$variable)
AllConcentrations <- levels(meltet20$Concentration)
for (i in AllConcentrations) {
meltet.i <- meltet20[meltet20$Concentration ==i,]
quartz()
print(dotplot(value~variable|Temp, group=Sex, data = meltet.i ,xlab="Time", ylab="Total height pr vial [mm above buttom]", main=paste('Line 20 concentration ', meltet.i$Concentration[1]),
key = list(points = list(col = colors[1:2], pch = c(1, 2)),
text = list(c("Female", "Male")),
space = "top"), col = colors, pch =c(1, 2))) }
I have tried with the quartz.save function, but that just overwrites the files. Im using a mac if that makes any difference.
When I want to save multiple plots in a loop I tend to do something like...
for(i in AllConcentrations){
meltet.i <- meltet20[meltet20$Concentration ==i,]
pdf(paste("my_filename", i, ".pdf", sep = ""))
dotplot(value~variable|Temp, group=Sex, data = meltet.i ,xlab="Time", ylab="Total height pr vial [mm above buttom]", main=paste('Line 20 concentration ', meltet.i$Concentration[1]),
key = list(points = list(col = colors[1:2], pch = c(1, 2)),
text = list(c("Female", "Male")),
space = "top"), col = colors, pch =c(1, 2))
dev.off()
}
This will create a pdf file for every level in AllConcentrations and save it in your working directory. It will paste together my_filename, the number of the iteration i, and then .pdf together to make each file unique. Of course, you will want to adjust height and width in the pdf function.
I there a way to see in R how a graph was built into a variable: the code behind the graph. I have tried the str(), deparse(), and replayPlot() functions but these don't give the answer I am searching for.
Precisely I am looking at the result returned by the MackChainLadder() function from the "ChainLadder" package. When I plot the the variable, say plot(MCL), it returns me 6 different graphs. Is it a way to find out how these graphs were built and saved into the variable?
library("ChainLadder")
MCL <- MackChainLadder(ABC)
plot(MCL)
One way to do this is to look at the package source code directly (download it from this page):
http://cran.r-project.org/web/packages/ChainLadder/index.html
The trick is finding the right method that plot() calls. I think it might be this one in MackChainLadderFunctions.R
################################################################################
## plot
##
plot.MackChainLadder <- function(x, mfrow=c(3,2), title=NULL,lattice=FALSE,...){
.myResult <- summary(x)$ByOrigin
.FullTriangle <- x[["FullTriangle"]]
.Triangle <- x[["Triangle"]]
if(!lattice){
if(is.null(title)) myoma <- c(0,0,0,0) else myoma <- c(0,0,2,0)
op=par(mfrow=mfrow, oma=myoma, mar=c(4.5,4.5,2,2))
plotdata <- t(as.matrix(.myResult[,c("Latest","IBNR")]))
n <- ncol(plotdata)
if(getRversion() < "2.9.0") { ## work around missing feature
bp <- barplot(plotdata,
legend.text=c("Latest","Forecast"),
## args.legend=list(x="topleft"), only avilable from R version >= 2.9.0
names.arg=rownames(.myResult),
main="Mack Chain Ladder Results",
xlab="Origin period",
ylab="Amount",#paste(Currency,myUnit),
ylim=c(0, max(apply(.myResult[c("Ultimate", "Mack.S.E")],1,sum),na.rm=TRUE)))
}else{
bp <- barplot(plotdata,
legend.text=c("Latest","Forecast"),
args.legend=list(x="topleft"),
names.arg=rownames(.myResult),
main="Mack Chain Ladder Results",
xlab="Origin period",
ylab="Amount",#paste(Currency,myUnit),
ylim=c(0, max(apply(.myResult[c("Ultimate", "Mack.S.E")],1,sum),na.rm=TRUE)))
}
## add error ticks
## require("Hmisc")
errbar(x=bp, y=.myResult$Ultimate,
yplus=(.myResult$Ultimate + .myResult$Mack.S.E),
yminus=(.myResult$Ultimate - .myResult$Mack.S.E),
cap=0.05,
add=TRUE)
matplot(t(.FullTriangle), type="l",
main="Chain ladder developments by origin period",
xlab="Development period", ylab="Amount", #paste(Currency, myUnit)
)
matplot(t(.Triangle), add=TRUE)
Residuals=residuals(x)
plot(standard.residuals ~ fitted.value, data=Residuals,
ylab="Standardised residuals", xlab="Fitted")
lines(lowess(Residuals$fitted.value, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
plot(standard.residuals ~ origin.period, data=Residuals,
ylab="Standardised residuals", xlab="Origin period")
lines(lowess(Residuals$origin.period, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
plot(standard.residuals ~ cal.period, data=Residuals,
ylab="Standardised residuals", xlab="Calendar period")
lines(lowess(Residuals$cal.period, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
plot(standard.residuals ~ dev.period, data=Residuals,
ylab="Standardised residuals", xlab="Development period")
lines(lowess(Residuals$dev.period, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
title( title , outer=TRUE)
par(op)
}else{
## require(grid)
## Set legend
fl <-
grid.layout(nrow = 2, ncol = 4,
heights = unit(rep(1, 2), "lines"),
widths =
unit(c(2, 1, 2, 1),
c("cm", "strwidth", "cm",
"strwidth"),
data = list(NULL, "Chain ladder dev.", NULL,
"Mack's S.E.")))
foo <- frameGrob(layout = fl)
foo <- placeGrob(foo,
linesGrob(c(0.2, 0.8), c(.5, .5),
gp = gpar(col=1, lty=1)),
row = 1, col = 1)
foo <- placeGrob(foo,
linesGrob(c(0.2, 0.8), c(.5, .5),
gp = gpar(col=1, lty=3)),
row = 1, col = 3)
foo <- placeGrob(foo,
textGrob(label = "Chain ladder dev."),
row = 1, col = 2)
foo <- placeGrob(foo,
textGrob(label = "Mack's S.E."),
row = 1, col = 4)
long <- expand.grid(origin=as.numeric(dimnames(.FullTriangle)$origin),
dev=as.numeric(dimnames(.FullTriangle)$dev))
long$value <- as.vector(.FullTriangle)
long$valuePlusMack.S.E <- long$value + as.vector(x$Mack.S.E)
long$valueMinusMack.S.E <- long$value - as.vector(x$Mack.S.E)
sublong <- long[!is.na(long$value),]
xyplot(valuePlusMack.S.E + valueMinusMack.S.E + value ~ dev |
factor(origin), data=sublong, t="l", lty=c(3,3,1), as.table=TRUE,
main="Chain ladder developments by origin period",
xlab="Development period",
ylab="Amount",col=1,
legend = list(top = list(fun = foo)),...)
}
}
As the above screenshot showed, I used the function heatmap.2() here.
how can I change 'Value' in the color coded bar to any other name?
One can just use the data from gplots package:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
heatmap.2(x, key=TRUE)
Many thanks :-)
The function heatmap.2 may have changed since #BondedDust answered, but its now possible to easily change the heatmap.2 key labels via:
key.xlab="New value"
First, your code from above (using the standard colors):
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x,key=TRUE)
Now replace the x and y labels:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key=TRUE , key.xlab="New value", key.ylab="New count")
It's hard-coded. You will need to change it in the code. It appears about midway down the section that draws the key and the line is:
else mtext(side = 1, "Value", line = 2)
This is the section of the heatmap.2 code that creates the key (at least up to the point where the word "Value" appears) :
if (key) {
par(mar = c(5, 4, 2, 1), cex = 0.75)
tmpbreaks <- breaks
if (symkey) {
max.raw <- max(abs(c(x, breaks)), na.rm = TRUE)
min.raw <- -max.raw
tmpbreaks[1] <- -max(abs(x), na.rm = TRUE)
tmpbreaks[length(tmpbreaks)] <- max(abs(x), na.rm = TRUE)
}
else {
min.raw <- min(x, na.rm = TRUE)
max.raw <- max(x, na.rm = TRUE)
}
z <- seq(min.raw, max.raw, length = length(col))
image(z = matrix(z, ncol = 1), col = col, breaks = tmpbreaks,
xaxt = "n", yaxt = "n")
par(usr = c(0, 1, 0, 1))
lv <- pretty(breaks)
xv <- scale01(as.numeric(lv), min.raw, max.raw)
axis(1, at = xv, labels = lv)
if (scale == "row")
mtext(side = 1, "Row Z-Score", line = 2)
else if (scale == "column")
mtext(side = 1, "Column Z-Score", line = 2)
else mtext(side = 1, "Value", line = 2)
.... lots more code below
You should type heatmap.2 , then copy the source code to an editor and then use the search function to find "Value". Change "Value" to something else (in quotes) and then type heatmap.2 <- and paste in the code and hit return. (Unless you save this it will only persist as long as the session continues.)
Just come across same task recently. Now there is an option "key.title" to set the title for scale inlet:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key.title = "New Title", key.xlab="New value", key.ylab="New count")
Unfortunately, it do not propagate properly if there is no histogram in inlet:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key.title = "New Title", key.xlab="New value", key.ylab="New count")
Well, key.xlab working as expected and can be used instead.
I've checked the source code on github and it is already fixed there.