I am relatively new to phyloseq and I struggle to obtain a relative abundance otu-table acceptable for input to siamcat R code for meta-analysis.
# this works: from qza to phyloseq object
ps<-qza_to_phyloseq(
features="all-table.qza",
tree="rooted-tree.qza",
taxonomy = "all-taxonomy.qza",
metadata = "metafinal.tsv"
)
# import metadata
metadata <- read_tsv("metafinal.tsv")
# 30 overlap of the metadata-sample_id with ps, 115 only in metadata
gplots::venn(list(metadata=metadata$sample_id, features=sample_names(ps))
# works: from phyloseq object to relative abundance otu table
table(tax_table(ps)[, "Phylum"])
ps_rel_abund <- transform_sample_counts(ps, function(x){x / sum(x)})
ps_phylum_rel <- tax_glom(ps_rel_abund, "Phylum")
taxa_names(ps_phylum_rel) <- tax_table(ps_phylum_rel)[, "Phylum"]
rel_table <- as(otu_table(ps_phylum_rel), "matrix")
# column names and sample_id are 100% the same
colnames(rel_table)
metadata$sample_id
# 100% overlap:
gplots::venn(list(metadata=metadata$sample_id, featuretable=colnames(rel_table)))
# check that metadata and feature agree
stopifnot(all(colnames(rel_table) == metadata$sample_id))
and here I get an error message: all(colnames(rel_table) == metadata$sample_id) is not TRUE
and the following siamcat code is not working at all.
my metadata[1:5, 1:5]:
sample_id absolute_filepath study experiment_acce… study_title
1 SRR8547628 $PWD/Chen_2020_da… Chen… SRX5349649 Dissection of c…
2 SRR8547629 $PWD/Chen_2020_da… Chen… SRX5349648 Dissection of c…
3 SRR8547630 $PWD/Chen_2020_da… Chen… SRX5349647 Dissection of c…
4 SRR8547631 $PWD/Chen_2020_da… Chen… SRX5349646 Dissection of c…
5 SRR8547632 $PWD/Chen_2020_da… Chen… SRX5349645 Dissection of c…
my rel-table[1:5, 1:5]:
SRR5092146 SRR5092147 SRR5092148 SRR5092149
Phragmoplastophyta 0 0.0000000 0.00000000 0.000000000
Vertebrata 0 0.0000000 0.00000000 0.000000000
Apicomplexa 0 0.0000000 0.00000000 0.000000000
Ascomycota 0 0.0000000 0.00000000 0.000000000
Campilobacterota 0 0.2465222 0.01166882 0.004337051
SRR5092150
Phragmoplastophyta 0.00000000
Vertebrata 0.00000000
Apicomplexa 0.00000000
Ascomycota 0.00000000
Campilobacterota 0.02106281
nrow(metadata)= 154
ncol(rel_table)= 154
Please, why is it not working? I tried for weeks now and I can't make the code run properly ...
Thank you for your time and help.
If I understand your question correctly, you are wondering, why you have perfect overlap between sample IDs in your metadata and in your feature table, but why
stopifnot(all(colnames(rel_table) == metadata$sample_id))
returns FALSE.
I think it is because your samples seem to be in a different order. The first five samples in your metadata are:
SRR8547628
SRR8547629
SRR8547630
SRR8547631
SRR8547632
and the first five samples in your feature table are:
SRR5092146
SRR5092147
SRR5092148
SRR5092149
SRR5092150
Try
stopifnot(all(colnames(rel_table) %in% metadata$sample_id))
Related
Have anyone used panel var in R?
Currently I'm using the package panelvar of R. And I'm getting this error :
Error in `[.data.frame`(data, , c(colnames(data)[panel_identifier], required_vars)) :
undefined columns selected
And my syntax currently is:
model1<-pvargmm(
dependent_vars = c("Change.."),
lags = 2,
exog_vars = c("Price"),
transformation = "fd",
data = base1,
panel_identifier = c("id", "t"),
steps = c("twostep"),
system_instruments = FALSE,
max_instr_dependent_vars = 99,
min_instr_dependent_vars = 2L,
collapse = FALSE)
I don't know why my panel_identifier is not working, it's pretty similar to the example given by panelvar package, however, it doesn't work, I want to appoint that base1 is on data.frame format. any ideas? Also, my data is structured like this:
head(base1)
id t country DDMMYY month month_text day Date_txt year Price Open
1 1 1296 China 1-4-2020 4 Apr 1 Apr 01 2020 12588.24 12614.82
2 1 1295 China 31-3-2020 3 Mar 31 Mar 31 2020 12614.82 12597.61
High Low Vol. Change..
1 12775.83 12570.32 NA -0.0021
2 12737.28 12583.05 NA 0.0014
thanks in advance !
Check the documentation of the package and the SSRN paper. For me it helped to ensure all entered formats are identical (you can check this with str(base1) command). For example they write:
library(panelvar)
data("Dahlberg")
ex1_dahlberg_data <-
pvargmm(dependent_vars = .......
When I look at it I get
>str(Dahlberg)
'data.frame': 2385 obs. of 5 variables:
$ id : Factor w/ 265 levels "114","115","120",..: 1 1 1 1 1 1 1 1 1 2 ...
$ year : Factor w/ 9 levels "1979","1980",..: 1 2 3 4 5 6 7 8 9 1 ...
$ expenditures: num 0.023 0.0266 0.0273 0.0289 0.0226 ...
$ revenues : num 0.0182 0.0209 0.0211 0.0234 0.018 ...
$ grants : num 0.00544 0.00573 0.00566 0.00589 0.00559 ...
For example the input data must be a data.frame (in my case it had additional type specifications like tibble or data.table). I resolved it by casting as.data.frame() on it.
A HTML table body has 1 column more than defined within the table header. This leads to skipping the last column and of course, column mismatch. How can I add the additional column to the result data.frame/table in R while reading in the HTML table with package("htmltab") Obviously, post processing does not help.
Here is an example:
code
install.packages("htmltab")
library(htmltab)
bu<- 0
bu <- data.table("Pl.", "Mannschaft", "Kurzname" , "Spiele", "G.", "U.", "V.", "Tore", "Diff.", "Pkt.")
#https://www.bundesliga-prognose.de/1/2009/1/
url <- "https://www.bundesliga-prognose.de/1/2009/1/"
bu <- htmltab(doc = url, column=10,columnnames=c ("Pl." , "Mannschaft", "Kurzname" , "Spiele", "G.", "U.", "V.", "Tore", "Diff.", "Pkt."), which = "//th[text() = 'Pl.']/ancestor::table")
bu <- data.table(bu)
head(bu)
This results in
Pl. Mannschaft Spiele G. U. V. Tore Diff. Pkt.
1: 1. VfL Wolfsburg Wolfsburg 1 1 0 0 2:0 2
2: 2. Eintracht Frankfurt E. Frankfurt 1 1 0 0 3:2 1
3: 3. FC Schalke 04 FC Schalke 04 1 1 0 0 2:1 1
4: 4. Borussia Dortmund B. Dortmund 1 1 0 0 1:0 1
5: NA Hertha BSC Berlin H. BSC Berlin 1 1 0 0 1:0 1
6: 6. Bor. Mönchengladbach M´gladbach 1 0 1 0 3:3 0
As the short-name("Kurzname") is not specified in the header the short-name ("Kurzname") is displayed with the games (Spiele) column an so on. So the last column is skipped. How can I add the additional column short-name ("Kurzname") while reading the header using the htmltab package?
In addition I would like to replace the NA in row 5 with the row-id/number using the htmltab package?
This seems to be indeed a problem for htmltab. The only solution i have found is to directly read the tbody of the table. You would then need to add the header manually.
htmltab(doc = url, which = "//table[2]/tbody")
With that help I found a quite simple solution:
specify to skip the header
List/define all colums thru colNames
url <- "https://www.bundesliga-prognose.de/1/2007/5/"
sp_2007_5<- htmltab(doc = url, which = "//table[1]/tbody", header = 0 , colNames = c("Datum" , "Anpfiff", "Heim" , "Heim_Kurzname","Gast", "Gast_Kurzname","Ergebnis", "Prognose"), rm_nodata_cols = F,encoding = "UTF-8")
head(sp_2007_5)
I am fairly new to scraping/parsing HTML in R. I am trying to get data from the Career Receiving Statistics and Career Rushing Statistics' tables from http://totalfootballstats.com/PlayerWR.asp?id=1218565.
I know about the read readHTMLtable function but both these tables are embedded in so much junk and I can't seem to get past the children nodes of the root.
EDIT: the above problem has been solved. However for the website http://www.sports-reference.com/cfb/players/a-index.html I am trying to loop through all players and access their data. I'm running into trouble in accessing their respective url links. I have tried:
fb=htmlParse("http://www.sports-reference.com/cfb/players/a-index.html")
p1=getNodeSet(fb,'//pre')
con = textConnection(xmlValue(p1[[100]]))
players100 = read.table(con)
But this results in the error "Error in scan(file, what, nmax, sep, dec, quote, skip, nlines, na.strings, :
line 3 did not have 5 elements"
The other thing I tried is:
links <- xpathSApply(fb, "//a/#href")
But I feel like there should be a better way to do this?
Well here's the same player from a different website, much much cleaner. The data doesn't match though, so someone got it wrong. My money's on totalfootballstats.com. Choose your resources wisely!
readHTMLTable(
"http://www.sports-reference.com/cfb/players/doyle-aaron-1.html"
)
# $receiving
# Year School Conf Class Pos G Rec Yds Avg TD Att Yds Avg TD Plays Yds Avg TD
# 1 1988 Miami (FL) Ind WR 11 1 12 12.0 0 1 34 34.0 0 2 46 23.0 0
# 2 1989 Miami (FL) Ind WR 11 8 93 11.6 1 8 93 11.6 1
# $kick_ret
# Year School Conf Class Pos G Ret Yds Avg TD Ret Yds Avg TD
# 1 1988 Miami (FL) Ind WR 11 1 8 8.0 0
# 2 1989 Miami (FL) Ind WR 11
For specific requests, it looks like you can a construct a valid URL like this, which will also construct the path for multiple players at once.
## base URI
u <- "http://www.sports-reference.com"
## player first and last names
first <- "bill"
last <- "adams"
## use sprintf() to make all the paths at once
fullPath <- sprintf("%s/cfb/players/%s-%s-1.html", u, first, last)
## read the table - I think you'll need to loop readHTMLTable() though
readHTMLTable(fullPath)
# $receiving
# Year School Conf Class Pos G Rec Yds Avg TD Att Yds Avg TD Plays Yds Avg TD
# 1 1969 Dayton Ind WR 10 1 3 3.0 1 1 3 3.0 1
# 2 1970 Dayton Ind WR 10 4 42 10.5 1 4 42 10.5 1
OK, to set the scene, I have written a function to import multiple tables from MySQL (using RODBC) and run randomForest() on them.
This function is run on multiple databases (as separate instances).
In one particular database, and one particular table, the "error in as.POSIXlt.character(x, tz,.....): character string not in a standard unambiguous format" error is thrown. The function runs on around 150 tables across two databases without any issues except this one table.
Here is a head() print from the table:
MQLTime bar5 bar4 bar3 bar2 bar1 pat1 baXRC
1 2014-11-05 23:35:00 184 24 8 24 67 147 Flat
2 2014-11-05 23:57:00 203 184 204 67 51 147 Flat
3 2014-11-06 00:40:00 179 309 49 189 75 19 Flat
4 2014-11-06 00:46:00 28 192 60 49 152 147 Flat
5 2014-11-06 01:20:00 309 48 9 11 24 19 Flat
6 2014-11-06 01:31:00 24 177 64 152 188 19 Flat
And here is the function:
GenerateRF <- function(db, countstable, RFcutoff) {
'load required libraries'
library(RODBC)
library(randomForest)
library(caret)
library(ff)
library(stringi)
'connection and data preparation'
connection <- odbcConnect ('TTODBC', uid='root', pwd='password', case="nochange")
'import count table and check if RF is allowed to be built'
query.str <- paste0 ('select * from ', db, '.', countstable, ' order by RowCount asc')
row.counts <- sqlQuery (connection, query.str)
'Operate only on tables that have >= RFcutoff'
for (i in 1:nrow (row.counts)) {
table.name <- as.character (row.counts[i,1])
col.count <- as.numeric (row.counts[i,2])
row.count <- as.numeric (row.counts[i,3])
if (row.count >= 20) {
'Delete old RFs and DFs for input pattern'
if (file.exists (paste0 (table.name, '_RF.Rdata'))) {
file.remove (paste0 (table.name, '_RF.Rdata'))
}
if (file.exists (paste0 (table.name, '_DF.Rdata'))) {
file.remove (paste0 (table.name, '_DF.Rdata'))
}
'import and clean data'
query.str2 <- paste0 ('select * from ', db, '.', table.name, ' order by mqltime asc')
raw.data <- sqlQuery(connection, query.str2)
'partition data into training/test sets'
set.seed(489)
index <- createDataPartition(raw.data$baXRC, p=0.66, list=FALSE, times=1)
data.train <- raw.data [index,]
data.test <- raw.data [-index,]
'find optimal trees to grow (without outcome and dates)
data.mtry <- as.data.frame (tuneRF (data.train [, c(-1,-col.count)], data.train$baXRC, ntreetry=100,
stepFactor=.5, improve=0.01, trace=TRUE, plot=TRUE, dobest=FALSE))
best.mtry <- data.mtry [which (data.mtry[,2] == min (data.mtry[,2])), 1]
'compress df'
data.ff <- as.ffdf (data.train)
'run RF. Originally set to 1000 trees but M1 dataset is to large for laptop. Maybe train at the lab?'
data.rf <- randomForest (baXRC~., data=data.ff[,-1], mtry=best.mtry, ntree=500, keep.forest=TRUE,
importance=TRUE, proximity=FALSE)
'generate and print variable importance plot'
varImpPlot (data.rf, main = table.name)
'predict on test data'
data.test.pred <- as.data.frame( predict (data.rf, data.test, type="prob"))
'get dates and name date column'
data.test.dates <- data.frame (data.test[,1])
colnames (data.test.dates) <- 'MQLTime'
'attach dates to prediction df'
data.test.res <- cbind (data.test.dates, data.test.pred)
'force date coercion to attempt negating unambiguous format error '
data.test.res$MQLTime <- format(data.test.res$MQLTime, format = "%Y-%m-%d %H:%M:%S")
'delete row names, coerce to dataframe, generate row table name and export outcomes to MySQL'
rownames (data.test.res)<-NULL
data.test.res <- as.data.frame (data.test.res)
root.table <- stri_sub(table.name, 0, -5)
sqlUpdate (connection, data.test.res, tablename = paste0(db, '.', root.table, '_outcome'), index = "MQLTime")
'save RF and test df/s for future use; save latest version of row_counts to MQL4 folder'
save (data.rf, file = paste0 ("C:/Users/user/Documents/RF_test2/", table.name, '_RF.Rdata'))
save (data.test, file = paste0 ("C:/Users/user/Documents/RF_test2/", table.name, '_DF.Rdata'))
write.table (row.counts, paste0("C:/Users/user/AppData/Roaming/MetaQuotes/Terminal/71FA4710ABEFC21F77A62A104A956F23/MQL4/Files/", db, "_m1_rowcounts.csv"), sep = ",", col.names = F,
row.names = F, quote = F)
'end of conditional block'
}
'end of for loop'
}
'close all connection to MySQL'
odbcCloseAll()
'clear workspace'
rm(list=ls())
'end of function'
}
At this line:
data.test.res$MQLTime <- format(data.test.res$MQLTime, format = "%Y-%m-%d %H:%M:%S")
I have tried coercing MQLTime using various functions including: as.character(), as.POSIXct(), as.POSIXlt(), as.Date(), format(), as.character(as.Date())
and have also tried:
"%y" vs "%Y" and "%OS" vs "%S"
All variants seem to have no effect on the error and the function is still able to run on all other tables. I have checked the table manually (which contains almost 1500 rows) and also in MySQL looking for NULL dates or dates like "0000-00-00 00:00:00".
Also, if I run the function line by line in R terminal, this offending table is processed without any problems which just confuses the hell out me.
I've exhausted all the functions/solutions I can think of (and also all those I could find through Dr. Google) so I am pleading for help here.
I should probably mention that the MQLTime column is stored as varchar() in MySQL. This was done to try and get around issues with type conversions between R and MySQL
SHOW VARIABLES LIKE "%version%";
innodb_version, 5.6.19
protocol_version, 10
slave_type_conversions,
version, 5.6.19
version_comment, MySQL Community Server (GPL)
version_compile_machine, x86
version_compile_os, Win32
> sessionInfo()
R version 3.0.2 (2013-09-25)
Platform: i386-w64-mingw32/i386 (32-bit)
Edit: Str() output on the data as imported from MySQl showing MQLTime is already in POSIXct format:
> str(raw.data)
'data.frame': 1472 obs. of 8 variables:
$ MQLTime: POSIXct, format: "2014-11-05 23:35:00" "2014-11-05 23:57:00" "2014-11-06 00:40:00" "2014-11-06 00:46:00" ...
$ bar5 : int 184 203 179 28 309 24 156 48 309 437 ...
$ bar4 : int 24 184 309 192 48 177 48 68 60 71 ...
$ bar3 : int 8 204 49 60 9 64 68 27 192 147 ...
$ bar2 : int 24 67 189 49 11 152 27 56 437 67 ...
$ bar1 : int 67 51 75 152 24 188 56 147 71 0 ...
$ pat1 : int 147 147 19 147 19 19 147 19 147 19 ...
$ baXRC : Factor w/ 3 levels "Down","Flat",..: 2 2 2 2 2 2 2 2 2 3 ...
So I have tried declaring stringsAsfactors = FALSE in the dataframe operations and this had no effect.
Interestingly, if the offending table is removed from processing through an additional conditional statement in the first 'if' block, the function stops on the table immediately preceeding the blocked table.
If both the original and the new offending tables are removed from processing, then the function stops on the table immediately prior to them. I have never seen this sort of behavior before and it really has me stumped.
I watched system resources during the function and they never seem to max out.
Could this be a problem with the 'for' loop and not necessarily date formats?
There appears to be some egg on my face. The table following the table where the function was stopping had a row with value '0000-00-00 00:00:00'. I added another statement in my MySQL function to remove these rows when pre-processing the tables. Thanks to those that had a look at this.
I'm trying to calculate various time period returns (monthly, quarterly, yearly etc.) for each unique member (identified by Code in the example below) of a data set. The data set will contain monthly pricing information for a 20 year period for approximately 500 stocks. An example of the data is below:
Date Code Price Dividend
1 2005-01-31 xyz 1000.00 20.0
2 2005-01-31 abc 1.00 0.1
3 2005-02-28 xyz 1030.00 20.0
4 2005-02-28 abc 1.01 0.1
5 2005-03-31 xyz 1071.20 20.0
6 2005-03-31 abc 1.03 0.1
7 2005-04-30 xyz 1124.76 20.0
I am fairly new to R, but thought that there would be a more efficient solution than looping through each Code and then each Date as shown here:
uniqueDates <- unique(data$Date)
uniqueCodes <- unique(data$Code
for (date in uniqueDates) {
for (code in uniqueCodes) {
nextDate <- seq.Date(from=stock_data$Date[i], by="3 months",length.out=2)[2]
curPrice <- data$Price[data$Date == date]
futPrice <- data$Price[data$Date == nextDate]
data$ret[(data$Date == date) & (data$Code == code)] <- (futPrice/curPrice)-1
}
}
This method in itself has an issue in that seq.Date does not always return the final day in the month.
Unfortunately the data is not uniform (the number of companies/codes varies over time) so using a simple row offset won't work. The calculation must match the Code and Date with the desired date offset.
I had initially tried selecting the future dates by using the seq.Date function
data$ret = (data[(data$Date == (seq.Date(from = data$Date, by="3 month", length.out=2)[2])), "Price"] / data$Price) - 1
But this generated an error as seq.Date requires a single entry.
> Error in seq.Date(from = stock_data$Date, by = "3 month", length.out =
> 2) : 'from' must be of length 1
I thought that R would be well suited to this type of calculation but perhaps not. Since all the data is in a mysql database I am now thinking that it might be faster/easier to do this calc directly in the database.
Any suggestions would be greatly appreciated.
Load data:
tc='
Date Code Price Dividend
2005-01-31 xyz 1000.00 20.0
2005-01-31 abc 1.00 0.1
2005-02-28 xyz 1030.00 20.0
2005-02-28 abc 1.01 0.1
2005-03-31 xyz 1071.20 20.0
2005-03-31 abc 1.03 0.1
2005-04-30 xyz 1124.76 20.0'
df = read.table(text=tc,header=T)
df$Date=as.Date(df$Date,"%Y-%m-%d")
First I would organize the data by date:
library(plyr)
pp1=reshape(df,timevar='Code',idvar='Date',direction='wide')
Then you would like to obtain monthly, quarterly, yearly, etc returns.
For that there are several options, one could be:
Make the data zoo or xts class. i.e
library(xts)
pp1[2:ncol(pp1)] = as.xts(pp1[2:ncol(pp1)],order.by=pp1$Date)
#let's create a function for calculating returns.
rets<-function(x,lag=1){
return(diff(log(x),lag))
}
Since this database is monthly, the lags for the returns will be:
monthly=1, quaterly=3, yearly =12. for instance let's calculate monthly return
for xyz.
lagged=1 #for monthly
This calculates Monthly returns for xyz
pp1$returns_xyz= c(NA,rets(pp1$Price.xyz,lagged))
To get all the returns:
#create matrix of returns
pricelist= ls(pp1)[grep('Price',ls(pp1))]
returnsmatrix = data.frame(matrix(rep(0,(nrow(pp1)-1)*length(pricelist)),ncol=length(pricelist)))
j=1
for(i in pricelist){
n = which(names(pp1) == i)
returnsmatrix[,j] = rets(pp1[,n],1)
j=j+1
}
#column names
codename= gsub("Price.", "", pricelist, fixed = TRUE)
names(returnsmatrix)=paste('ret',codename,sep='.')
returnsmatrix
You can do this very easily with the quantmod and xts packages. Using the data in AndresT's answer:
library(quantmod) # loads xts too
pp1 <- reshape(df,timevar='Code',idvar='Date',direction='wide')
# create an xts object
x <- xts(pp1[,-1], pp1[,1])
# only get the "Price.*" columns
p <- getPrice(x)
# run the periodReturn function on each column
r <- apply(p, 2, periodReturn, period="monthly", type="log")
# merge prior result into a multi-column object
r <- do.call(merge, r)
# rename columns
names(r) <- paste("monthly.return",
sapply(strsplit(names(p),"\\."), "[", 2), sep=".")
Which leaves you with an r xts object containing:
monthly.return.xyz monthly.return.abc
2005-01-31 0.00000000 0.000000000
2005-02-28 0.02955880 0.009950331
2005-03-31 0.03922071 0.019608471
2005-04-30 0.04879016 NA