accessing eigenvalues in RSSA package in R - r

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

Related

Cant save ggplot graphs while using a loop in R

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"

RC class method to generate two plots with ggplot2

I have a RC-class with a plot method in r.
I have written code to run ggplot() twice, but it will only plot the latest one called. Any suggestions on why this is happening/how to fix it?
Below is an example of my structure.
testClass <- setRefClass("testClass",
fields = list(
x = "numeric",
y = "numeric"
),
methods = list(
initialize = function(x, y) {
.self$x = x
.self$y = y
},
plot = function() {
ggplot2::ggplot(...)
ggplot2::ggplot(...)
}))

How to change plotting parameters of a function within a wrapper (R)

I'm trying to generate heatmaps by using cellrangerRkit package. The function within this package refers to pheatmap function featured in pheatmap library as seen below:
gbm_pheatmap
function (gbm, genes_to_plot, cells_to_plot, n_genes = 5, colour = NULL,
limits = c(-3, 3))
{
if (!is.list(genes_to_plot)) {
cat("Plotting one gene set instead of multiple cluster-specific gene sets\n")
gene_indices <- sapply(genes_to_plot, function(x) get_gene_index(gbm,
x))
gene_annotation <- NULL
}
else {
if ("significant" %in% names(genes_to_plot[[1]])) {
gene_indices <- unlist(lapply(genes_to_plot, function(x) with(x,
head(ix[significant], n_genes))))
gene_grouping <- unlist(lapply(names(genes_to_plot),
function(nm) rep(nm, with(genes_to_plot[[nm]],
length(head(ix[significant], n_genes))))))
}
else {
gene_indices <- unlist(lapply(genes_to_plot, function(x) x$ix[1:n_genes]))
gene_grouping <- rep(names(genes_to_plot), each = n_genes)
}
gene_annotation <- data.frame(ClusterID = as.factor(gene_grouping))
}
cell_indices <- unlist(lapply(cells_to_plot, function(x) x$ix))
value <- t(scale(t(as.matrix(exprs(gbm))[gene_indices, cell_indices])))
value[value < limits[1]] <- limits[1]
value[value > limits[2]] <- limits[2]
rownames(value) <- make.unique(fData(gbm)$symbol[gene_indices])
cell_grouping <- unlist(lapply(1:length(cells_to_plot), function(x) {
rep(names(cells_to_plot)[x], length(cells_to_plot[[x]]$barcode))
}))
cell_annotation <- data.frame(ClusterID = as.factor(cell_grouping))
rownames(cell_annotation) <- colnames(value)
if (!is.null(gene_annotation)) {
rownames(gene_annotation) <- rownames(value)
}
if (is.null(colour)) {
anno_colors <- NULL
}
else {
names(colour) <- names(cells_to_plot)
anno_colors <- list(ClusterID = colour)
}
pheatmap(value, cluster_rows = FALSE, cluster_cols = FALSE,
show_colnames = FALSE, annotation_row = gene_annotation,
annotation_col = cell_annotation, annotation_names_row = FALSE,
annotation_names_col = FALSE, annotation_colors = anno_colors)
}
<bytecode: 0x00000000507b7970>
<environment: namespace:cellrangerRkit>
My problem is that, when I plot my heatmap, the annotation on the right side of the plot is overlapping due to large font size (see below)
The wrapper function gbm_heatmap doesn't have a fontsize option, preventing me from simply passing an argument when calling it. How I can change the plotting behavior within this wrapper?
Appreciate all the input, thanks!

How can I add text to a network plot in R?

I am using the package networkDynamic to visualise two evolving networks and I would like to add, close to each network a simple legend (a few words of text). I can't find a way of doing this.
In the networkDynamic package, the function render.animation uses plot.network (from the package network) to render each frame and then compiles the different frames into an animation.
The plot.network arguments can be passed to render.animation, so the problem seems to boils down to adding text to a plot generated with plot.network but there doesn't seem to be a way of adding text at specified coordinates.
With a normal plot I would use the text function, but is there a way of including this function into the plot.network arguments?
render.animation is a function in the ndtv package. You will have to create a custom render.animation2 function based on render.animation. In the following function, I add an extra line to the render.animation function. I add an mtext after each plot.network calls (see about 20 lines from the end). You could change it to a text instead of mtext.
render.animation2 <- function (net, render.par = list(tween.frames = 10, show.time = TRUE,
show.stats = NULL, extraPlotCmds = NULL, initial.coords = 0),
plot.par = list(bg = "white"), ani.options = list(interval = 0.1),
render.cache = c("plot.list", "none"), verbose = TRUE, ...)
{
if (!is.network(net)) {
stop("render.animation requires the first argument to be a network object")
}
if (is.null(render.par)) {
stop("render.animation is missing the 'render.par' argument (a list of rendering parameters).")
}
if (is.null(render.par$tween.frames)) {
render.par$tween.frames <- 10
}
if (is.null(render.par$show.time)) {
render.par$show.time <- TRUE
}
if (is.null(render.par$initial.coords)) {
render.par$initial.coords <- matrix(0, ncol = 2, nrow = network.size(net))
}
if (!all(c("animation.x.active", "animation.y.active") %in%
list.vertex.attributes(net))) {
net <- compute.animation(net, verbose = verbose)
}
externalDevice <- FALSE
doRStudioHack <- TRUE
if (!is.null(render.par$do_RStudio_plot_hack)) {
doRStudioHack <- render.par$do_RStudio_plot_hack
}
if (!is.function(options()$device)) {
if (names(dev.cur()) == "RStudioGD" & doRStudioHack) {
message("RStudio's graphics device is not well supported by ndtv, attempting to open another type of plot window")
if (.Platform$OS.type == "windows") {
windows()
}
else if (length(grep(R.version$platform, pattern = "apple")) >
0) {
quartz()
}
else {
x11()
}
externalDevice <- TRUE
}
}
if (par("bg") == "transparent" & is.null(plot.par$bg)) {
plot.par$bg <- "white"
}
origPar <- par(plot.par)
oopts <- ani.options(ani.options)
slice.par <- get.network.attribute(net, "slice.par")
if (is.null(slice.par)) {
stop("render.animation can not locate the 'slice.par' list of parameters in the input network object")
}
render.cache <- match.arg(render.cache)
plot_params <- list(...)
if (is.null(plot_params$label)) {
plot_params$label <- function(slice) {
network.vertex.names(slice)
}
}
if (is.null(plot_params$xlab) & render.par$show.time) {
plot_params$xlab <- function(onset, terminus) {
ifelse(onset == terminus, paste("t=", onset, sep = ""),
paste("t=", onset, "-", terminus, sep = ""))
}
}
if (!is.null(render.par$show.stats) && render.par$show.stats !=
FALSE) {
if (render.par$show.time) {
plot_params$xlab <- eval(parse(text = paste("function(slice,onset,terminus){stats<-summary.statistics.network(slice",
render.par$show.stats, ")\n return(paste('t=',onset,'-',terminus,' ',paste(rbind(names(stats),stats),collapse=':'),sep='')) }",
sep = "")))
}
else {
plot_params$xlab <- eval(parse(text = paste("function(slice){stats<-summary.statistics.network(slice",
render.par$show.stats, ")\n return(paste(rbind(names(stats),stats),collapse=':')) }",
sep = "")))
}
}
if (is.null(plot_params$jitter)) {
plot_params$jitter <- FALSE
}
interp.fun <- coord.interp.smoothstep
starts <- seq(from = slice.par$start, to = slice.par$end,
by = slice.par$interval)
ends <- seq(from = slice.par$start + slice.par$aggregate.dur,
to = slice.par$end + slice.par$aggregate.dur, by = slice.par$interval)
xmin <- aggregate.vertex.attribute.active(net, "animation.x",
min)
xmax <- aggregate.vertex.attribute.active(net, "animation.x",
max)
ymin <- aggregate.vertex.attribute.active(net, "animation.y",
min)
ymax <- aggregate.vertex.attribute.active(net, "animation.y",
max)
if (is.null(plot_params$xlim)) {
if (xmin == xmax) {
xmax <- xmin + 1
xmin <- xmin - 1
}
plot_params$xlim <- c(xmin, xmax)
}
if (is.null(plot_params$ylim)) {
if (ymin == ymax) {
ymax <- ymin + 1
ymin <- ymin - 1
}
plot_params$ylim <- c(ymin, ymax)
}
if (is.numeric(render.par$initial.coords)) {
coords <- matrix(render.par$initial.coords, ncol = 2,
nrow = network.size(net))
}
slice <- network.collapse(net, starts[1], ends[1], rule = slice.par$rule,
rm.time.info = FALSE)
activev <- is.active(net, starts[1], ends[1], v = seq_len(network.size(net)),
rule = if (slice.par$rule != "all") {
"any"
})
if (length(slice) > 0 & network.size(slice) > 0) {
coords[activev, 1] <- get.vertex.attribute(slice, "animation.x")
coords[activev, 2] <- get.vertex.attribute(slice, "animation.y")
}
coords2 <- coords
if (render.cache == "plot.list") {
ani.record(reset = TRUE)
}
for (s in 1:length(starts)) {
if (verbose) {
print(paste("rendering", render.par$tween.frames,
"frames for slice", s - 1))
}
slice <- network.collapse(net, starts[s], ends[s], rule = slice.par$rule,
rm.time.info = FALSE)
activev <- is.active(net, starts[s], ends[s], v = seq_len(network.size(net)),
rule = if (slice.par$rule != "all") {
"any"
})
if (length(slice) > 0 & network.size(slice) > 0) {
evald_params <- .evaluate_plot_params(plot_params = plot_params,
net = net, slice = slice, s = s, onset = starts[s],
terminus = ends[s])
for (t in 1:render.par$tween.frames) {
coords2[activev, 1] <- get.vertex.attribute(slice,
"animation.x")
coords2[activev, 2] <- get.vertex.attribute(slice,
"animation.y")
tweenCoords <- interp.fun(coords, coords2, t,
render.par$tween.frames)
plot_args <- list(x = slice, coord = tweenCoords[activev,
, drop = FALSE])
plot_args <- c(plot_args, evald_params)
do.call(plot.network, plot_args)
mtext("my text\n on two lines", side = 3) #my.legend
if (!is.null(render.par$extraPlotCmds)) {
eval(render.par$extraPlotCmds)
}
if (render.cache == "plot.list") {
ani.record()
}
}
coords <- coords2
}
else {
evald_params <- .evaluate_plot_params(plot_params = plot_params,
net = net, slice = slice, s = s, onset = starts[s],
terminus = ends[s])
if (render.par$show.time) {
xlab <- evald_params$xlab
}
else {
xlab <- NULL
}
singlenet <- network.initialize(1)
for (t in 1:render.par$tween.frames) {
plot.network(singlenet, vertex.cex = 0, xlab = xlab)
if (!is.null(render.par$extraPlotCmds)) {
eval(render.par$extraPlotCmds)
}
if (render.cache == "plot.list") {
ani.record()
}
}
}
}
par(origPar)
if (externalDevice) {
dev.off()
}
}
It is then important to assign your new function render.animation2 to the ndtv namespace. If you don't, it will crash because render.animation refers to functions that can only be found in its own namespace.
environment(render.animation2) <- asNamespace('ndtv')
environment(render.animation) #<environment: namespace:ndtv>
environment(render.animation2) #<environment: namespace:ndtv>
Using, render.animation2, you will then get your legend printed on each slide of the animation.
require(ndtv)
triangle <- network.initialize(3) # create a toy network
add.edge(triangle,1,2)
# add an edge between vertices 1 and 2
add.edge(triangle,2,3)
# add a more edges
activate.edges(triangle,at=1) # turn on all edges at time 1 only
activate.edges(triangle,onset=2, terminus=3,
e=get.edgeIDs(triangle,v=1,alter=2))
add.edges.active(triangle,onset=4, length=2,tail=3,head=1)
render.animation2(triangle) #custom function
ani.replay()
Here's what the last slide looks like in the animation:
If you only need to add a few lines of text, you can pass the standard plot arguments main (for the main title) or xlab (for the x-axis caption). you can separate lines with the newline escape "\n"
library(ndtv)
data(short.stergm.sim)
render.animation(short.stergm.sim,main='hello\nworld')
It is also possible to plot other graphic elements (such as legend or text or maps) using the extraPlotCmds argument to render.animation. For example, if you wanted to plot "hello world" in blue at coordiantes 0,0 using text you can wrap it in an expression and pass it in via render.par
render.animation(short.stergm.sim,
render.par=list(extraPlotCmds=expression(
text(0,0,'hello\nworld',col='blue')
))
)
the extra plot command will evaluated on each frame as the network is rendered

Many "duplicated levels in factors are deprecated" warning with ggplot2

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.

Resources