retain dplyr::group_by columns when using tidyr::nest() - r

Take the following example in R
library(dplyr)
library(tidyr)
mtcars_cyl <- mtcars %>% group_by(cyl) %>% nest()
if we look at the column names of mtcars_cyl, we see that cyl is no longer included.
mtcars_cyl$data[[1]] %>% colnames()
[1] "mpg" "disp" "hp" "drat" "wt" "qsec" "vs" "am" "gear" "carb"
I was expecting to find some method/option for retaining the group_by
columns within data, but finding a solution is escaping me. I can understand this might be a niche need. As an example, one might want to create a table of each group_by data frame and include cyl as a column in that output.
library(pander)
mtcars_cyl$data %>% pander::pander()
In other cases, when using in combination with purrr, one might need to include the group_by columns in a function call.

You can use split(mtcars, mtcars$cyl) instead. This gives a list of data frames.
split(mtcars, mtcars$cyl)
#> $`4`
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
#> Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
#> Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
#> Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1
#> Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2
#> Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1
#> Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1
#> Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1
#> Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2
#>
#> $`6`
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1
#> Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1
#> Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4
#> Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4
#> Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6
#>
#> $`8`
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
#> Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
#> Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3
#> Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3
#> Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3
#> Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4
#> Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4
#> Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4
#> Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2
#> AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2
#> Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4
#> Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2
#> Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4
#> Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8

Generally, I tend to use nest() but also miss the grouping variables.
It is rarely a problem in workflows where the nested data is passed to purrr::pmap functions. This work flow allows for subsetting data with nest and apply functions to the nested dataframes including the grouping variables.
library(dplyr)
library(tidyr)
mtcars_cyl <- mtcars %>% group_by(cyl) %>% nest()
# The nested data
mtcars_cyl
# A tibble: 3 x 2
cyl data
<dbl> <list>
1 6 <tibble [7 x 10]>
2 4 <tibble [11 x 10]>
3 8 <tibble [14 x 10]>
# The nested data is summarized and returned with the grouping variable intact
mtcars_cyl %>%
purrr::pmap_dfr(function(cyl, data) {
data %>%
summarise_if(is.numeric, mean) %>%
mutate(cyl = cyl))
}
# A tibble: 3 x 11
mpg disp hp drat wt qsec vs am gear carb cyl
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 19.7 183. 122. 3.59 3.12 18.0 0.571 0.429 3.86 3.43 6
2 26.7 105. 82.6 4.07 2.29 19.1 0.909 0.727 4.09 1.55 4
3 15.1 353. 209. 3.23 4.00 16.8 0 0.143 3.29 3.5 8
For an indept discussion on split vs nest see this

Related

R SQL templating with glue_sql, ability to dynamically drop where clause

TLDR
I would like to be able to template SQL queries and run them in R. The glue package and DBI work great, but I can't figure out a way to template statements. In other words, is there a way to do something like this (borrowing from jinja):
SELECT * FROM mtcars
{% if length( {make} ) > 0 %}
WHERE make IN( {make*}
{% end %}
Additional Detail
DBI and glue work great for a single use case, but often I want to reuse the same general SQL code with a few different variations of WHERE clauses and things like that. Often I want the WHERE to be "off". in some of the use cases and not in others (e.g. for WHERE IN() it defaults to all values, for WHERE x >= y it doesn't apply the conditional at all, etc.).
The only solution I can find is to evaluate inputs in R as discussed here, and then pass a default vector or the input. This approach works in some use cases and not at all in others. I think it makes it harder to generalize and has a performance hit in my most common use case - when I want a query with a parameter that passes values to a WHERE IN() clause, but defaults to all values. If the table is evolving (i.e. all values changes over time) then I need to first run a query to get all values, then input them if the user doesn't provide values. That can be expensive on larger tables and prohibitive if it's in a user experience (shiny).
library(DBI)
library(glue)
library(dplyr, warn.conflicts = F)
# Setup local DB ####
con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
mtcars_df <- tibble::rownames_to_column(mtcars, var = "make")
str(mtcars_df)
#> 'data.frame': 32 obs. of 12 variables:
#> $ make: chr "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive" ...
#> $ mpg : num 21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
#> $ cyl : num 6 6 4 6 8 6 8 4 4 6 ...
#> $ disp: num 160 160 108 258 360 ...
#> $ hp : num 110 110 93 110 175 105 245 62 95 123 ...
#> $ drat: num 3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
#> $ wt : num 2.62 2.88 2.32 3.21 3.44 ...
#> $ qsec: num 16.5 17 18.6 19.4 17 ...
#> $ vs : num 0 0 1 1 0 1 0 1 1 1 ...
#> $ am : num 1 1 1 0 0 0 0 0 0 0 ...
#> $ gear: num 4 4 4 3 3 3 3 4 4 4 ...
#> $ carb: num 4 4 1 1 2 1 4 2 2 4 ...
DBI::dbWriteTable(con, "mtcars", mtcars_df)
# Example query ####
sql <- glue::glue_sql("SELECT * FROM mtcars WHERE make IN( {make*} )", make = c("Fiat X1-9", "Datsun 710"), .con = con)
DBI::dbGetQuery(con, sql)
#> make mpg cyl disp hp drat wt qsec vs am gear carb
#> 1 Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
#> 2 Fiat X1-9 27.3 4 79 66 4.08 1.935 18.90 1 1 4 1
# Templating ####
sql <- "SELECT * FROM mtcars WHERE make IN( {make*} )"
sql_template <- tempfile(fileext = ".sql")
readr::write_file(sql, sql_template)
read_sql <- function(file, ..., .con, .envir = parent.frame()){
sql <- readr::read_file(file)
sql <- glue::glue_sql(sql, ..., .con = .con, .envir = .envir)
}
# SQL files can be templated and called from R
sql <- read_sql(sql_template, make = c("Fiat X1-9", "Datsun 710"), .con = con)
DBI::dbGetQuery(con, sql)
#> make mpg cyl disp hp drat wt qsec vs am gear carb
#> 1 Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
#> 2 Fiat X1-9 27.3 4 79 66 4.08 1.935 18.90 1 1 4 1
# All {values} must be provided, errors out
sql <- read_sql(sql_template, .con = con)
#> Error in eval(parse(text = text, keep.source = FALSE), envir): object 'make' not found
# Doesn't return anything
sql <- read_sql(sql_template, make = DBI::SQL(""), .con = con)
print(sql)
#> <SQL> SELECT * FROM mtcars WHERE make IN( )
DBI::dbGetQuery(con, sql)
#> [1] make mpg cyl disp hp drat wt qsec vs am gear carb
#> <0 rows> (or 0-length row.names)
# Can't make the entire where clause a parameter either without doing a lot of escapes and basically defeating the purppose of glue
sql <- glue::glue_sql("SELECT * FROM mtcars {makes}", makes = "WHERE make IN('Fiat X1-9', 'Datsun 710')", .con = con)
print(sql)
#> <SQL> SELECT * FROM mtcars 'WHERE make IN(''Fiat X1-9'', ''Datsun 710'')'
DBI::dbGetQuery(con, sql)
#> make mpg cyl disp hp drat wt qsec vs am gear carb
#> 1 Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4
#> 2 Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4
#> 3 Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
#> 4 Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1
#> 5 Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
#> 6 Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1
#> 7 Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
#> 8 Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
#> 9 Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
#> 10 Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4
#> 11 Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4
#> 12 Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3
#> 13 Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3
#> 14 Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3
#> 15 Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4
#> 16 Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4
#> 17 Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4
#> 18 Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1
#> 19 Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2
#> 20 Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1
#> 21 Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1
#> 22 Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2
#> 23 AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2
#> 24 Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4
#> 25 Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2
#> 26 Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1
#> 27 Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2
#> 28 Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2
#> 29 Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4
#> 30 Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6
#> 31 Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8
#> 32 Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2
# Get all values first
all_makes <- DBI::dbGetQuery(con, "SELECT DISTINCT make FROM mtcars") %>% dplyr::pull(make)
sql <- read_sql(sql_template, make = all_makes, .con = con)
DBI::dbGetQuery(con, sql)
#> make mpg cyl disp hp drat wt qsec vs am gear carb
#> 1 Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4
#> 2 Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4
#> 3 Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
#> 4 Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1
#> 5 Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
#> 6 Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1
#> 7 Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
#> 8 Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
#> 9 Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
#> 10 Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4
#> 11 Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4
#> 12 Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3
#> 13 Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3
#> 14 Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3
#> 15 Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4
#> 16 Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4
#> 17 Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4
#> 18 Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1
#> 19 Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2
#> 20 Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1
#> 21 Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1
#> 22 Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2
#> 23 AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2
#> 24 Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4
#> 25 Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2
#> 26 Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1
#> 27 Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2
#> 28 Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2
#> 29 Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4
#> 30 Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6
#> 31 Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8
#> 32 Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2
# Templating with a conditional####
sql <- "SELECT * FROM mtcars WHERE cyl >= {cyl} "
sql_template <- tempfile(fileext = ".sql")
readr::write_file(sql, sql_template)
read_sql <- function(file, ..., .con, .envir = parent.frame()){
sql <- readr::read_file(file)
sql <- glue::glue_sql(sql, ..., .con = .con, .envir = .envir)
}
# No way to use the all values approach since it's a one sided conditional
sql <- read_sql(sql_template, cyl = 8, .con = con)
DBI::dbGetQuery(con, sql)
#> make mpg cyl disp hp drat wt qsec vs am gear carb
#> 1 Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
#> 2 Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
#> 3 Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3
#> 4 Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3
#> 5 Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3
#> 6 Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4
#> 7 Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4
#> 8 Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4
#> 9 Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2
#> 10 AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2
#> 11 Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4
#> 12 Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2
#> 13 Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4
#> 14 Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8
You can use multiple arguments to glue::glue_sql:
# con <- dbConnect(...)
make <- c()
glue::glue_sql(
"select * from mtcars",
if (length(make)) " where make in ({make*})" else "",
.con = con)
# <SQL> select * from mtcars
make <- c("Fiat X1-9", "Datsun 710")
glue::glue_sql( # unchanged
"select * from mtcars",
if (length(make)) " where make in ({make*})" else "",
.con = con)
# <SQL> select * from mtcars where make in ('Fiat X1-9', 'Datsun 710')
Using jinjar v0.2.0:
query <- "SELECT * FROM mtcars
{% if length(make) > 0 -%}
WHERE make IN ({{ quote_sql(make) }})
{%- endif %}"
jinjar::render(query, make = c()) |> writeLines()
#> SELECT * FROM mtcars
jinjar::render(query, make = c("Fiat X1-9", "Datsun 710")) |> writeLines()
#> SELECT * FROM mtcars
#> WHERE make IN ('Fiat X1-9', 'Datsun 710')
Created on 2022-06-24 by the reprex package (v2.0.1)

How to randomly sample multiple consecutive rows of a dataframe in R?

I've a dataframe with 100 rows and 20 columns and want to randomly sample 5 times 10 consecutive rows, e.g. 10:19, 25:34, etc. With: sample_n( df, 5 ) I'm able to extract 5 unique, randomly sampled rows, but don't know how to sample consecutive rows. Any help? Thanks!
df <- mtcars
df$row_nm <- seq(nrow(df))
set.seed(7)
sample_seq <- function(n, N) {
i <- sample(seq(N), size = 1)
ifelse(
test = i + (seq(n) - 1) <= N,
yes = i + (seq(n) - 1),
no = i + (seq(n) - 1) - N
)
}
replica <- replicate(n = 5, sample_seq(n = 10, N = nrow(df)))
# result
lapply(seq(ncol(replica)), function(x) df[replica[, x], ])
#> [[1]]
#> mpg cyl disp hp drat wt qsec vs am gear carb row_nm
#> Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4 10
#> Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4 11
#> Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3 12
#> Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3 13
#> Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3 14
#> Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4 15
#> Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4 16
#> Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4 17
#> Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1 18
#> Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2 19
#>
#> [[2]]
#> mpg cyl disp hp drat wt qsec vs am gear carb row_nm
#> Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2 19
#> Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1 20
#> Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1 21
#> Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2 22
#> AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2 23
#> Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4 24
#> Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2 25
#> Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1 26
#> Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2 27
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2 28
#>
#> [[3]]
#> mpg cyl disp hp drat wt qsec vs am gear carb row_nm
#> Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8 31
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2 32
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 1
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 2
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 3
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1 4
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 5
#> Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1 6
#> Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 7
#> Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 8
#>
#> [[4]]
#> mpg cyl disp hp drat wt qsec vs am gear carb row_nm
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2 28
#> Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4 29
#> Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6 30
#> Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8 31
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2 32
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 1
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 2
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 3
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1 4
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 5
#>
#> [[5]]
#> mpg cyl disp hp drat wt qsec vs am gear carb row_nm
#> Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 7
#> Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 8
#> Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2 9
#> Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4 10
#> Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4 11
#> Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3 12
#> Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3 13
#> Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3 14
#> Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4 15
#> Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4 16
Created on 2022-01-24 by the reprex package (v2.0.1)
You could so something like:
#sample data
df <- data.table(value = 1:100000)
#function which sampled consecutive rows (x = dataframe, rows = nr of consecutive rows, nr = amount of times you want to sample consecutive rows)
sample_fun <- function(x, rows, nr){
#maximum number which can be sampled
numbers <- 1:(nrow(x) - rows)
#randomly sample 5 numbers
sampled.numbers <- sample(numbers, nr)
#convert to vector (5 consecutive)
sampled.rows <- lapply(sampled.numbers, function(x){seq(x, (x+rows-1), 1)})
sampled.rows <- do.call(c, sampled.rows)
#sample and return
result <- x[sampled.rows,]
return(result)
}
sample_fun(x = df, rows = 5, nr = 2)
You don't mention if this can include replacement (i.e. if you sample 10:19, can you then also sample 15:24?). You also don't mention if you can sample anything above row 91, which would mean that sample of 10 gets cut off (i.e. 98,99,100 would only be 3 consecutive rows unless you want that to loop back to row 1). Assuming you can sample any value with replacement, the solution can be done in one line:
sapply(sample(1:100,5),function(x){seq(x,x+9)})
This applies the sequence function to each of 5 individually sampled numbers. The output will be a matrix, where each column is a sample of 10 consecutive rows, but as noted, these will potentially overlap, or go above 100.
If you want a solution where the rows will not overlap at all, and avoiding values over 100, without making values above 91 less likely to be sampled, this actually gets kind of trick, but I think the code below should work. You cant just sample from 1:91 without affect probability of your random sample, because then this means a value like 100 actually only has a 1/91 probability of being sampled (the sample value has to be 91), where other values don't involve that same constraint. This solution makes it so all rows are equally likely to be sampled.
Rows=c(1:100,1:100)
SampleRows=matrix(0,nrow=10,ncol=5)
for(i in 1:ncol(SampleRows)){
SampledValue=sample(Rows,1)
RowsIndex=min(which(Rows==SampledValue))
Sequence=Rows[RowsIndex:(RowsIndex+9)]
SampleRows[,i]=Sequence
Rows=Rows[!(Rows %in% Sequence)]
}
This approach creates a vector that sequences from 1:100, repeated twice (variable Rows), you'll see why this is important in a bit. For each of 5 iterations (corresponding to 5 samples), we take a sampled value from Rows, which will be a number 1:100, we then figure out where that number is in Rows, and take all 9 values next to it. In the first sample this will always be 10 consecutive numbers (e.g. 20:29). But then we remove those sampled values from Rows. If we happen to get the next sample as a value that would lead to overlap (like 18), then instead it samples (18,19,30,31,32,33,34...) since 20:29 have been removed. We need to do 1:100 twice in Rows, so that if we sample a value like 99, it resets from 100, back to 1.
If you want your output in a vector,throw in this at the end
sort(as.vector(SampleRows))
Let me know if this works for the needs of your problem.

Cleaner way to reshape dataframe with many variables in R [duplicate]

This question already has answers here:
Reshaping data.frame from wide to long format
(8 answers)
Closed 1 year ago.
So I want to reshape my wide format dataframe, and my varying variables range from item01-item21. Is there a shortcut that i can use instead of manually typing item01, item02, etc? This is the code I have now:
RTdataLong <- reshape(RTdata,direction="long",idvar=c("ID","Language","Gender"), varying=list(c("Time01","Time02","Time03","Time04","Time05","Time06","Time07","Time08","Time09","Time10","Time11","Time12","Time13","Time14", "Time15","Time16","Time17","Time18","Time19","Time20","Time21")))
It works, but I would really appreicate it if someone could give me some tips on how to do this more efficiently.
You don't provide an exmaple data but you could use tidyr::pivot_longer like so:
library(tidyverse)
mtcars
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
#> Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1
#> Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
#> Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
#> Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
#> Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4
#> Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4
#> Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3
#> Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3
#> Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3
#> Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4
#> Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4
#> Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4
#> Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1
#> Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2
#> Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1
#> Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1
#> Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2
#> AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2
#> Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4
#> Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2
#> Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1
#> Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2
#> Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4
#> Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6
#> Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2
mtcars %>%
pivot_longer(cols = 1:11, names_to = "col_name")
#> # A tibble: 352 x 2
#> col_name value
#> <chr> <dbl>
#> 1 mpg 21
#> 2 cyl 6
#> 3 disp 160
#> 4 hp 110
#> 5 drat 3.9
#> 6 wt 2.62
#> 7 qsec 16.5
#> 8 vs 0
#> 9 am 1
#> 10 gear 4
#> # ... with 342 more rows
Created on 2021-09-15 by the reprex package (v2.0.1)

Modifying dataframe within a list-column

I have a dataframe with a list-column which itself contains dataframes (see below). Essentially, I am trying to add values from another column in the parent dataframe into the smaller dataframe by creating another column.
This is a simplified example- my real application is more complex.
library(tidyverse)
# What I am trying to do: add column "a" to dataframe within the list column
add_column(mtcars, a = 1)
#> mpg cyl disp hp drat wt qsec vs am gear carb a
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4 1
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4 1
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1 1
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1 1
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2 1
#> Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1 1
#> Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4 1
#> Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2 1
#> Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2 1
#> Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4 1
#> Merc 280C 17.8 6 167.6 123 3.92 3.440 18.90 1 0 4 4 1
#> Merc 450SE 16.4 8 275.8 180 3.07 4.070 17.40 0 0 3 3 1
#> Merc 450SL 17.3 8 275.8 180 3.07 3.730 17.60 0 0 3 3 1
#> Merc 450SLC 15.2 8 275.8 180 3.07 3.780 18.00 0 0 3 3 1
#> Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250 17.98 0 0 3 4 1
#> Lincoln Continental 10.4 8 460.0 215 3.00 5.424 17.82 0 0 3 4 1
#> Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4 1
#> Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1 1
#> Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2 1
#> Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1 1
#> Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1 1
#> Dodge Challenger 15.5 8 318.0 150 2.76 3.520 16.87 0 0 3 2 1
#> AMC Javelin 15.2 8 304.0 150 3.15 3.435 17.30 0 0 3 2 1
#> Camaro Z28 13.3 8 350.0 245 3.73 3.840 15.41 0 0 3 4 1
#> Pontiac Firebird 19.2 8 400.0 175 3.08 3.845 17.05 0 0 3 2 1
#> Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1 1
#> Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2 1
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2 1
#> Ford Pantera L 15.8 8 351.0 264 4.22 3.170 14.50 0 1 5 4 1
#> Ferrari Dino 19.7 6 145.0 175 3.62 2.770 15.50 0 1 5 6 1
#> Maserati Bora 15.0 8 301.0 335 3.54 3.570 14.60 0 1 5 8 1
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2 1
Then create list-column:
(df <- tibble(data = rep(list(mtcars), times = 3), a = 1:3))
#> # A tibble: 3 x 2
#> data a
#> <list> <int>
#> 1 <data.frame [32 x 11]> 1
#> 2 <data.frame [32 x 11]> 2
#> 3 <data.frame [32 x 11]> 3
But this doesn't work:
df %>%
rowwise() %>%
modify_at("data", ~ add_column(., a = a))
# Error in eval_tidy(xs[[i]], unique_output): object 'a' not found
We may use
df %>% mutate(data = data %>% map2(a, ~add_column(.x, a = .y)))
In this way we start by mutating a column as usual, but then recognising that it's a list we use map2 along with the a column.

How do I add a prefix to several variable names using dplyr?

I'm trying to add a common prefix to each of the variable names in a data.frame. For example, using the mtcars data, I could add the prefix "cars." using the following code:
> data(mtcars)
> names(mtcars)
[1] "mpg" "cyl" "disp" "hp" "drat" "wt" "qsec" "vs"
[9] "am" "gear" "carb"
> names(mtcars) <- paste0("cars.", names(mtcars))
> names(mtcars)
[1] "cars.mpg" "cars.cyl" "cars.disp" "cars.hp"
[5] "cars.drat" "cars.wt" "cars.qsec" "cars.vs"
[9] "cars.am" "cars.gear" "cars.carb"
However, I would like to do this as part of a piped operation (i.e., a series of functions strung together using %>%), using some of the dplyr syntax. It seems like some combination of rename and everything() should do the trick, but I don't know how to make it work. Does anyone have any ideas?
Indeed, you can use rename_ (NSE rename itself doesn’t work):
data %>% rename_(.dots = setNames(names(.), paste0('cars.', names(.))))
… but honestly, why? Just assigning names directly is shorter and more readable:
data %>% setNames(paste0('cars.', names(.)))
The latest solution (2020) seems to use rename_with, which is available in dplyr 1.0.0 and higher:
mtcars %>% rename_with(.fn = ~ paste0("Myprefix_", .x, "_Mypostfix")) -> mtcars.custom
Use the .cols = argument to specify a subset of variables, it defaults to everything().
For future readers, dplyr now can do this with the select_if, select_at, and select_all functions:
dplyr::select_all(mtcars, .funs = funs(paste0("cars.", .)))
Another dplyr solution:
I find it easiest with the dplyr rename_all, rename_at, rename_if which from v.1.0.4. have been superseded by rename_with...
Try this for renaming all column names:
mtcars %>% rename_all(function(x){paste0("cars.", x)}) # older dplyr versions
mtcars %>% rename_with(.cols = everything(), function(x){paste0("cars.", x)}) # v.1.0.4.
Try this for renaming "some" column names:
mtcars %>% rename_at(vars(hp:wt) ,function(x){paste0("cars.", x)}) # older dplyr versions
mtcars %>% rename_with(.cols = hp:wt, function(x){paste0("cars.", x)}) # v.1.0.4.
dplyr now expects lists and will throw a warning:
Warning message:
funs() is soft deprecated as of dplyr 0.8.0
Please use a list of either functions or lambdas:
# Simple named list:
list(mean = mean, median = median)
# Auto named with `tibble::lst()`:
tibble::lst(mean, median)
# Using lambdas
list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
you can solve this example as follows:
dplyr::select_all(mtcars, list(~ paste0("cars.", .)))
#> cars.mpg cars.cyl cars.disp cars.hp cars.drat cars.wt
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875
#> Datsun 710 22.8 4 108.0 93 3.85 2.320
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440
#> Valiant 18.1 6 225.0 105 2.76 3.460
#> Duster 360 14.3 8 360.0 245 3.21 3.570
#> Merc 240D 24.4 4 146.7 62 3.69 3.190
#> Merc 230 22.8 4 140.8 95 3.92 3.150
#> Merc 280 19.2 6 167.6 123 3.92 3.440
#> Merc 280C 17.8 6 167.6 123 3.92 3.440
#> Merc 450SE 16.4 8 275.8 180 3.07 4.070
#> Merc 450SL 17.3 8 275.8 180 3.07 3.730
#> Merc 450SLC 15.2 8 275.8 180 3.07 3.780
#> Cadillac Fleetwood 10.4 8 472.0 205 2.93 5.250
#> Lincoln Continental 10.4 8 460.0 215 3.00 5.424
#> Chrysler Imperial 14.7 8 440.0 230 3.23 5.345
#> Fiat 128 32.4 4 78.7 66 4.08 2.200
#> Honda Civic 30.4 4 75.7 52 4.93 1.615
#> Toyota Corolla 33.9 4 71.1 65 4.22 1.835
#> Toyota Corona 21.5 4 120.1 97 3.70 2.465
#> Dodge Challenger 15.5 8 318.0 150 2.76 3.520
#> AMC Javelin 15.2 8 304.0 150 3.15 3.435
#> Camaro Z28 13.3 8 350.0 245 3.73 3.840
#> Pontiac Firebird 19.2 8 400.0 175 3.08 3.845
#> Fiat X1-9 27.3 4 79.0 66 4.08 1.935
#> Porsche 914-2 26.0 4 120.3 91 4.43 2.140
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513
#> Ford Pantera L 15.8 8 351.0 264 4.22 3.170
#> Ferrari Dino 19.7 6 145.0 175 3.62 2.770
#> Maserati Bora 15.0 8 301.0 335 3.54 3.570
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780
#> cars.qsec cars.vs cars.am cars.gear cars.carb
#> Mazda RX4 16.46 0 1 4 4
#> Mazda RX4 Wag 17.02 0 1 4 4
#> Datsun 710 18.61 1 1 4 1
#> Hornet 4 Drive 19.44 1 0 3 1
#> Hornet Sportabout 17.02 0 0 3 2
#> Valiant 20.22 1 0 3 1
#> Duster 360 15.84 0 0 3 4
#> Merc 240D 20.00 1 0 4 2
#> Merc 230 22.90 1 0 4 2
#> Merc 280 18.30 1 0 4 4
#> Merc 280C 18.90 1 0 4 4
#> Merc 450SE 17.40 0 0 3 3
#> Merc 450SL 17.60 0 0 3 3
#> Merc 450SLC 18.00 0 0 3 3
#> Cadillac Fleetwood 17.98 0 0 3 4
#> Lincoln Continental 17.82 0 0 3 4
#> Chrysler Imperial 17.42 0 0 3 4
#> Fiat 128 19.47 1 1 4 1
#> Honda Civic 18.52 1 1 4 2
#> Toyota Corolla 19.90 1 1 4 1
#> Toyota Corona 20.01 1 0 3 1
#> Dodge Challenger 16.87 0 0 3 2
#> AMC Javelin 17.30 0 0 3 2
#> Camaro Z28 15.41 0 0 3 4
#> Pontiac Firebird 17.05 0 0 3 2
#> Fiat X1-9 18.90 1 1 4 1
#> Porsche 914-2 16.70 0 1 5 2
#> Lotus Europa 16.90 1 1 5 2
#> Ford Pantera L 14.50 0 1 5 4
#> Ferrari Dino 15.50 0 1 5 6
#> Maserati Bora 14.60 0 1 5 8
#> Volvo 142E 18.60 1 1 4 2
Created on 2019-07-31 by the reprex package (v0.3.0)

Resources