pophelper icon indicating copy to clipboard operation
pophelper copied to clipboard

I have an error when using the mergeQ function

Open beeamerino opened this issue 1 year ago • 4 comments

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

beeamerino avatar Aug 07 '23 20:08 beeamerino

Hello, I'm still experiencing the problem, is there any ways to walk around the issue?

YuanwenGuo avatar Dec 11 '23 02:12 YuanwenGuo

I have exactly the same problem.

adrientaudiere avatar Jan 17 '24 20:01 adrientaudiere

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])
}


adrientaudiere avatar Jan 17 '24 21:01 adrientaudiere

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!

teuneverts avatar Jan 29 '24 16:01 teuneverts