Related
For some reason, I can't figure out, why when I run a ggplot loop to create multiple graphs I don't see them in the environment and hence can't further display the graphs.
Data sample.
db = data.frame(exposure = sample(1:100, 100),
exposure2 = sample(-90:100,100),
outcome = sample(200:1000,100))
exposure_vector = c("exposure","exposure2")
exposure_title = c("Pesticide","Apple")
for (i in 1:length(exposure_vector)) {
current_exposure = db[[exposure_vector[i]]]
title = exposure_title[i]
graph_name = paste0(title,"_","Graph")
graph_name=ggplot(db,aes(x=current_exposure,y=outcome))+geom_smooth()+
theme_bw()+ylab("outcome")+xlab("exposure")+ggtitle(title)
print(graph_name)
}
This is probably a better way to do what you are trying to do. You can mapply over your vectors of titles and exposures, which will return a list of graphs you can then refer to by name:
graphs <- mapply(X=exposure_title,Y=exposure_vector, function(X,Y){
ggplot(db,aes(x=.data[[Y]],y=outcome))+
geom_smooth()+
theme_bw()+
ylab("outcome")+
xlab("exposure")+
ggtitle(X)
}, SIMPLIFY = FALSE )
graphs$Pesticide
graphs$Apple
The graphname is out of scope.
You need to declare it outside the loop.
For example
db = data.frame(exposure = sample(1:100, 100),
exposure2 = sample(-90:100,100),
outcome = sample(200:1000,100))
exposure_vector = c("exposure","exposure2")
exposure_title = c("Pesticide","Apple")
plot <- list() #declare
for (i in 1:length(exposure_vector)) {
current_exposure = db[[exposure_vector[i]]]
title = exposure_title[i]
graph_name = paste0(title,"_","Graph")
graph_name=ggplot(db,aes(x=current_exposure,y=outcome))+geom_smooth()+
theme_bw()+ylab("outcome")+xlab("exposure")+ggtitle(title)
plot[[i]] <- graph_name #write
print(graph_name)
}
I assume that you want to assign to a variable, whose name is paste0(title, "_", "Graph"), the value of the plot. If this is correct, you should use assign
library(ggplot2)
db <- data.frame(exposure = sample(1:100, 100),
exposure2 = sample(-90:100,100),
outcome = sample(200:1000,100))
exposure_vector <- c("exposure","exposure2")
exposure_title <- c("Pesticide","Apple")
for (i in 1:length(exposure_vector)) {
current_exposure <- db[[exposure_vector[i]]]
title <- exposure_title[i]
graph_name <- paste0(title,"_","Graph")
p <- ggplot(db,aes(x=current_exposure,y=outcome))+
geom_smooth()+
theme_bw()+
ylab("outcome")+
xlab("exposure")+
ggtitle(title)
assign(graph_name, p)
print(p)
}
ls()
##> [1] "Apple_Graph" "current_exposure" "db" "exposure_title"
##> [5] "exposure_vector" "graph_name" "i" "p"
##> [9] "Pesticide_Graph" "title"
I have 3 different rasters in a stack. I need to plot a panel plot and add different shapefiles on each panel. So far I managed to do the following;
## read the libraries
library(raster)
library(rgdal)
library(sp)
library(rworldmap)
library(OceanView)
##random raster object
r <- raster(ncol=40, nrow=20)
r[] <- rnorm(n=ncell(r))
# Create a RasterStack object with 3 layers
s <- stack(x=c(r, r*2, r**2))
##coordinate system
wgs<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
##reading the additional shape files
w <- spTransform(getMap(), wgs)
poly <- list(list("sp.lines", as(w, 'SpatialLines'), lwd =
0.5,col="black"))
##plotting with spplot
plot(spplot(s,layout=c(3,1),sp.layout=poly,
colorkey =list(space = "right"),
names.attr = c("a","b","c")))
so far I plotted the 3 rasters with a shapefile overlayed on it. Now I need to plot the 3 different contours one each on the panel plot. And also need to plot the windspeed arrows on each of the plot. I know to do this I need to use contour() and quiver() functions. However, I am unable to plot these.
## different raster stack for the contour plot
s1 <- stack(x=c(r/2, r*10, r**5))
##differnt wind components
lat= matrix(rep(seq(-90,90,length.out=20),each=20), ncol=20, byrow=TRUE)
lon=matrix(rep(seq(-180,180,length.out=20),each=20), ncol=20, byrow=F)
u=matrix(rep(sample(seq(-2,2,length.out=1000),20),each=20), ncol=20, byrow=TRUE)
v=matrix(rep(sample(seq(-2,2,length.out=1000),20),each=20), ncol=20, byrow=TRUE)
##plot the arrows
quiver2D(u = u,v=v,x = lon, y = lat,add=T,type="simple")
can any one help me with this? Any help would be appreciated.
First you need to figure out which function in the lattice paradigm is being called. That requires either looking at the ?spplot` help page (which I stupidly failed to do first), or following the classes and functions along the calling tree (which is what I actually did). And then look at the help page of the final function to see if there is a parameter you can pass to add contour lines:
showMethods("spplot",class="Raster", includeDefs=TRUE) # last argument need to see code
Function: spplot (package sp)
obj="Raster"
function (obj, ...)
{
.local <- function (obj, ..., maxpixels = 50000, as.table = TRUE,
zlim)
{
obj <- sampleRegular(obj, maxpixels, asRaster = TRUE,
useGDAL = TRUE)
if (!missing(zlim)) {
if (length(zlim) != 2) {
warning("zlim should be a vector of two elements")
}
if (length(zlim) >= 2) {
obj[obj < zlim[1] | obj > zlim[2]] <- NA
}
}
obj <- as(obj, "SpatialGridDataFrame")
spplot(obj, ..., as.table = as.table)
}
.local(obj, ...)
}
> showMethods("spplot",class="SpatialGridDataFrame",includeDefs=TRUE)
Function: spplot (package sp)
obj="SpatialGridDataFrame"
function (obj, ...)
spplot.grid(as(obj, "SpatialPixelsDataFrame"), ...)
> showMethods("spplot.grid",class="SpatialPixelsDataFrame",includeDefs=TRUE)
Function "spplot.grid":
<not an S4 generic function>
> spplot.grid
Error: object 'spplot.grid' not found
> getAnywhere(spplot.grid)
A single object matching ‘spplot.grid’ was found
It was found in the following places
namespace:sp
with value
function (obj, zcol = names(obj), ..., names.attr, scales = list(draw = FALSE),
xlab = NULL, ylab = NULL, aspect = mapasp(obj, xlim, ylim),
panel = panel.gridplot, sp.layout = NULL, formula, xlim = bbox(obj)[1,
], ylim = bbox(obj)[2, ], checkEmptyRC = TRUE, col.regions = get_col_regions())
{
if (is.null(zcol))
stop("no names method for object")
if (checkEmptyRC)
sdf = addNAemptyRowsCols(obj)
else sdf = as(obj, "SpatialPointsDataFrame")
if (missing(formula))
formula = getFormulaLevelplot(sdf, zcol)
if (length(zcol) > 1) {
sdf = spmap.to.lev(sdf, zcol = zcol, names.attr = names.attr)
zcol2 = "z"
}
else zcol2 = zcol
if (exists("panel.levelplot.raster")) {
opan <- lattice.options("panel.levelplot")[[1]]
lattice.options(panel.levelplot = "panel.levelplot.raster")
}
scales = longlat.scales(obj, scales, xlim, ylim)
args = append(list(formula, data = as(sdf, "data.frame"),
aspect = aspect, panel = panel, xlab = xlab, ylab = ylab,
scales = scales, sp.layout = sp.layout, xlim = xlim,
ylim = ylim, col.regions = col.regions), list(...))
if (all(unlist(lapply(obj#data[zcol], is.factor)))) {
args$data[[zcol2]] = as.numeric(args$data[[zcol2]])
if (is.null(args$colorkey) || (is.logical(args$colorkey) &&
args$colorkey) || (is.list(args$colorkey) && is.null(args$colorkey$at) &&
is.null(args$colorkey$labels))) {
if (!is.list(args$colorkey))
args$colorkey = list()
ck = args$colorkey
args$colorkey = NULL
args = append(args, colorkey.factor(obj[[zcol[1]]],
ck))
}
else args = append(args, colorkey.factor(obj[[zcol[1]]],
ck, FALSE))
}
ret = do.call(levelplot, args)
if (exists("panel.levelplot.raster"))
lattice.options(panel.levelplot = opan)
ret
}
<bytecode: 0x7fae5e6b7878>
<environment: namespace:sp>
You can see that it supports additional arguments passed via , list(...)). As it happens it's therefore fairly easy to add contour lines to a levelplot with contour=TRUE although that only appears in the Arguments list, but not in the named arguments in the Usage section for levelplot. Nonetheless testing in the example on ?levelplot page shows that it succeeds. Your example is not a particularly good one to illustrate with, since it is so fine-grained and has no pattern of ascending or descending levels. Nonetheless adding contour=TRUE, to the arguments to spplot does produce black contour lines. (The timestamp is due to lattice code in my Rprofile setup so won't show up on your device).
png(); plot(spplot(s,layout=c(3,1),sp.layout=poly, contour=TRUE,
colorkey =list(space = "right"),
names.attr = c("a","b","c"))) ; dev.off()
If one gets around to hacking spplot.grid or perhaps sp::panel.gridplot, then this material from the author of levelplot might be of use:
https://markmail.org/search/?q=list%3Aorg.r-project.r-help+lattice+add+contours+to+levelplot#query:list%3Aorg.r-project.r-help%20lattice%20add%20contours%20to%20levelplot%20from%3A%22Deepayan%20Sarkar%22+page:1+mid:w7q4l7dh6op2lfmt+state:results
I am using RSSA package in R and I need to access the eigenvalues.
using the following code I can plot the components. However, I need to access all eigenvalues as numbers.
require(Rssa)
t=ssa(co2)
plot(t)
I know almost nothing about this package. I'm taking from context that you want the values that are plotted on the y-axis of that graphic. Lacking a reproducible example, I turn to the ?ssa help page and use the first example:
> s <- ssa(co2)
>
> plot(s)
So that looks like your plot: Then I look at the code
> getAnywhere(plot.ssa)
A single object matching ‘plot.ssa’ was found
It was found in the following places
registered S3 method for plot from namespace Rssa
namespace:Rssa
with value
function (x, type = c("values", "vectors", "paired", "series",
"wcor"), ..., vectors = c("eigen", "factor"), plot.contrib = TRUE,
numvalues = nsigma(x), numvectors = min(nsigma(x), 10), idx = 1:numvectors,
idy, groups)
{
type <- match.arg(type)
vectors <- match.arg(vectors)
if (identical(type, "values")) {
.plot.ssa.values(x, ..., numvalues = numvalues)
}
else if (identical(type, "vectors")) {
.plot.ssa.vectors(x, ..., what = vectors, plot.contrib = plot.contrib,
idx = idx)
}
else if (identical(type, "paired")) {
if (missing(idy))
idy <- idx + 1
.plot.ssa.paired(x, ..., what = vectors, plot.contrib = plot.contrib,
idx = idx, idy = idy)
}
else if (identical(type, "series")) {
if (missing(groups))
groups <- as.list(1:min(nsigma(x), nu(x)))
.plot.ssa.series(x, ..., groups = groups)
}
else if (identical(type, "wcor")) {
if (missing(groups))
groups <- as.list(1:min(nsigma(x), nu(x)))
plot(wcor(x, groups = groups), ...)
}
else {
stop("Unsupported type of SSA plot!")
}
}
<environment: namespace:Rssa>
So then I look at the function called when the default arguments are used:
> getAnywhere(.plot.ssa.values)
A single object matching ‘.plot.ssa.values’ was found
It was found in the following places
namespace:Rssa
with value
function (x, ..., numvalues, plot.type = "b")
{
dots <- list(...)
d <- data.frame(A = 1:numvalues, B = x$sigma[1:numvalues])
dots <- .defaults(dots, type = plot.type, xlab = "Index",
ylab = "norms", main = "Component norms", grid = TRUE,
scales = list(y = list(log = TRUE)), par.settings = list(plot.symbol = list(pch = 20)))
do.call("xyplot", c(list(x = B ~ A, data = d, ssaobj = x),
dots))
}
<environment: namespace:Rssa>
So the answer appears to be:
s$sigma
[1] 78886.190749 329.031810 327.198387 184.659743 88.695271 88.191805
[7] 52.380502 40.527875 31.329930 29.409384 27.157698 22.334446
[13] 17.237926 14.175096 14.111402 12.976716 12.943775 12.216524
[19] 11.830642 11.614243 11.226010 10.457529 10.435998 9.774000
[25] 9.710220 9.046872 8.995923 8.928725 8.809155 8.548962
[31] 8.358872 7.699094 7.266915 7.243014 7.164837 6.203210
[37] 6.085105 6.064150 6.035110 6.028446 5.845783 5.808865
[43] 5.770708 5.753422 5.680897 5.672330 5.650324 5.612606
[49] 5.599314 5.572931
I tried to use rChart's rNVD3 package's discrete bar plot instead of the same old ggplot2. But it's requiring some formula argument as a first argument. I've not used lattice package and I don't know how to create one.
Here's my data frame:
df <- data.frame(
Pupil = factor(c("Richy","Shyam","Nithin"), levels=c("Richy","Shyam","Nithin")),
Scores = c(75,93,62)
)
Code I used to render the plot:
require(rNVD3)
bar1 <- nvd3Plot(x = "Pupil", y = "Scores", data = df, type = "discreteBarChart", width = 600)
bar1$printChart("chart1")
This is what the error is:
Error in lattice::latticeParseFormula(x, data = data) :
model must be a formula object
When I tried to rectify the error:
bar1<-nvd3Plot(Scores ~ Pupil, data = df, type = "discreteBarChart", width = 600)
bar1$printChart("chart1")
It just showed the .js code but not the barchart.
<div id='chart1' class='nvd3Plot'></div>
<script type='text/javascript'>
drawchart1()
function drawchart1(){
var opts = {"id":"chart1","yAxis":[],"x":"Pupil","y":"Scores","type":"discreteBarChart","width":600,"height":400},
data = [{"Pupil":"Richy","Scores":75},{"Pupil":"Shyam","Scores":93},{"Pupil":"Nithin","Scores":62}]
var data = d3.nest()
.key(function(d){
return opts.group === undefined ? 'main' : d[opts.group]
})
.entries(data)
nv.addGraph(function() {
var chart = nv.models[opts.type]()
.x(function(d) { return d[opts.x] })
.y(function(d) { return d[opts.y] })
.width(opts.width)
.height(opts.height)
d3.select("#" + opts.id)
.append('svg')
.datum(data)
.transition().duration(500)
.call(chart);
nv.utils.windowResize(chart.update);
return chart;
});
};
</script>
rCharts can be a little confusing sometimes due to its use of reference classes. You are very close. First install rCharts. Then, instead of nvd3Plot, use nPlot as shown below. Also, you might be interested in htmlwidgets.
library(rCharts)
df <- data.frame(
Pupil = factor(c("Richy","Shyam","Nithin"), levels=c("Richy","Shyam","Nithin")),
Scores = c(75,93,62)
)
# without formula interface
nPlot(
x = "Pupil", y = "Scores", data = df,
type = "discreteBarChart", width = 600
)
# with formula interface
nPlot(Scores~Pupil, data = df, type = "discreteBarChart", width = 600)
I have made a function that can plot the loadings from many factor analyses at once, also when their variables do not overlap perfectly (or at all). It works fine, except that it generates a number of "duplicated levels in factors are deprecated" warning, and I don't understand why.
The code allow should be reproducible.
library(devtools)
source_url("https://raw.githubusercontent.com/Deleetdk/psych2/master/psych2.R")
loadings.plot2 = function(fa.objects, fa.names="") {
fa.num = length(fa.objects) #number of fas
if (fa.names=="") {
fa.names = str_c("fa.", 1:fa.num)
}
if (length(fa.names) != fa.num) {
stop("Names vector does not match the number of factor analyses.")
}
#merge into df
d = data.frame() #to merge into
for (fa.idx in 1:fa.num) { #loop over fa objects
loads = fa.objects[[fa.idx]]$loadings
rnames = rownames(loads)
loads = as.data.frame(as.vector(loads))
rownames(loads) = rnames
colnames(loads) = fa.names[fa.idx]
d = merge.datasets(d, loads, 1)
}
#reshape to long form
d2 = reshape(d,
varying = 1:fa.num,
direction="long",
ids = rownames(d))
d2$time = as.factor(d2$time)
d2$id = as.factor(d2$id)
print(d2)
print(levels(d2$time))
print(levels(d2$id))
#plot
g = ggplot(reorder_by(id, ~ fa, d2), aes(x=fa, y=id, color=time)) +
geom_point() +
xlab("Loading") + ylab("Indicator") +
scale_color_discrete(name="Analysis",
labels=fa.names)
return(g)
}
fa1 = fa(iris[-5])
fa2 = fa(iris[-c(1:50),-5])
fa3 = fa(ability)
fa4 = fa(ability[1:50,])
loadings.plot2(list(fa1))
loadings.plot2(list(fa1,fa2))
loadings.plot2(list(fa1,fa2,fa3))
loadings.plot2(list(fa1,fa2,fa3,fa4))
Plotting different numbers of factors give different numbers of errors.
I have tried setting the variables as.factor before giving them to ggplot, but it didn't change anything.
Any ideas? Perhaps related to reorder_by()? This function is needed to sort the data.frame, otherwise ggplot sorts them alphabetically, which is useless.
As mentioned in the comments, this warning is caused by using the reorder_by() function but only in conjunction with ggplot2. Specifically, the levels are for some reason duplicated:
#> levels(d2$id)
[1] "Sepal.Width" "Sepal.Width" "Sepal.Length" "Sepal.Length" "Petal.Width" "Petal.Width" "Petal.Length"
[8] "Petal.Length"
ggplot2 does not like duplicate levels, and so gives the warning.
In case anyone is interested, I wrote new code to do the re-leveling myself to avoid this problem and to avoid the dependency on the plotflow package.
The new function is this:
#' Plot multiple factor loadings in one plot.
#'
#' Returns a ggplot2 plot with sorted loadings colored by the analysis they belong to. Supports reversing óf any factors that are reversed. Dodges to avoid overplotting. Only works for factor analyses with 1 factor solutions!
#' #param fa_objects (list of fa-class objects) Factor analyses objects from the fa() function from the \code{\link{psych}} package.
#' #param fa_labels (chr vector) Names of the analyses. Defaults to fa.1, fa.2, etc..
#' #param reverse_vector (num vector) Vector of numbers to use for reversing factors. Use e.g. c(1, -1) to reverse the second factor. Defaults not reversing.
#' #param reorder (chr scalar or NA) Which factor analysis to order the loadings by. Can be integers that reprensent each factor analysis. Can also be "mean", "median" to use the means and medians of the loadings. Use "all" for the old method. Default = "mean".
#' #export
#' #examples
#' library(psych)
#' plot_loadings_multi(fa(iris[-5])) #extract a factor and reverse
plot_loadings_multi = function (fa_objects, fa_labels, reverse_vector = NA, reorder = "mean") {
library("stringr")
library("ggplot2")
library("plyr")
fa_num = length(fa_objects)
fa_names = str_c("fa.", 1:fa_num)
if (!is.list(fa_objects)) {
stop("fa_objects parameter is not a list.")
}
if (class(fa_objects) %in% c("psych", "fa")) {
fa_objects = list(fa_objects)
fa_num = length(fa_objects)
fa_names = str_c("fa.", 1:fa_num)
}
if (missing("fa_labels")) {
if (!is.null(names(fa_objects))) {
fa_labels = names(fa_objects)
}
else {
fa_labels = fa_names
}
}
if (length(fa_labels) != fa_num) {
stop("Factor analysis labels length is not identical to number of analyses.")
}
if (all(is.na(reverse_vector))) {
reverse_vector = rep(1, fa_num)
}
else if (length(reverse_vector) != fa_num) {
stop("Length of reversing vector does not match number of factor analyses.")
}
d = data.frame()
for (fa.idx in 1:fa_num) {
loads = fa_objects[[fa.idx]]$loadings * reverse_vector[fa.idx]
rnames = rownames(loads)
loads = as.data.frame(as.vector(loads))
rownames(loads) = rnames
colnames(loads) = fa_names[fa.idx]
suppressor({
d = merge_datasets(d, loads, 1)
})
}
d2 = reshape(d, varying = 1:fa_num, direction = "long", ids = rownames(d))
d2$time = as.factor(d2$time)
d2$id = as.factor(d2$id)
colnames(d2)[2] = "fa"
#reorder factor?
if (!is.na(reorder)) {
if (reorder == "all") {
library("plotflow")
silence({
d2 = reorder_by(id, ~fa, d2)
})
} else if (reorder == "mean") {
v_aggregate_values = daply(d2, .(id), function(x) {
mean(x$fa)
})
#re-level
d2$id = factor(d2$id, levels = names(sort(v_aggregate_values, decreasing = F)))
} else if (reorder == "median") {
v_aggregate_values = daply(d2, .(id), function(x) {
median(x$fa)
})
#re-level
d2$id = factor(d2$id, levels = names(sort(v_aggregate_values, decreasing = F)))
} else {
d2_sub = d2[d2$time == reorder, ] #subset the analysis whose loading is to be used for the reorder
silence({
d2_sub = reorder_by(id, ~fa, d2_sub)
})
library(gdata)
d2$id = reorder.factor(d2$id, new.order = levels(d2_sub$id))
}
}
#plot
g = ggplot(d2, aes(x = id, y = fa, color = time, group = time)) +
geom_point(position = position_dodge(width = 0.5)) +
ylab("Loading") + xlab("Indicator") + scale_color_discrete(name = "Analysis",
labels = fa_labels) + coord_flip()
return(g)
}
library(psych)
fa_1 = fa(iris[-5])
fa_2 = fa(iris[1:125, -5])
plot_loadings_multi(list(fa_1, fa_2), reorder = "mean")
Which produces the following plot without warnings:
The code is from my personal package.