pophelper
pophelper copied to clipboard
I have an error when using the mergeQ function
Hello everyone, I hope you are well.
I am trying to re-plot some SSR data and have not been able to resolve this error. I happen to import my data as I did some time ago when I created this script (it goes below) and everything was working fine. Now, when I try to use MergeQ, there is no way it works.
`
Load libraries
library(pophelper) library(devtools) library(ggplot2) library(gridExtra) library(gtable) library(label.switching) library(tidyr)
Set working directory
setwd("SSR Results/Structure")
STRUCTURE files
Neop.sfiles <- list.files(path = "Structure/Neoporteria", full.names=T)
Basic usage
Neop.slist <- readQ(files=Neop.sfiles, indlabfromfile=T)
TabulateQ
tr1 <- tabulateQ(qlist=Neop.slist)
SummariseQ
sr1 <- summariseQ(tr1)
Evanno method
em <- evannoMethodStructure(sr1)
Plot Evanno
evannoMethodStructure(data=sr1, exportplot=T, exportpath=getwd(), outputfilename = "EvannoNeop")
plot meanK
str(Neop.slist) length(Neop.slist)
Now try sorting
Neop.slist_1 <- alignK(Neop.slist) Neop.slist_2 <- mergeQ(Neop.slist_1)
so when run... Neop.slist_2 <- mergeQ(Neop.slist_1) Error in xtfrm.data.frame(x) : cannot xtfrm data frames
Hello, I'm still experiencing the problem, is there any ways to walk around the issue?
I have exactly the same problem.
I finally found a dirty way by using custom mergeQ and sortQ functions with a only one line removed line 332 in qlist.R
mergeQ2 <- function(qlist) {
is.qlist(qlist)
if(diff(range(as.integer(tabulateQ(qlist)$ind)))!=0) stop("mergeQ: Number of individuals differ between runs.")
# Computes mean cell-wise across dataframes
# x A list of numeric dataframes
#
mergy <- function(x) {
return(list(Reduce(`+`, x)/length(x)))
}
# if all runs have same K, merge as is
if(diff(range(as.integer(tabulateQ(qlist)$k)))==0) {
labels <- summariseQ(tabulateQ(qlist))$k
x <- mergy(qlist)
names(x) <- labels
}else{
# if runs have different K, split them and merge within sublists
qlist <- sortQ2(qlist)
labels <- summariseQ(tabulateQ(qlist,sorttable=FALSE))$k
x <- unlist(lapply(splitQ(qlist),mergy),recursive=FALSE)
names(x) <- labels
}
return(as.qlist(x))
}
sortQ2 <- function(qlist,by="k",decreasing=FALSE,debug=FALSE) {
is.qlist(qlist)
if(length(by)==0) stop("sortQ: Argument 'by' must not be length zero.")
if(!is.character(by)) stop("sortQ: Argument 'by' must be a character.")
if(!is.logical(decreasing)) stop("sortQ: Argument 'decreasing' must be a logical datatype.")
fun1 <- function(x) as.matrix(unlist(attributes(x)))
a <- lapply(qlist,fun1)
if(debug) print(a)
if(any(!sapply(a,function(x) any(grepl(paste0(by,collapse="|"),rownames(x)))))) {
stop(paste0("One or more of the attributes provided in by (",by,") is missing in one or more runs. If 'ind' or 'k' is missing, use 'as.qlist()' to add them."))
}
# get df of attributes
b <- as.data.frame(t(as.data.frame(lapply(a,function(x,y) x[y,],by),stringAsFactors=FALSE)),stringsAsFactors=FALSE)
fun2 <- function(x) if(all(!is.na(as.numeric(as.character(x))))) {return(as.numeric(as.character(x)))}else{return(x)}
b <- as.data.frame(sapply(b,fun2),stringAsFactors=FALSE)
if(debug) {print(str(b)); print(b)}
# order
ord <- do.call(order,b[,by,drop=FALSE])
if(decreasing) ord <- rev(ord)
# sort qlist
return(qlist[ord])
}
I have the same problem. I have emailed the package developer with reference to this page. I hope he will be able to fix this, but for the meantime, I will use the dirty fix above!