I am trying to run a sem with a random effect in piecewiseSEM. My model runs with no error, and sem.fit() also runs with no error or warnings. However, when I run sem.coefs() I get the following warning:
1: In if (grepl("cbind", deparse(formula(x)))) all.vars(formula(x))[-c(1:2)] else all.vars(formula(x)) :
the condition has length > 1 and only the first element will be used
Any ideas what this warning is about or what it means? Given it's a warning and not an error, the code still runs and give me estimates, but can I trust the estimates?
Thanks!
EDIT
#code:
library(piecewiseSEM)
library(nlme)
avg.forb<-list( lme(nitrogen_variation~nat+impervious+precip.variation,random=~1|site/species,control = lmeControl(opt = "optim"),forb), lme(po4_variation~nat+impervious+precip.variaton,random=~1|site/species,control = lmeControl(opt = "optim"),forb),
lme(nitrogen~nat +impervious+precip.variation,random=~1|site/species,control = lmeControl(opt = "optim"), forb),
lme(po4 ~nat +impervious+precip.variation,random=~1|site/species,control = lmeControl(opt = "optim"),forb), lme(avg.height~nat+impervious+po4+po4_variation+nitrogen+nitrogen_variation+precip.variation+n_i, random=~1|site/species,control =lmeControl(opt="optim"),forb), lme(avg.culms~nat+impervious+po4+po4_variation+nitrogen+nitrogen_variation+precip.variation+n_i,random=~1|site/species,control = lmeControl(opt = "optim"), forb), lme(avg.chloro~nat+impervious+po4+po4_variation+nitrogen+nitrogen_variation+precip.variation+n_i,random=~1|site/species, control =lmeControl(opt="optim"),forb), lme(avg.sla~nat+impervious+po4+po4_variation+nitrogen+nitrogen_variation+precip.variation+n_i,random=~1|site/species, control = lmeControl(opt = "optim"),forb))
sem.fit(avg.forb, conditional=T, forb) #this code gives the above error message
#data subset:
structure(list(site = structure(c(1L, 1L, 1L, 2L, 2L, 3L), .Label = c("Baker", "Cronkelton", "Delaware"), class = "factor"), species = structure(c(1L, 4L, 6L, 2L, 3L, 5L), .Label = c("apocynum cannabinum", "aster ericoides", "aster lanceolatus var. interior", "cirsium arvense", "impatiens capensis", "typha angustifolia"), class = "factor"), n_i = structure(c(2L,
1L, 1L, 2L, 2L, 2L), .Label = c("i", "n"), class = "factor"),nat=structure(c(1L, 1L, 1L, 1L, 1L, 2L), .Label = c("1", "2"), class = "factor"), impervious = structure(c(2L, 2L, 2L, 1L, 1L, 1L), .Label = c("1", "2"), class = "factor"), precip_variation = c(70.24882178, 70.24882178, 70.24882178, 21.92460821, 21.92460821, 18.90115299), po4 = c(-2.203425667,
-2.204119983, -2.20481541, -1.845271793, -1.844967771, -2.417936637), po4_variation = c(0.8011, 0.801, 0.8009, 0.4839, 0.484, 0.5229), nitrogen = c(0.00627, 0.00626, 0.00625, 0.00432, 0.00433, 0.01018), nitrogen_variation = c(0.7739, 0.7738, 0.7737, 0.5435, 0.5436, -0.1251), avg.height = c(99.1, 113.5559506, 191.4111012, 73.72222025, 35.42222025, 59.52222025), avg.culms = c(0.492915384, 0.78612011, 0.884606749, 0.96483549, 0.819543936, 0.831087338), avg.sla = c(179.3510333, 149.0332471, 68.77888941, 334.2177912, 798.7581389, 443.2005556), avg.chloro = c(0.900670513, 0.790832282, 0.965532685, 0.565585484, 1.106203493, 0.970209082)), .Names = c("site", "species", "n_i", "nat", "impervious", "precip_variation", "po4", "po4_variation", "nitrogen", "nitrogen_variation", "avg.height", "avg.culms", "avg.sla", "avg.chloro"), row.names = c(NA, 6L), class = "data.frame")
Related
I am applying the apriori algorithm in R with the database structured as followed (in dput()):
structure(list(Firm.s.global.reorganization = structure(c(1L,
2L, 1L, 2L, 2L), .Label = c("no", "yes"), class = "factor"),
Delivery.time = structure(c(1L, 1L, 1L, 1L, 1L), .Label = c("no",
"yes"), class = "factor"), Automation.of.production.process = structure(c(2L,
1L, 2L, 1L, 1L), .Label = c("no", "yes"), class = "factor"),
Poor.quality.of.offshored.production = structure(c(1L, 1L,
1L, 1L, 1L), .Label = c("no", "yes"), class = "factor"),
Made.in.effect = structure(c(1L, 1L, 1L, 1L, 1L), .Label = c("no",
"yes"), class = "factor"), Proximity.to.customers = structure(c(1L,
1L, 1L, 1L, 1L), .Label = c("no", "yes"), class = "factor")), row.names = c(NA,
5L), class = "data.frame")
When I run my code I only want values to return that have a "yes" value, thus I use the following code:
rules7 <- apriori(data4, parameter = list(support = 0.05,confidence = 0.5, maxlen=5), appearance=list(rhs=c("Firm.s.global.reorganization=yes"),
lhs=c("Delivery.time=yes",
"Automation.of.production.process=yes",
"Poor.quality.of.offshored.production=yes",
"Made.in.effect=yes",
"Proximity.to.customers=yes",
"Implementation.of.strategies.based.on.product.process.innovation=yes",
"Untapped.production.capacity=yes",
"Know.how.in.the.home.country=yes",
"Change.in.total.costs.of.sourcing=yes",
"Logistics.costs=yes",
"Need.for.greater.organizational.flexibility=yes",
"Economic.crisis=yes",
"Improve.customer.service=yes",
"Labour.costs..gap.reduction=yes",
"Government.support.to.relocation=yes",
"Proximity.to.suppliers=yes",
"Loyalty.to.the.home.country=yes"),default="lhs"))
But the results I keep receiving include:
lhs rhs support confidence coverage lift count
[1] {Made.in.effect=no,
Untapped.production.capacity=no,
Economic.crisis=yes} => {Firm.s.global.reorganization=yes} 0.02521008 1.0000000 0.02521008 3.838710 6
even though I explicitly used "Made.in.effect=yes" in my code to avoid the "no's".
How can I make sure I only receive "yes" results on both lhs and rhs?
Thanks!
well already fixed it.
Incase someone struggles with it in the future:
change the default to:
default="none"))
This is not so much a coding as general approach call for help ;-) I prepared a table containing taxonomic information about organisms. But I want to use the "names" of these organisms, so no values or anything where you could compute a distance or clustering with (this is also all the information I have). I just want to use these factors to create a plot that shows the relationship. My data looks like this:
test2<-structure(list(genus = structure(c(4L, 2L, 7L, 8L, 6L, 1L, 3L,
5L, 5L), .Label = c("Aminobacter", "Bradyrhizobium", "Hoeflea",
"Hyphomonas", "Mesorhizobium", "Methylosinus", "Ochrobactrum",
"uncultured"), class = "factor"), family = structure(c(4L, 1L,
2L, 3L, 5L, 6L, 6L, 6L, 6L), .Label = c("Bradyrhizobiaceae",
"Brucellaceae", "Hyphomicrobiaceae", "Hyphomonadaceae", "Methylocystaceae",
"Phyllobacteriaceae"), class = "factor"), order = structure(c(1L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Caulobacterales",
"Rhizobiales"), class = "factor"), class = structure(c(1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "Alphaproteobacteria", class = "factor"),
phylum = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "Proteobacteria", class = "factor")), .Names = c("genus",
"family", "order", "class", "phylum"), class = "data.frame", row.names = c(NA,
9L))
is it necessary to set up artificial values to describe a distance between the levels?
Here is an attempt using data.tree library
First create a string variable in the form:
Proteobacteria/Alphaproteobacteria/Caulobacterales/Hyphomonadaceae/Hyphomonas
library(data.tree)
test2$pathString <- with(test2,
paste(phylum,
class,
order,
family,
genus, sep = "/"))
tree_test2 = as.Node(test2)
plot(tree_test2)
many things can be done after like:
Interactive network:
library(networkD3)
test2_Network <- ToDataFrameNetwork(tree_test2, "name")
simpleNetwork(test2_Network)
or graph styled
library(igraph)
plot(as.igraph(tree_test2, directed = TRUE, direction = "climb"))
check out the vignette
using ggplot2:
library(ggraph)
graph = as.igraph(tree_test2, directed = TRUE, direction = "climb")
ggraph(graph, layout = 'kk') +
geom_node_text(aes(label = name))+
geom_edge_link(arrow = arrow(type = "closed", ends = "first",
length = unit(0.20, "inches"),
angle = 15)) +
geom_node_point() +
theme_graph()+
coord_cartesian(xlim = c(-3,3), expand = TRUE)
or perhaps:
ggraph(graph, layout = 'kk') +
geom_node_text(aes(label = name), repel = T)+
geom_edge_link(angle_calc = 'along',
end_cap = circle(3, 'mm'))+
geom_node_point(size = 5) +
theme_graph()+
coord_cartesian(xlim = c(-3,3), expand = TRUE)
I am constructing GLMMs (using glmer() of "lme4" R package) and sometimes I get an error when estimating R2 values (using r.squaredGLMM() from "MuMIn" package).
The model I am trying to fit is simmilar to this one:
library(lme4)
lmA <- glmer(x~y+(1|w)+(1|w/k), data = data1, family = binomial(link="logit"))
Then, to estime R2, I use:
library(MuMIn)
r.squaredGLMM(lmA)
And I get this:
The result is correct only if all data used by the model has not changed since model was fitted. Error in .rsqGLMM(fam = family(x),
varFx = var(fxpred), varRe = varRe, : 'names' attribute [2] must be the same length as the vector [0]
Do you have any idea why this error appears? For instance, If I use only a single random factor (in this case, (1|w)) this error does not appear.
Here is my dataset:
data1 <-
structure(list(w = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L,
1L, 2L, 1L), .Label = c("CA", "CB"), class = "factor"), k = structure(c(4L,
4L, 3L, 3L, 3L, 4L, 1L, 3L, 2L, 3L, 2L), .Label = c("CAF01-CAM01",
"CAM01", "CBF01-CBM01", "CBM01"), class = "factor"), x = c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L), y = c(-0.034973549,
0.671720643, 4.557044729, 5.347170897, 2.634240583, -0.555740207,
4.118277809, 2.599825716, 0.95853864, 4.327804344, 0.057331718
)), .Names = c("w", "k", "x", "y"), class = "data.frame", row.names = c(NA,
-11L))
Any thoughts?
This was a bug that has been fixed in version >= 1.15.8 (soon on CRAN, currently on R-Forge).
I have this data frame. It is a very small subset of my actual data frame but the column names everything else is the same:
This is the data frame that has the data:
dput(p)
structure(list(Hostname = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("server101",
"server102", "server103", "server104", "test101", "app101d",
"web25", "web26", "web111", "web11", "web123", "tomcat101", "tomcat103",
"tomcat104"), class = "factor"), Date = structure(c(1441373431,
1441372531, 1441737938, 1441337431, 1441374331, 1441367131), class = c("POSIXct",
"POSIXt"), tzone = ""), Cpubusy = c(22, 21, 20, 28, 22, 20),
UsedPercentMemory = c(3L, 3L, 21L, 3L, 3L, 4L), App = structure(c(1L,
1L, 1L, 1L, 1L, 1L), .Label = c("WEB", "DB"), class = "factor"),
HA = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("server3456",
"backup101", "ha123", "No HA Host", "No HA Host", "server120",
"server234", "server666", "No HA Host"), class = "factor"),
DR = structure(c(5L, 5L, 5L, 5L, 5L, 5L), .Label = c("Cannot login to DR Host",
"dr101", "dr345", "dr444", "dr5678", "No DR Host", "drserver11",
"dr666", "No HA Host", "No HA Host", "No HA Host"), class = "factor")), .Names = c("Hostname",
"Date", "Cpubusy", "UsedPercentMemory", "App", "HA", "DR"), row.names = c(NA,
6L), class = "data.frame")
This is my applition server mapping data frame:
dput(c)
structure(list(App = structure(c(1L, 2L, 2L, 2L, 2L, 1L), .Label = c("WEB",
"APP"), class = "factor"), Prod = structure(c(1L, 5L, 6L, 4L,
3L, 2L), .Label = c("server101", "server102", "server104", "server106",
"server107", "server109"), class = "factor"), HA = structure(c(1L,
3L, 3L, 3L, 3L, 2L), .Label = c("server3456", "server3456", "No HA Host"
), class = "factor"), DR = structure(c(1L, 2L, 2L, 2L, 2L, 3L
), .Label = c("dr5678", "No DR Host", "No DR Host"), class = "factor")), .Names = c("App",
"Prod", "HA", "DR"), row.names = c(NA, 6L), class = "data.frame")
This is just a small subset of data. I am trying to run knitr to export my analysis to pdf file as follows:
application<-unique(c$App, drop=TRUE)
application<-droplevels(application)
metrics<-unique(colnames(pp[,c(3:4)]))
env<-unique(colnames(c[,c(2:4)]))
I have this chunk in knitr to create charts in each section:
```{r qplot,fig.width=10, fig.height=8, message=FALSE, results = 'asis', echo=FALSE, warning=FALSE, fig.cap="long caption", fig.scap="short"}
library(ggplot2)
library(knitr)
for (product in application){
product<-gsub("\\(", "_",product)
product<-gsub("\\)", "_",product)
for(en in env){
tryCatch({
mergedData <- merge(pp, c, by.x=c("Hostname"),by.y=en)
cat(paste(product, en, " - Environment"))
cat("\n")
for(m in metrics){
p<-ggplot(mergedData,aes(Date, m, group=Hostname, colour=Hostname))+geom_line()+
geom_smooth(method="lm", se=T, colour="blue")+
facet_wrap(~Hostname)+theme_bw()+
ggtitle(m)+
theme(strip.background = element_rect(colour="blue", fill="#b2d8ff"),axis.text.x = element_text(angle = 30,hjust = 1),plot.background = element_rect(size = 1, colour="black",linetype = "solid"))+
scale_fill_brewer(palette="RdYlGn")
print(p)
cat("\n")
}
},error=function(e) {
print(paste(product, "does not have - ", en, "- Environment"))
print("\n")
})
}
}
```
It is taking extremely long time to run this, any ideas how I could optimize it to run in a short time?
I have the following barchart to which I want to add error bars.
library(lattice)
barchart(Change~fTreat,groups=Process,change,
auto.key=list(points=FALSE,rectangles=TRUE),
panel=function(x, y,...){
panel.barchart(x,y,origin = 0,...);
panel.abline(h=0,col="black",...);
}
)
I have tried using the panel.errbars from the memisc package which works great for xyplots, but when I add it to my code it does not respect the groups.
library(memisc)
barchart(cbind(Change,lower,upper)~fTreat,groups=Process,change,
ylab="Pocertage change",
ylim=-115:50,
scales=list(alternating=FALSE,
tick.number=7,
tck=c(-1,0)),
panel=function(x, y,groups,...){
panel.barchart(x,y=change$Change,groups=change$Process,origin = 0,...);
panel.abline(h=0,col="black",...);
panel.errbars(x,y,make.grid="none",ewidth=0.2,type="n",...)
}
)
Any ideas of how to add error bars to my plot either using the panel.errbars or any other function?
The data:
structure(list(Treat = structure(c(3L, 4L, 1L, 2L, 3L, 4L, 1L,
2L), .Label = c("12-380", "12-750", "8-380", "8-750"), class = "factor"),
Process = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("Resp",
"Cal"), class = c("ordered", "factor")), Change = c(-33.05,
-34.74, 20.94, 18.06, 6.85, -28.57, -8.1, -78.72), upper = c(-13.22896628,
-28.61149669, 31.29930461, 27.30173776, 39.73271282, 9.458372948,
13.11035572, -47.03745704), lower = c(-52.86120694, -40.87446411,
10.57421563, 8.822042178, -26.03144161, -66.60447035, -29.30563327,
-110.3973761), fTreat = structure(c(1L, 2L, 3L, 4L, 1L, 2L,
3L, 4L), .Label = c("8-380", "8-750", "12-380", "12-750"), class = c("ordered",
"factor"))), .Names = c("Treat", "Process", "Change", "upper",
"lower", "fTreat"), row.names = c(NA, -8L), class = "data.frame")
Cheers
Here is another answer I was given using lattice.
prepanel=function(y, stderr, subscripts=subscripts, ...){
uy <- as.numeric(y+stderr[subscripts])
ly <- as.numeric(y-stderr[subscripts])
list(ylim=range(y,uy,ly, finite=TRUE))
}
panel.err=function(x, y, subscripts, groups, stderr, box.ratio, ...){
d <- 1/(nlevels(groups)+nlevels(groups)/box.ratio)
g <- (as.numeric(groups[subscripts])-1); g <- (g-median(g))*d
panel.arrows(as.numeric(x)+g,y-stderr[subscripts], as.numeric(x)+g, y+stderr[subscripts],
code=3,angle=90, length=0.025)
}
barchart(Change~fTreat,groups=Process,change,
stderr=change$stderr,
ylab="Pocertage change",
xlab="Treatment",
ylim=-115:50,
auto.key=list(points=FALSE,rectangles=TRUE,columns=2),
scales=list(alternating=FALSE,
tick.number=7,
tck=c(-1,0)),
prepanel=prepanel,
panel=function(x, y, subscripts, groups, stderr, box.ratio, ...){
panel.barchart(x, y, subscripts=subscripts,
groups=groups, box.ratio=box.ratio,origin=0, ...)
panel.abline(h=0,col="black",...)
panel.err(x, y, subscripts=subscripts,
groups=groups, box.ratio=box.ratio,stderr=change$stderr)
}
)
A big thank you to Walmes Marques Zeviani for providing the code
Here is the modified data:
change <- structure(list(Treat = structure(c(3L, 4L, 1L, 2L, 3L, 4L, 1L,
2L), .Label = c("12-380", "12-750", "8-380", "8-750"), class = "factor"),
Process = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("Respiration",
"Calcification"), class = c("ordered", "factor")), Change = c(-33L,
-35L, 21L, 18L, 7L, -29L, -8L, -79L), stderr = c(20L, 6L,
10L, 9L, 33L, 38L, 21L, 32L), fTreat = structure(c(1L, 2L,
3L, 4L, 1L, 2L, 3L, 4L), .Label = c("8-380", "8-750", "12-380",
"12-750"), class = c("ordered", "factor"))), .Names = c("Treat",
"Process", "Change", "stderr", "fTreat"), row.names = c(NA, -8L
), class = "data.frame")
This is not what you're asking for, but the plot is rather easy to make with ggplot2 (in a case that this is an option)
dt <- structure(list(Treat = structure(c(3L, 4L, 1L, 2L, 3L, 4L, 1L,
2L), .Label = c("12-380", "12-750", "8-380", "8-750"), class = "factor"),
Process = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("Resp",
"Cal"), class = c("ordered", "factor")), Change = c(-33.05,
-34.74, 20.94, 18.06, 6.85, -28.57, -8.1, -78.72), upper = c(-13.22896628,
-28.61149669, 31.29930461, 27.30173776, 39.73271282, 9.458372948,
13.11035572, -47.03745704), lower = c(-52.86120694, -40.87446411,
10.57421563, 8.822042178, -26.03144161, -66.60447035, -29.30563327,
-110.3973761), fTreat = structure(c(1L, 2L, 3L, 4L, 1L, 2L,
3L, 4L), .Label = c("8-380", "8-750", "12-380", "12-750"), class = c("ordered",
"factor"))), .Names = c("Treat", "Process", "Change", "upper",
"lower", "fTreat"), row.names = c(NA, -8L), class = "data.frame")
a <- ggplot(dt, aes(y = Change, x = Treat, ymax = upper, ymin = lower))
dodge <- position_dodge(width=0.9)
a + geom_bar(aes(fill = Process), position = dodge) +
geom_errorbar(aes(fill = Process), position = dodge, width = 0.2)