Related
This is a follow-up to a previous question of mine:
Code in R to conditionally subtract columns in data frames
I now want to apply the given solution to my previous problem
cols <- grep('^\\d+$', names(df), value = TRUE)
new_cols <- paste0(cols, '_corrected')
df[new_cols] <- df[cols] - df[paste0('Background_', cols)]
df[c("Wavelength", new_cols)]
to every data frame in a list. I import all sheets of an excel file so that every sheet becomes one data frame in a list using this code (courtesy of Read all worksheets in an Excel workbook into an R list with data.frames 's top answer):
read_excel_allsheets <- function(filename, tibble = FALSE) {
sheets <- readxl::excel_sheets(filename)
x <- lapply(sheets, function(X) readxl::read_excel(filename, sheet = X))
if(!tibble) x <- lapply(x, as.data.frame)
names(x) <- sheets
x
}
mysheets <- read_excel_allsheets(file.choose())
How do I apply the first code box to my data frame list?
I want to get from something like this:
df_1 <- structure(list(Wavelength = 300:301, Background_1 = c(5L, 3L),
`1` = c(11L, 12L), Background_2 = c(4L, 5L), `2` = c(12L, 10L)),
class = "data.frame", row.names = c(NA, -2L))
df_2 <- structure(list(Wavelength = 300:301, Background_1 = c(6L, 4L),
`1` = c(10L, 13L), Background_2 = c(5L, 6L), `2` = c(11L, 11L),
Background_3 = c(4L, 6L), `3` = c(13L, 13L)),
class = "data.frame", row.names = c(NA, -2L))
df_list <- list(df_1, df_2)
To something like this:
df_1_corrected <- structure(list(Wavelength = 300:301, `1_corrected` = c(6L, 9L),
`2_corrected` = c(8L, 5L)),
class = "data.frame", row.names = c(NA, -2L))
df_2_corrected <- structure(list(Wavelength =300:301, `1_corrected` = c(4L, 9L),
`2_corrected` = c(6L, 5L),
`3_corrected` = c(9L, 7L)),
class = "data.frame", row.names = c(NA, -2L))
df_corrected_list <- list(df_1_corrected, df_2_corrected)
actual data excerpt
Wavelength Background 1 1 Background 2 2 Background 3 3
300 273290.0 337670.0 276740.0 397530 288500.0 367480.0
301 299126.7 375143.3 299273.3 432250 310313.3 394796.7
I have read the lapply function would be used for this but i have never used it before, as I am quite the beginner in R.
Help is much appreciated!
You can put the code in a function and apply it for each dataframe in list using lapply :
subtract_values <- function(df) {
cols <- grep('^\\d+$', names(df), value = TRUE)
new_cols <- paste0(cols, '_corrected')
df[new_cols] <- df[cols] - df[paste0('Background ', cols)]
df[c("Wavelength", new_cols)]
}
lapply(df_list, subtract_values)
#[[1]]
# Wavelength 1_corrected 2_corrected
#1 300 6 8
#2 301 9 5
#[[2]]
# Wavelength 1_corrected 2_corrected 3_corrected
#1 300 4 6 9
#2 301 9 5 7
I have two data.frames as follows:
a$id <- as.data.frame(c("1-23-2", "2-3-231-2", "122-121"))
b$id <- as.data.frame(c("1-23-2", "122-121", "12-1223-12", "1221-12"))
I want to check, if all values of a can be found in b.
I tried this:
if (a$id %in% b$id){a$test <- "yes"} else {a$test <- "no"}
Which gives a warning message and the wrong result unfortunately.
Use ifelse.
a$test <- ifelse(a$id %in% b$id, "yeah", "no")
a
# id test
# 1 1-23-2 yeah
# 2 2-3-231-2 no
# 3 122-121 yeah
Data
a <- structure(list(id = structure(c(1L, 3L, 2L), .Label = c("1-23-2",
"122-121", "2-3-231-2"), class = "factor")), class = "data.frame", row.names = c(NA,
-3L))
b <- structure(list(id = structure(c(1L, 3L, 2L, 4L), .Label = c("1-23-2",
"12-1223-12", "122-121", "1221-12"), class = "factor")), class = "data.frame", row.names = c(NA,
-4L))
You may have several base R approaches to make it, e.g.,
a <- within(a,test <- ifelse(id %in% b$id,"yes","no"))
or
a <- within(a,test <- c("yes","no")[(!id%in% b$id) + 1])
or
a <- within(a,test <- c("yes","no")[is.na(match(id,b$id))+1])
such that
> a
id test
1 1-23-2 yes
2 2-3-231-2 no
3 122-121 yes
DATA
a <- data.frame(id = c("1-23-2", "2-3-231-2", "122-121"))
b <- data.frame(id = c("1-23-2", "122-121", "12-1223-12", "1221-12"))
I have just started my journey with R. I want to test values across multiple columns for the same condition and return 5 if any of the values is "hello" within a row:
result = ifelse((myData[1] == "hello") | (myData[2] == "hello") | (myData[3] == "hello"), 5, 0)
This works fine, but code seems to be redundant. When I do:
resultSec = ifelse(myData[1:3] == "hello", 5, 0)
Then all 3 columns are checked against the condition, but the result I get is not a single column, but 3 columns. So then I would have to perform an additional comparison for all columns which makes totally more lines of code then the first redundant method.
How can I get in this case a one column of values in efficient way ?
You can use the function apply() to iterate over a data.frame or matrix, by either columns or rows. The margin argument determines which one you use.
Here we want to check the rows, so we use margin = 1:
dat <- data.frame(col1 = c("happy", "sad", "mad"),
col2 = c("tired", "sleepy", "happy"),
col3 = c("relaxed", "focused", "fine"))
dat$res <- apply(X = dat, MARGIN = 1,
FUN = function(x) ifelse("happy" %in% x, 5, 0))
dat
col1 col2 col3 res
1 happy tired relaxed 5
2 sad sleepy focused 0
3 mad happy fine 5
We can use rowSums here
df1$res <- rowSums(df1 == "happy") * 5
df1$res
#[1] 5 0 5
data
df1 <- structure(list(col1 = structure(c(1L, 3L, 2L), .Label = c("happy",
"mad", "sad"), class = "factor"), col2 = structure(c(3L, 2L,
1L), .Label = c("happy", "sleepy", "tired"), class = "factor"),
col3 = structure(c(3L, 2L, 1L), .Label = c("fine", "focused",
"relaxed"), class = "factor")), .Names = c("col1", "col2",
"col3"), row.names = c(NA, -3L), class = "data.frame")
I have many dataframes stored in a list, and I want to create weighted averages from these and store the results in a new dataframe. For example, with the list:
dfs <- structure(list(df1 = structure(list(A = 4:5, B = c(8L, 4L), Weight = c(TRUE, TRUE), Site = c("X", "X")),
.Names = c("A", "B", "Weight", "Site"), row.names = c(NA, -2L), class = "data.frame"),
df2 = structure(list(A = c(6L, 8L), B = c(9L, 4L), Weight = c(FALSE, TRUE), Site = c("Y", "Y")),
.Names = c("A", "B", "Weight", "Site"), row.names = c(NA, -2L), class = "data.frame")),
.Names = c("df1", "df2"))
In this example, I want to use columns A, B, and Weight for the weighted averages. I also want to move over related data such as Site, and want to sum the number of TRUE and FALSE. My desired result would look something like:
result <- structure(list(Site = structure(1:2, .Label = c("X", "Y"), class = "factor"),
A.Weight = c(4.5, 8), B.Weight = c(6L, 4L), Sum.Weight = c(2L,
1L)), .Names = c("Site", "A.Weight", "B.Weight", "Sum.Weight"
), class = "data.frame", row.names = c(NA, -2L))
Site A.Weight B.Weight Sum.Weight
1 X 4.5 6 2
2 Y 8.0 4 1
The above is just a very simple example, but my real data have many dataframes in the list, and many more columns than just A and B for which I want to calculate weighted averages. I also have several columns similar to Site that are constant in each dataframe and that I want to move to the result.
I'm able to manually calculate weighted averages using something like
weighted.mean(dfs$df1$A, dfs$df1$Weight)
weighted.mean(dfs$df1$B, dfs$df1$Weight)
weighted.mean(dfs$df2$A, dfs$df2$Weight)
weighted.mean(dfs$df2$B, dfs$df2$Weight)
but I'm not sure how I can do this in a shorter, less "manual" way. Does anyone have any recommendations? I've recently learned how to lapply across dataframes in a list, but my attempts have not been so great so far.
The trick is to create a function that works for a single data.frame, then use lapply to iterate across your list. Since lapply returns a list, we'll then use do.call to rbind the resulting objects together:
foo <- function(data, meanCols = LETTERS[1:2], weightCol = "Weight", otherCols = "Site") {
means <- t(sapply(data[, meanCols], weighted.mean, w = data[, weightCol]))
sumWeight <- sum(data[, weightCol])
others <- data[1, otherCols, drop = FALSE] #You said all the other data was constant, so we can just grab first row
out <- data.frame(others, means, sumWeight)
return(out)
}
In action:
do.call(rbind, lapply(dfs, foo))
---
Site A B sumWeight
df1 X 4.5 6 2
df2 Y 8.0 4 1
Since you said this was a minimal example, here's one approach to expanding this to other columns. We'll use grepl() and use regular expressions to identify the right columns. Alternatively, you could write them all out in a vector. Something like this:
do.call(rbind, lapply(dfs, foo,
meanCols = grepl("A|B", names(dfs[[1]])),
otherCols = grepl("Site", names(dfs[[1]]))
))
using dplyr
library(dplyr)
library('devtools')
install_github('hadley/tidyr')
library(tidyr)
unnest(dfs) %>%
group_by(Site) %>%
filter(Weight) %>%
mutate(Sum=n()) %>%
select(-Weight) %>%
summarise_each(funs(mean=mean(., na.rm=TRUE)))
gives the result
# Site A B Sum
#1 X 4.5 6 2
#2 Y 8.0 4 1
Or using data.table
library(data.table)
DT <- rbindlist(dfs)
DT[(Weight)][, c(lapply(.SD, mean, na.rm = TRUE),
Sum=.N), by = Site, .SDcols = c("A", "B")]
# Site A B Sum
#1: X 4.5 6 2
#2: Y 8.0 4 1
Update
In response to #jazzuro's comment, Using dplyr 0.3, I am getting
unnest(dfs) %>%
group_by(Site) %>%
summarise_each(funs(weighted.mean=stats::weighted.mean(., Weight),
Sum.Weight=sum(Weight)), -starts_with("Weight")) %>%
select(Site:B_weighted.mean, Sum.Weight=A_Sum.Weight)
# Site A_weighted.mean B_weighted.mean Sum.Weight
#1 X 4.5 6 2
#2 Y 8.0 4 1
Input
row.no column2 column3 column4
1 bb ee up
2 bb ee down
3 bb ee up
4 bb yy down
5 bb zz up
I have a rule to remove row 1 and 2 and 3, as while column2 and column3 for row 1, 2 and 3 are the same, contradictory data (up and down) are found in column 4.
How can I ask R to remove those rows with same name in column2 and column3 but contracting column 3 to result a matrix as follows:
row.no column2 column3 column4
4 bb yy down
5 bb zz up
The functions in package plyr really shine at this type of problem. Here is a solution using two lines of code.
Set up the data (kindly provided by #GavinSimpson)
dat <- structure(list(row.no = 1:5, column2 = structure(c(1L, 1L, 1L,
1L, 1L), .Label = "bb", class = "factor"), column3 = structure(c(1L,
1L, 1L, 2L, 3L), .Label = c("ee", "yy", "zz"), class = "factor"),
column4 = structure(c(2L, 1L, 2L, 1L, 2L), .Label = c("down",
"up"), class = "factor")), .Names = c("row.no", "column2",
"column3", "column4"), class = "data.frame", row.names = c(NA,
-5L))
Load the plyr package
library(plyr)
Use ddply to split, analyse and combine dat. The following line of code analyses splits dat into unique combination of (column2 and column3) separately. I then add a column called unique, which calculates the number of unique values of column4 for each set. Finally, use a simple subsetting to return only those lines where unique==1, and drop column 5.
df <- ddply(dat, .(column2, column3), transform,
row.no=row.no, unique=length(unique(column4)))
df[df$unique==1, -5]
And the results:
row.no column2 column3 column4
4 4 bb yy down
5 5 bb zz up
Here is one potential, if somewhat inelegant, solution
out <- with(dat, split(dat, interaction(column2, column3)))
out <- lapply(out, function(x) if(NROW(x) > 1) {NULL} else {data.frame(x)})
out <- out[!sapply(out, is.null)]
do.call(rbind, out)
Which gives:
> do.call(rbind, out)
row.no column2 column3 column4
bb.yy 4 bb yy down
bb.zz 5 bb zz up
Some explanation, line by line:
Line 1: splits the data into a list, each component of which is a data frame with rows corresponding to groups formed by unique combinations of column2 and column3.
Line 2: iterate over the result from Line 1; if there are more than 1 row in data frame, return NULL, if not return the 1-row data frame.
Line 3: iterate over the output from Line 2; return only non-NULL components
Line 4: need to bind, row-wise, the output from Line 3, which we arrange via do.call()
This can be simplified to two lines, combining Lines 1-3 into a single line:
out <- lapply(with(dat, split(dat, interaction(column2, column3))),
function(x) if(NROW(x) > 1) {NULL} else {data.frame(x)})
do.call(rbind, out[!sapply(out, is.null)])
The above was all done with:
dat <- structure(list(row.no = 1:5, column2 = structure(c(1L, 1L, 1L,
1L, 1L), .Label = "bb", class = "factor"), column3 = structure(c(1L,
1L, 1L, 2L, 3L), .Label = c("ee", "yy", "zz"), class = "factor"),
column4 = structure(c(2L, 1L, 2L, 1L, 2L), .Label = c("down",
"up"), class = "factor")), .Names = c("row.no", "column2",
"column3", "column4"), class = "data.frame", row.names = c(NA,
-5L))
Gavin keeps raising the bar on the quality of answers. Here's my attempt.
# This is one way of importing the data into R
sally <- textConnection("row.no column2 column3 column4
1 bb ee up
2 bb ee down
3 bb ee up
4 bb yy down
5 bb zz up")
sally <- read.table(sally, header = TRUE)
# Order the data frame to make rle work its magic
sally <- sally[order(sally$column3, sally$column4), ]
# Find which values are repeating
sally.rle2 <- rle(as.character(sally$column2))
sally.rle3 <- rle(as.character(sally$column3))
sally.rle4 <- rle(as.character(sally$oclumn4))
sally.can.wait2 <- sally.rle2$values[which(sally.rle3$lengths != 1)]
sally.can.wait3 <- sally.rle3$values[which(sally.rle3$lengths != 1)]
sally.can.wait4 <- sally.rle4$values[which(sally.rle4$lengths != 1)]
# Find which lines have values that are repeating
dup <- c(which(sally$column2 == sally.can.wait2),
which(sally$column3 == sally.can.wait3),
which(sally$column4 == sally.can.wait4))
dup <- dup[duplicated(dup)]
# Display the lines that have no repeating values
sally[-dup, ]
You can try one of the following two methods. Suppose the table is called 'table1'.
Method 1
repeated_rows = c();
for (i in 1:(nrow(table1)-1)){
for (j in (i+1):nrow(table1)){
if (sum((table1[i,2:3] == table1[j,2:3])) == 2){
repeated_rows = c(repeated_rows, i, j)
}
}
}
repeated_rows = unique(repeated_rows)
table1[-repeated_rows,]
Method 2
duplicates = duplicated(table1[,2:3])
for (i in 1:length(duplicates)){
if (duplicates[i] == TRUE){
for (j in 1:nrow(table1)){
if (sum(table1[i,2:3] == table1[j,2:3]) == 2){
duplicates[j] = TRUE;
}
}
}
}
table1[!duplicates,]