Lapply over subset of dataframes without splitting further - r

I am at a loss on how to do this without addressing each individual part. I have an initial timeseries dataset that I split into a list of 12 dataframes representing each month. Within each month, I want to run calculations and ggplot on each unique site without having to call each individual site. The structure currently is as follows:
$ April :'data.frame': 9360 obs. of 15 variables:
..$ site_id : int [1:9360] 1003 1003 1003 1003 1003 1003 1003 1003 1003 1003 ...
..$ UTC_date.1 : Date[1:9360], format: "2005-04-01" "2005-04-02" "2005-04-03" "2005-04-04" ...
..$ POSIXct : POSIXct[1:9360], format: "2005-04-01 06:00:00" "2005-04-02 06:00:00" "2005-04-03 06:00:00" "2005-04-04 06:00:00" ...
..$ swe_mm : num [1:9360] 45.9 44.6 43.5 42.4 41.2 ...
..$ fsca : num [1:9360] 1 1 1 1 0.997 ...
..$ snoht_m : num [1:9360] 0.303 0.239 0.21 0.186 0.165 ...
..$ swe_mm.1 : num [1:9360] 45.9 44.6 43.5 42.4 41.2 ...
..$ fsca.1 : num [1:9360] 1 1 1 1 0.997 ...
..$ snoht_m.1 : num [1:9360] 0.303 0.239 0.21 0.186 0.165 ...
..$ actSWE_mm : num [1:9360] 279 282 282 282 282 284 292 295 295 295 ...
..$ actSD_cm : num [1:9360] 79 79 NA 79 79 81 185 81 81 81 ...
..$ swe_Res_mm : num [1:9360] 233 237 238 240 241 ...
..$ snoht_Res_m : num [1:9360] 0.487 0.551 NA 0.604 0.625 ...
..$ swe_Res1_mm : num [1:9360] 233 237 238 240 241 ...
..$ snoht_Res1_m: num [1:9360] 0.487 0.551 NA 0.604 0.625 ...
I can use lapply to calculate the standardized rmse without issue if I apply it to each dataframe entirely:
stdres.fun <- function(data,x,out) {data[out] <- data[[x]] / ((sum(data[[x]]^2, na.rm = TRUE)/NROW(data))^.5); data}
monthSplit <- lapply(monthSplit, stdres.fun, x = "swe_Res_mm", out="stdSWE_res")
However, I am having trouble figuring out how to run this calculation on each unique site_id. What I mean to say is there are 32 different sites. They are the same sites in each dataframe, however I want to calculate the rmse for each site within each dataframe in the list. So if I had sites 946 and 1003, the calculation would run on each of those separately rather than together.
I'm assuming I can split the data further into different lists but I feel like this would be messier than it already is. Is there another way I can go about doing this?

We could modify the function and use tidyverse methods
library(purrr)
library(dplyr)
monthSplit2 <- map(monthSplit, ~
.x %>%
group_by(sites) %>%
mutate(stdSWE_res = swe_Res_mm/((sum(swe_Res_mm^2,
na.rm = TRUE)/n()) ^.5))

Related

convert list with unequal vector length to data frame by strata in R

I have the output from a coxph function, which is estimated by strata. I would like to transform this output from a list into a data frame. The code I ran for coxph is below:
k <- coxph(Surv(cum.goodp, dlq.next) ~ rpc.length + cluster(itemcode) + strata(sector), data = nr.sample)
m <- summary(survfit(k))
There are twenty different strata used to estimate the coxph. Here is the structure of the list
List of 16
$ n : int [1:20] 870 843 2278 603 6687 8618 15155 920 2598 654 ...
$ time : num [1:870] 1 2 3 4 5 6 7 8 9 10 ...
$ n.risk : num [1:870] 870 592 448 361 320 286 232 214 196 186 ...
$ n.event : num [1:870] 246 126 77 34 33 25 18 18 8 6 ...
$ n.censor : num [1:870] 32 18 10 7 1 29 0 0 2 0 ...
$ strata : Factor w/ 20 levels "sector=11","sector=21",..: 1 1 1 1 1 1 1 1 1 1 ...
$ surv : num [1:870] 0.725 0.571 0.471 0.425 0.379 ...
$ type : chr "right"
$ cumhaz : num [1:870] 0.322 0.561 0.754 0.856 0.971 ...
$ std.err : num [1:870] 0.015 0.017 0.0174 0.0174 0.0173 ...
$ upper : num [1:870] 0.755 0.605 0.506 0.46 0.414 ...
$ lower : num [1:870] 0.696 0.538 0.438 0.392 0.347 ...
$ conf.type: chr "log"
$ conf.int : num 0.95
$ call : language survfit(formula = k)
$ table : num [1:20, 1:7] 870 843 2278 603 6687 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:20] "sector=11" "sector=21" "sector=22" "sector=23" ...
.. ..$ : chr [1:7] "records" "n.max" "n.start" "events" ...
- attr(*, "class")= chr "summary.survfit"
I have done this before, but without strata. When I did not have strata I used the following approach:
col <- lapply(c(1 : 7), function(x) m[x])
tbl <- do.call(data.frame, col)
However, when I try that approach here, I get the familiar error:
cannot coerce class "c("survfit.cox", "survfit")" to a data.frame
All columns have the same name, but they are of different length. If possible, I would like to add a column to the final data frame that contains the particular strata that the results are for. Is there a way to do this? It doesn't have to be in base R. Any help would be much appreciated. Thanks so much.
This problem can be solved via the tidy function in the broom package. For the example above, the code is:
n <- survfit(k)
df <- tidy(n)
The tidy function produces a data frame with a variable "strata". It does not, however, provide the median and mean, but they can be estimated from the data frame df if one were so inclined. If the survfit object has multiple strata, the glance(list) cannot provide the median or mean.

r quantregForest() error: NA's produced by integer overflow lead to an invalid argument in the rep() function

I am trying to use the quantregForest() function from the quantregForest package (which is built on the randomForest package.)
I tried to train the model using:
qrf_model <- quantregForest(x=Xtrain, y=Ytrain, importance=TRUE, ntree=10)
and I get the following error message (even after reducing the number of trees from 100 to 10):
Error in rep(0, nobs * nobs * npred) : invalid 'times' argument
plus a warning:
In nobs * nobs * npred : NAs produced by integer overflow
The data frame Xtrain has 38 numeric variables, and it looks like this:
> str(Xtrain)
'data.frame': 31132 obs. of 38 variables:
$ X1 : num 301306 6431 2293 1264 32477 ...
$ X2 : num 173.2 143.5 43.4 180.6 1006.2 ...
$ X3 : num 0.1598 0.1615 0.1336 0.0953 0.1988 ...
$ X4 : num 0.662 0.25 0.71 0.709 0.671 ...
$ X5 : num 0.05873 0.0142 0 0.00154 0.09517 ...
$ X6 : num 0.01598 0 0.0023 0.00154 0.01634 ...
$ X7 : num 0.07984 0.03001 0.00845 0.04304 0.09326 ...
$ X8 : num 0.92 0.97 0.992 0.957 0.907 ...
$ X9 : num 105208 1842 830 504 11553 ...
$ X10: num 69974 1212 611 352 7080 ...
$ X11: num 0.505 0.422 0.55 0.553 0.474 ...
$ X12: num 0.488 0.401 0.536 0.541 0.45 ...
$ X13: num 0.333 0.419 0.257 0.282 0.359 ...
$ X14: num 0.187 0.234 0.172 0.207 0.234 ...
$ X15: num 0.369 0.216 0.483 0.412 0.357 ...
$ X16: num 0.0765 0.1205 0.0262 0.054 0.0624 ...
$ X17: num 2954 77 12 10 739 ...
$ X18: num 2770 43 9 21 433 119 177 122 20 17 ...
$ X19: num 3167 72 49 25 622 ...
$ X20: num 3541 57 14 24 656 ...
$ X21: num 3361 82 0 33 514 ...
$ X22: num 3929 27 10 48 682 ...
$ X23: num 3695 73 61 15 643 ...
$ X24: num 4781 52 5 14 680 ...
$ X25: num 3679 103 5 23 404 ...
$ X26: num 7716 120 55 40 895 ...
$ X27: num 11043 195 72 48 1280 ...
$ X28: num 16080 332 160 83 1684 ...
$ X29: num 12312 125 124 62 1015 ...
$ X30: num 8218 99 36 22 577 ...
$ X31: num 9957 223 146 26 532 ...
$ X32: num 0.751 0.444 0.621 0.527 0.682 ...
$ X33: num 0.01873 0 0 0.00317 0.02112 ...
$ X34: num 0.563 0.372 0.571 0.626 0.323 ...
$ X35: num 0.366 0.39 0.156 0.248 0.549 ...
$ X36: num 0.435 0.643 0.374 0.505 0.36 ...
$ X37: num 0.526 0.31 0.577 0.441 0.591 ...
$ X38: num 0.00163 0 0 0 0.00155 0.00103 0 0 0 0 ...
And the response variable Ytrain looks like this:
> str(Ytrain)
num [1:31132] 2605 56 8 16 214 ...
I checked that neither Xtrain or Ytrain contain any NA's by:
> sum(is.na(Xtrain))
[1] 0
> sum(is.na(Ytrain))
[1] 0
I am assuming that the error message for the invalid "times" argument for the rep(0, nobs * nobs * npred)) function comes from the NA value assigned to the product nobs * nobs * npred due to an integer overflow.
What I do not understand is where the integer overflow comes from. None of my variables are of the integer class so what am I missing?
I examined the source code for the quantregForest() function and the source code for the method predict.imp called by the quantregForest() function.
I found that nobs stands for the number of observations. In the case above nobs =length(Ytrain) = 31132 . The variable npred stands for the number of predictors. It is given by npred = ncol(Xtrain)=38. Both npred and nobs are of class integer, and
npred*npred*nobs = 31132*31132*38 = 36829654112.
And herein lies the root cause of the error, since:
npred*npred*nobs = 36829654112 > 2147483647,
where 2147483647 is the maximal integer value in R. Hence the integer overflow warning and the replacement of the product npred*npred*nobs with an NA.
The bottom line is, in order to avoid the error message I will have to use quite a bit fewer observations when training the model or set importance=FALSE in the quantregForest() function argument. The computations required to find variable importance are very memory intensive, even when using less then 10000 observations.

Combine data frames after using rvest

My task is to grab baseball data from all 30 teams and combine it all into one table. However, I keep getting integer(0) as a return. Here are my data frames:
install.packages("rvest")
library(rvest)
# Store web url
baseball1 <- read_html("http://www.baseball-reference.com/teams/ARI/")
#Scrape the website for the franchise table
franch1 <- baseball1 %>%
html_nodes("#franchise_years") %>%
html_table()
franch1
# Store web url
baseball2 <- read_html("http://www.baseball-reference.com/teams/ATL/")
#Scrape the website for the franchise table
franch2 <- baseball2 %>%
html_nodes("#franchise_years") %>%
html_table()
franch2
Here is the structure of the data frame: str(franch1)
List of 1
$ :'data.frame': 18 obs. of 21 variables:
..$ Rk : int [1:18] 1 2 3 4 5 6 7 8 9 10 ...
..$ Year : int [1:18] 2015 2014 2013 2012 2011 2010 2009 2008 2007 2006 ...
..$ Tm : chr [1:18] "Arizona Diamondbacks" "Arizona Diamondbacks" "Arizona Diamondbacks" "Arizona Diamondbacks" ...
..$ Lg : chr [1:18] "NL West" "NL West" "NL West" "NL West" ...
..$ G : int [1:18] 162 162 162 162 162 162 162 162 162 162 ...
..$ W : int [1:18] 79 64 81 81 94 65 70 82 90 76 ...
..$ L : int [1:18] 83 98 81 81 68 97 92 80 72 86 ...
..$ Ties : int [1:18] 0 0 0 0 0 0 0 0 0 0 ...
..$ W-L% : num [1:18] 0.488 0.395 0.5 0.5 0.58 0.401 0.432 0.506 0.556 0.469 ...
..$ pythW-L% : num [1:18] 0.504 0.415 0.493 0.53 0.545 0.428 0.462 0.509 0.487 0.491 ...
..$ Finish : chr [1:18] "3rd of 5" "5th of 5" "2nd of 5" "3rd of 5" ...
..$ GB : chr [1:18] "13.0" "30.0" "11.0" "13.0" ...
..$ Playoffs : chr [1:18] "" "" "" "" ...
..$ R : int [1:18] 720 615 685 734 731 713 720 720 712 773 ...
..$ RA : int [1:18] 713 742 695 688 662 836 782 706 732 788 ...
..$ BatAge : num [1:18] 26.6 27.6 28.1 28.3 28.2 26.8 26.5 26.7 26.6 29.6 ...
..$ PAge : num [1:18] 27.1 28 27.6 27.4 27.4 27.9 27.7 29.4 28.2 28.8 ...
..$ #Bat : int [1:18] 50 52 44 48 51 48 45 41 47 45 ...
..$ #P : int [1:18] 27 25 23 23 25 28 24 20 26 25 ...
..$ Top Player: chr [1:18] "P.Goldschmidt (8.8)" "P.Goldschmidt (4.5)" "P.Goldschmidt (7.1)" "A.Hill (5.0)" ...
..$ Managers : chr [1:18] "C.Hale (79-83)" "K.Gibson (63-96) and A.Trammell (1-2)" "K.Gibson (81-81)" "K.Gibson (81-81)" ...
What function do I use to combine these data frames? Your help is much appreciated and let me know if I need to provide additional info.
It's because your franchise tables are listed as data frame values that needed to be converted into data frames still. Also, "read_html" didn't work for me I use "html" instead.
Try this:
# Store web url using "html" not "read_html"
baseball1 <- html("http://www.baseball-reference.com/teams/ARI/")
#Scrape the website for the franchise table
franch1 <- baseball1 %>%
html_nodes("#franchise_years") %>%
html_table()
franch1
# Store web url
baseball2 <- html("http://www.baseball-reference.com/teams/ATL/")
#Scrape the website for the franchise table
franch2 <- baseball2 %>%
html_nodes("#franchise_years") %>%
html_table()
franch2
franch1 <- as.data.frame(franch1)
franch2 <- as.data.frame(franch2)
franchMerged <- rbind(franch1, franch2)
Let me know if that works for you.

Subsetting by rows to do a correlation

I created a data frame from another dataset with 332 ID's. I split the data frame by IDs and would like to do a count rows of each ID and then do a correlation function. Can someone tell me how to do a count of the rows of each ID in order to do a correlation from these individual groups.
jlhoward your suggestion to add "table(dat1$ID)" command worked. My other problem is the function will not stop running
corr<-function(directory,threshold=)
####### file location path#####
for(i in 1:332){dat<-rbind(dat,read.csv(specdata1[i]))
dat1<-dat[complete.cases(dat),]
dat2<-(split(dat1,dat1$ID))
list(dat2)
dat3<-table(dat1$ID)
for (i in dat1>=threshold){
x<-dat1$sulfate
y<-dat1$nitrate
correlations<-cor(x,y,use="pairwise.complete.obs",method="pearson")
corrs_output<-c(corrs_output,correlations)
}
I'm trying to correlate the "sulfate" and "nitrate of each ID monitor that fits a threshold. I created a list that has all the complete cases per ID monitor. I need the function to do a correlation for "sulfate" and "nitrate of every set per ID that's => the threshold argument in the function. Below is the head and tail of the structure of the data.frame/list of each data set within the main data set "specdata1".
head of entire data.frame/list of specdata1 complete cases for
correlation
head(str(dat2,1))
List of 323
$ 1 :'data.frame': 117 obs. of 4 variables:
..$ Date : Factor w/ 4018 levels "2003-01-01","2003-01-02",..: 279 285 291 297 303 315 321 327 333 339 ...
..$ sulfate: num [1:117] 7.21 5.99 4.68 3.47 2.42 1.43 2.76 3.41 1.3 3.15 ...
..$ nitrate: num [1:117] 0.651 0.428 1.04 0.363 0.507 0.474 0.425 0.964 0.491 0.669 ...
..$ ID : int [1:117] 1 1 1 1 1 1 1 1 1 1 ...
tail of entire data.frame/list for all complete cases of specdata1
tail(str(dat2,1))
$ 99 :'data.frame': 479 obs. of 4 variables:
..$ Date : Factor w/ 4018 levels "2003-01-01","2003-01-02",..: 1774 1780 1786 1804 1810 1816 1822 1840 1852 1858 ...
..$ sulfate: num [1:479] 1.51 8.2 1.48 4.75 3.47 1.19 1.77 2.27 2.06 2.11 ...
..$ nitrate: num [1:479] 0.725 1.64 1.01 6.81 0.751 1.69 2.08 0.996 0.817 0.488 ...
..$ ID : int [1:479] 99 99 99 99 99 99 99 99 99 99 ...
[list output truncated]

Split and unsplit a dataframe in four parts

I'd like to split a dataframe in 4 equals parts, because I'd like to use the 4 cores of my computer.
I did this :
df2 <- split(df, 1:4)
unsplit(df2, f=1:4)
and that
df2 <- split(df, 1:4)
unsplit(df2, f=c('1','2','3','4')
But the unsplit function did not work, I have these warnings messages
1: In split.default(seq_along(x), f, drop = drop, ...) :
data length is not a multiple of split variable
...
Do you have an idea of the reason ?
How many rows in df? You will get that warning if the number of rows in your table is not divisible by 4. I think you are using the split factor f incorrectly, unless what you want to do is put each subsequent row into a different split data.frame.
If you really want to split your data into 4 dataframes. one row after the other then make your splitting factor the same size as the number of rows in your dataframe using rep_len like this:
## Split like this:
split(df , f = rep_len(1:4, nrow(df) ) )
## Unsplit like this:
unsplit( split(df , f = rep_len(1:4, nrow(df) ) ) , f = rep_len(1:4,nrow(df) ) )
Hopefully this example illustrates why the error occurs and how to avoid it (i.e. use a proper splitting factor!).
## Want to split our data.frame into two halves, but rows not divisible by 2
df <- data.frame( x = runif(5) )
df
## Splitting still works but...
## We get a warning because the split factor 'f' was not recycled as a multiple of it's length
split( df , f = 1:2 )
#$`1`
# x
#1 0.6970968
#3 0.5614762
#5 0.5910995
#$`2`
# x
#2 0.6206521
#4 0.1798006
Warning message:
In split.default(x = seq_len(nrow(x)), f = f, drop = drop, ...) :
data length is not a multiple of split variable
## Instead let's use the same split levels (1:2)...
## but make it equal to the length of the rows in the table:
splt <- rep_len( 1:2 , nrow(df) )
splt
#[1] 1 2 1 2 1
## Split works, and f is not recycled because there are
## the same number of values in 'f' as rows in the table
split( df , f = splt )
#$`1`
# x
#1 0.6970968
#3 0.5614762
#5 0.5910995
#$`2`
# x
#2 0.6206521
#4 0.1798006
## And unsplitting then works as expected and reconstructs our original data.frame
unsplit( split( df , f = splt ) , f = splt )
# x
#1 0.6970968
#2 0.6206521
#3 0.5614762
#4 0.1798006
#5 0.5910995
In the R language 'split' example . . .
aq <- airquality
g <- aq$Month
l <- split(aq,g)
After the 'scale' function is executed
l <- lapply(l, transform, Ozone = scale(Ozone))
I am guessing that at one time in R history
the function 'scale' did not add extra attributes
to the column it is modifying.
..$ Ozone : num ...
.. ..- attr(*, "scaled:center")= num 29.4
.. ..- attr(*, "scaled:scale")= num 18.2
As seen in here . . .
> str(l)
List of 5
$ 5:'data.frame': 31 obs. of 6 variables:
..$ Ozone : num [1:31, 1] 0.782 0.557 -0.523 -0.253 NA ...
.. ..- attr(*, "scaled:center")= num 23.6
.. ..- attr(*, "scaled:scale")= num 22.2
..$ Solar.R: int [1:31] 190 118 149 313 NA NA 299 99 19 194 ...
..$ Wind : num [1:31] 7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ...
..$ Temp : int [1:31] 67 72 74 62 56 66 65 59 61 69 ...
..$ Month : int [1:31] 5 5 5 5 5 5 5 5 5 5 ...
..$ Day : int [1:31] 1 2 3 4 5 6 7 8 9 10 ...
$ 6:'data.frame': 30 obs. of 6 variables:
..$ Ozone : num [1:30, 1] NA NA NA NA NA ...
.. ..- attr(*, "scaled:center")= num 29.4
.. ..- attr(*, "scaled:scale")= num 18.2
..$ Solar.R: int [1:30] 286 287 242 186 220 264 127 273 291 323 ...
..$ Wind : num [1:30] 8.6 9.7 16.1 9.2 8.6 14.3 9.7 6.9 13.8 11.5 ...
..$ Temp : int [1:30] 78 74 67 84 85 79 82 87 90 87 ...
..$ Month : int [1:30] 6 6 6 6 6 6 6 6 6 6 ...
..$ Day : int [1:30] 1 2 3 4 5 6 7 8 9 10 ...
$ 7:'data.frame': 31 obs. of 6 variables:
..$ Ozone : num [1:31, 1] 2.399 -0.32 -0.857 NA 0.154 ...
.. ..- attr(*, "scaled:center")= num 59.1
.. ..- attr(*, "scaled:scale")= num 31.6
..$ Solar.R: int [1:31] 269 248 236 101 175 314 276 267 272 175 ...
..$ Wind : num [1:31] 4.1 9.2 9.2 10.9 4.6 10.9 5.1 6.3 5.7 7.4 ...
..$ Temp : int [1:31] 84 85 81 84 83 83 88 92 92 89 ...
..$ Month : int [1:31] 7 7 7 7 7 7 7 7 7 7 ...
..$ Day : int [1:31] 1 2 3 4 5 6 7 8 9 10 ...
$ 8:'data.frame': 31 obs. of 6 variables:
..$ Ozone : num [1:31, 1] -0.528 -1.284 -1.108 0.455 -0.629 ...
.. ..- attr(*, "scaled:center")= num 60
.. ..- attr(*, "scaled:scale")= num 39.7
..$ Solar.R: int [1:31] 83 24 77 NA NA NA 255 229 207 222 ...
..$ Wind : num [1:31] 6.9 13.8 7.4 6.9 7.4 4.6 4 10.3 8 8.6 ...
..$ Temp : int [1:31] 81 81 82 86 85 87 89 90 90 92 ...
..$ Month : int [1:31] 8 8 8 8 8 8 8 8 8 8 ...
..$ Day : int [1:31] 1 2 3 4 5 6 7 8 9 10 ...
$ 9:'data.frame': 30 obs. of 6 variables:
..$ Ozone : num [1:30, 1] 2.674 1.928 1.721 2.467 0.644 ...
.. ..- attr(*, "scaled:center")= num 31.4
.. ..- attr(*, "scaled:scale")= num 24.1
..$ Solar.R: int [1:30] 167 197 183 189 95 92 252 220 230 259 ...
..$ Wind : num [1:30] 6.9 5.1 2.8 4.6 7.4 15.5 10.9 10.3 10.9 9.7 ...
..$ Temp : int [1:30] 91 92 93 93 87 84 80 78 75 73 ...
..$ Month : int [1:30] 9 9 9 9 9 9 9 9 9 9 ...
..$ Day : int [1:30] 1 2 3 4 5 6 7 8 9 10 ...
But now it does add those attributes
..$ Ozone : num ...
.. ..- attr(*, "scaled:center")= num 29.4
.. ..- attr(*, "scaled:scale")= num 18.2
and the very simple 'unsplit' function is not programmed to handle those attributes.
> unsplit(l,g)
Error in xj[i, , drop = FALSE] : (subscript) logical subscript too long
The (direct and simple) solution is to get rid of those attributes.
attributes(l[[1]]$Ozone) <- NULL
attributes(l[[2]]$Ozone) <- NULL
attributes(l[[3]]$Ozone) <- NULL
attributes(l[[4]]$Ozone) <- NULL
attributes(l[[5]]$Ozone) <- NULL
Then try to unsplit again.
str( unsplit(l,g) )
> str( unsplit(l,g) )
'data.frame': 153 obs. of 6 variables:
$ Ozone : num 0.782 0.557 -0.523 -0.253 NA ...
$ Solar.R: int 190 118 149 313 NA NA 299 99 19 194 ...
$ Wind : num 7.4 8 12.6 11.5 14.3 14.9 8.6 13.8 20.1 8.6 ...
$ Temp : int 67 72 74 62 56 66 65 59 61 69 ...
$ Month : int 5 5 5 5 5 5 5 5 5 5 ...
$ Day : int 1 2 3 4 5 6 7 8 9 10 ...
So, now it works.
Andre Mikulec

Resources