Splinting one cell to different cells - r

I have read csv file, which contain data in below format:
A 0.1
B 0.2
C .1,.2,.4,.6
D .1,.2,.4,.6
E 0.2
I want to set this in like:
A B C D E
0.1 0.2 0.1 0.1 0.2
0.2 0.2
0.4 0.4
0.6 0.6
I am using code:
test <- read.csv("test.csv")
test_t <- setNames(data.frame(t(test[,-1])), test[,1])
which is giving error:
Error in setNames(data.frame(t(test[, -1])), test[, 1]) :
'names' attribute [4] must be the same length as the vector [1]

Using:
library(splitstackshape)
dcast(cSplit(df, 'V2', ',','long'), rowid(V1) ~ V1)[,-1]
gives:
A B C D E
1: 0.1 0.2 0.1 0.1 0.2
2: NA NA 0.2 0.2 NA
3: NA NA 0.4 0.4 NA
4: NA NA 0.6 0.6 NA
A solution without extra packages:
splt <- strsplit(as.character(df$V2),',')
df2 <- data.frame(V1 = rep(df$V1, lengths(splt)),
V2 = as.numeric(unlist(splt)),
id = unlist(lapply(splt, seq_along)))
df3 <- reshape(df2, idvar = 'id', timevar = 'V1', direction = 'wide')
which gives a similar result:
> df3
V2.A V2.B V2.C V2.D V2.E
1 0.1 0.2 0.1 0.1 0.2
4 NA NA 0.2 0.2 NA
5 NA NA 0.4 0.4 NA
6 NA NA 0.6 0.6 NA
If you want to get the exact same column-names as in the first solution:
names(df3) <- gsub('V2.', '', names(df3), fixed = TRUE)

Related

Remove % of Items in Columns

I'm trying to drop columns that have more than 90% of NA values present, I've followed the following but I only get a values in return, not sure what I can be doing wrong. I would be expecting an actual data frame, I tried putting as.data.frame in front but this is also erroneous.
Linked Post: Delete columns/rows with more than x% missing
Example DF
gene cell1 cell2 cell3
A 0.4 0.1 NA
B NA NA 0.1
C 0.4 NA 0.5
D NA NA 0.5
E 0.5 NA 0.6
F 0.6 NA NA
Desired DF
gene cell1 cell3
A 0.4 NA
B NA 0.1
C 0.4 0.5
D NA 0.5
E 0.5 0.6
F 0.6 NA
Code
#Select Genes that have NA values for 90% of a given cell line
df_col <- df[,2:ncol(df)]
df_col <-df_col[, which(colMeans(!is.na(df_col)) > 0.9)]
df <- cbind(df[,1], df_col)
I would use dplyr here.
If you want to use select() with logical conditions, you are probably looking for the where() selection helper in dplyr.
It can be used like this: select(where(condition))
I used a 80% threshold because 90% would keep all columns and would therefore not illustrate the solution as well
library(dplyr)
df %>% select(where(~mean(is.na(.))<0.8))
It can also be done with base R and colMeans:
df[, c(TRUE, colMeans(is.na(df[-1]))<0.8)]
or with purrr:
library(purrr)
df %>% keep(~mean(is.na(.))<0.8)
Output:
gene cell1 cell3
1 a 0.4 NA
2 b NA 0.1
3 c 0.4 0.5
4 d NA 0.5
5 e 0.5 0.6
6 f 0.6 NA
Data
df<-data.frame(gene=letters[1:6],
cell1=c(0.4, NA, 0.4, NA, 0.5, 0.6),
cell2=c(0.1, rep(NA, 5)),
cell3=c(NA, 0.1, 0.5, 0.5, 0.6, NA))
Well, cell3 has 83% NA values (5/6) but anyway you can do -
ignore <- 1
perc <- 0.8 #80 %
df <- cbind(df[ignore], df[-ignore][colMeans(is.na(df[-ignore])) < perc])
df
# gene cell1 cell3
#1 A 0.4 NA
#2 B NA 0.1
#3 C 0.4 0.5
#4 D NA 0.5
#5 E 0.5 0.6
#6 F 0.6 NA

How split a heatmap at the specific rows? Error invalid for atomic vectors

I am trying to build a heatmap in R. I wanted to split the heatmap at specific rows. For example my matrix is as:
ID A B C
FD_1 0.3 0.2 1
FD_2 0.4 1 0.9
FD_3 0.6 0.8 0.2
FS_1 0.3 0.2 1
FS_2 0.4 1 0.9
FS_3 0.6 0.8 0.2
FS_4 0.4 1 0.9
FS_5 0.6 0.8 0.2
FE_1 0.3 0.2 1
FE_2 0.4 1 0.9
FE_3 0.6 0.8 0.2
FE_4 0.4 1 0.9
I need to make a heatmap that includes 3 slice: one for 3 FD, one for 5 FS and one for 4 FE. And label each slice with their name as FD, FS and FE.
I'm using this code:
Heatmap(M_matrix, name = "level", row_split = M_matrix$ID)
But I'm getting this error:
Error in M_matrix$ID : $ operator is invalid for atomic vectors
Any suggestion?
Thanks
You can define the splits based on your ID column:
library(ComplexHeatmap)
ID=c(paste0("FD_", 1:3), paste0("FS_", 1:5), paste0("FE_", 1:4))
df <- data.frame(ID=ID,
matrix(rnorm(3*12, mean = 3), ncol=3,
dimnames=list(ID, LETTERS[1:3])),
stringsAsFactors = FALSE)
splits <- factor(gsub("_.*", "", ID))
Heatmap(matrix=as.matrix(df[,-1] ), row_split = splits, cluster_row_slices = FALSE)
If you want list of dataframes based on ID, we can use split.
list_df <- split(df, sub("_.*", "", df$ID))
list_df
#$FD
# ID A B C
#1 FD_1 0.3 0.2 1.0
#2 FD_2 0.4 1.0 0.9
#3 FD_3 0.6 0.8 0.2
#$FE
# ID A B C
#9 FE_1 0.3 0.2 1.0
#10 FE_2 0.4 1.0 0.9
#11 FE_3 0.6 0.8 0.2
#12 FE_4 0.4 1.0 0.9
#$FS
# ID A B C
#4 FS_1 0.3 0.2 1.0
#5 FS_2 0.4 1.0 0.9
#6 FS_3 0.6 0.8 0.2
#7 FS_4 0.4 1.0 0.9
#8 FS_5 0.6 0.8 0.2
We can use group_split
library(dplyr)
library(stringr)
list_df <- df %>%
group_split(grp = str_remove(ID, "_.*"), keep = FALSE)

convert from long to symmetrical square wide format in R

I would like to convert this dataframe
tmp <- data.frame(V1=c("A","A","B"),V2=c("B","C","C"),V3=c(0.2,0.4,0.1))
tmp
V1 V2 V3
1 A B 0.2
2 A C 0.4
3 B C 0.1
into a square matrix like this (which should ultimately be a dist object
A B C
A 0
B 0.2 0
C 0.4 0.1 0
I tried different approaches based on functions reshape, spread or xtabs but I cannot get the right dimension. Thanks for your help.
Maybe you can try the code below
d <- sort(unique(unlist(tmp[1:2])))
m <- `dimnames<-`(matrix(0,length(d),length(d)),list(d,d))
m[as.matrix(tmp[1:2])] <- tmp$V3
res <- t(m) + m
such that
> res
A B C
A 0.0 0.2 0.4
B 0.2 0.0 0.1
C 0.4 0.1 0.0
You can also create your own dist object this way using structure:
tmp_lab <- unique(c(as.character(tmp$V1), as.character(tmp$V2)))
structure(tmp$V3,
Size = length(tmp_lab),
Labels = tmp_lab,
Diag = TRUE,
Upper = FALSE,
method = "user",
class = "dist")
Output
A B C
A 0.0
B 0.2 0.0
C 0.4 0.1 0.0
Here is an option with xtabs after converting the columns 'V1' , 'V2' to factor with levels specified as the same
tmp[1:2] <- lapply(tmp[1:2], factor, levels = c('A', 'B', 'C'))
as.dist(xtabs(V3 ~ V2 + V1, tmp), diag = TRUE)
# A B C
#A 0.0
#B 0.2 0.0
#C 0.4 0.1 0.0

Transform NA values based on first registration and nearest values

I already made a similar question but now I want just to restrict the new values of NA.
I have some data like this:
Date 1 Date 2 Date 3 Date 4 Date 5 Date 6
A NA 0.1 0.2 NA 0.3 0.2
B 0.1 NA NA 0.3 0.2 0.1
C NA NA NA NA 0.3 NA
D 0.1 0.2 0.3 NA 0.1 NA
E NA NA 0.1 0.2 0.1 0.3
I would like to change the NA values of my data based on the first date a value is registered. So for example for A, the first registration is Date 2. Then I want that before that registration the values of NA in A are 0, and after the first registration the values of NA become the mean of the nearest values (mean of date 3 and 5).
In case the last value is an NA, transform it into the last registered value (as in C and D). In the case of E all NA values will become 0.
Get something like this:
Date 1 Date 2 Date 3 Date 4 Date 5 Date 6
A 0 0.1 0.2 0.25 0.3 0.2
B 0.1 0.2 0.2 0.3 0.2 0.1
C 0 0 0 0 0.3 0.3
D 0.1 0.2 0.3 0.2 0.1 0.1
E 0 0 0.1 0.2 0.1 0.3
Can you help me? I'm not sure how to do it in R.
Here is a way using na.approx from the zoo package and apply with MARGIN = 1 (so this is probably not very efficient but get's the job done).
library(zoo)
df1 <- as.data.frame(t(apply(dat, 1, na.approx, method = "constant", f = .5, na.rm = FALSE)))
This results in
df1
# V1 V2 V3 V4 V5
#A NA 0.1 0.2 0.25 0.3
#B 0.1 0.2 0.2 0.30 0.2
#C NA NA NA NA 0.3
#E NA NA 0.1 0.20 0.1
Replace NAs and rename columns.
df1[is.na(df1)] <- 0
names(df1) <- names(dat)
df1
# Date_1 Date_2 Date_3 Date_4 Date_5
#A 0.0 0.1 0.2 0.25 0.3
#B 0.1 0.2 0.2 0.30 0.2
#C 0.0 0.0 0.0 0.00 0.3
#E 0.0 0.0 0.1 0.20 0.1
explanation
Given a vector
x <- c(0.1, NA, NA, 0.3, 0.2)
na.approx(x)
returns x with linear interpolated values
#[1] 0.1000000 0.1666667 0.2333333 0.3000000 0.2000000
But OP asked for constant values so we need the argument method = "constant" from the approx function.
na.approx(x, method = "constant")
# [1] 0.1 0.1 0.1 0.3 0.2
But this is still not what OP asked for because it carries the last observation forward while you want the mean for the closest non-NA values. Therefore we need the argument f (also from approx)
na.approx(x, method = "constant", f = .5)
# [1] 0.1 0.2 0.2 0.3 0.2 # looks good
From ?approx
f : for method = "constant" a number between 0 and 1 inclusive, indicating a compromise between left- and right-continuous step functions. If y0 and y1 are the values to the left and right of the point then the value is y0 if f == 0, y1 if f == 1, and y0*(1-f)+y1*f for intermediate values. In this way the result is right-continuous for f == 0 and left-continuous for f == 1, even for non-finite y values.
Lastly, if we don't want to replace the NAs at the beginning and end of each row we need na.rm = FALSE.
From ?na.approx
na.rm : logical. If the result of the (spline) interpolation still results in NAs, should these be removed?
data
dat <- structure(list(Date_1 = c(NA, 0.1, NA, NA), Date_2 = c(0.1, NA,
NA, NA), Date_3 = c(0.2, NA, NA, 0.1), Date_4 = c(NA, 0.3, NA,
0.2), Date_5 = c(0.3, 0.2, 0.3, 0.1)), .Names = c("Date_1", "Date_2",
"Date_3", "Date_4", "Date_5"), class = "data.frame", row.names = c("A",
"B", "C", "E"))
EDIT
If there are NAs in the last column we can replace these with the last non-NAs before we apply na.approx as shown above.
dat$Date_6[is.na(dat$Date_6)] <- dat[cbind(1:nrow(dat),
max.col(!is.na(dat), ties.method = "last"))][is.na(dat$Date_6)]
This is another possible answer, using na.locf from the zoo package.
Edit: apply is actually not required; This solution fills in the last observed value if this value is missing.
# create the dataframe
Date1 <- c(NA,.1,NA,NA)
Date2 <- c(.1, NA,NA,NA)
Date3 <- c(.2,NA,NA,.1)
Date4 <- c(NA,.3,NA,.2)
Date5 <- c(.3,.2,.3,.1)
Date6 <- c(.1,NA,NA,NA)
df <- as.data.frame(cbind(Date1,Date2,Date3,Date4,Date5,Date6))
rownames(df) <- c('A','B','C','D')
> df
Date1 Date2 Date3 Date4 Date5 Date6
A NA 0.1 0.2 NA 0.3 0.1
B 0.1 NA NA 0.3 0.2 NA
C NA NA NA NA 0.3 NA
D NA NA 0.1 0.2 0.1 NA
# Load library
library(zoo)
df2 <- t(na.locf(t(df),na.rm = F)) # fill last observation carried forward
df3 <- t(na.locf(t(df),na.rm = F, fromLast = T)) # last obs carried backward
df4 <- (df2 + df3)/2 # mean of both dataframes
df4 <- t(na.locf(t(df4),na.rm = F)) # fill last observation carried forward
df4[is.na(df4)] <- 0 # NA values are 0
Date1 Date2 Date3 Date4 Date5 Date6
A 0.0 0.1 0.2 0.25 0.3 0.1
B 0.1 0.2 0.2 0.30 0.2 0.2
C 0.0 0.0 0.0 0.00 0.3 0.3
D 0.0 0.0 0.1 0.20 0.1 0.1
Here's another option with base R + rollmean from zoo (clearly easy to rewrite in base R for this case with window size k = 2).
t(apply(df, 1, function(x) {
means <- c(0, rollmean(na.omit(x), 2), tail(na.omit(x), 1))
replace(x, is.na(x), means[1 + cumsum(!is.na(x))[is.na(x)]])
}))
# Date1 Date2 Date3 Date4 Date5 Date6
# A 0.0 0.1 0.2 0.25 0.3 0.2
# B 0.1 0.2 0.2 0.30 0.2 0.1
# C 0.0 0.0 0.0 0.00 0.3 0.3
# D 0.1 0.2 0.3 0.20 0.1 0.1
# E 0.0 0.0 0.1 0.20 0.1 0.3
Explanation. Suppose that x is the first row of df:
# Date1 Date2 Date3 Date4 Date5 Date6
# A NA 0.1 0.2 NA 0.3 0.2
Then
means
# [1] 0.00 0.15 0.25 0.25 0.20
is a vector of 0, rolling means of two the following non-NA elements, and the last non-NA element. Then all we need to do is to replace those elements of x that are is.na(x). We will replace them by the elements of means at indices 1 + cumsum(!is.na(x))[is.na(x)]. That's the trickier part. Here
cumsum(!is.na(x))
# [1] 0 1 2 2 3 4
Meaning that the first element of x has seen 0 non-NA elements, while, say, the last one has seen 4 non-NA elements so far. Then
cumsum(!is.na(x))[is.na(x)]
# [1] 0 2
is about those NA elements in x that we want to replace. Notice that then
1 + cumsum(!is.na(x))[is.na(x)]
# [1] 1 3
corresponds to the elements of means that we want to use for replacement.
I am finding the function below too complicated but it works, so here it goes.
fun <- function(x){
if(anyNA(x)){
inx <- which(!is.na(x))
if(inx[1] > 1) x[seq_len(inx[1] - 1)] <- 0
prev <- inx[1]
for(i in inx[-1]){
if(i - prev > 1){
m <- mean(c(x[i], x[prev]))
while(prev < i){
x[prev] <- m
prev <- prev + 1
}
}
prev <- i
}
}
x
}
res <- t(apply(df1, 1, fun))
res <- as.data.frame(res)
res
# Date.1 Date.2 Date.3 Date.4 Date.5
#A 0.0 0.1 0.25 0.25 0.3
#B 0.2 0.2 0.20 0.30 0.2
#C 0.0 0.0 0.00 0.00 0.3
#E 0.0 0.0 0.10 0.20 0.1
Data.
df1 <- read.table(text = "
Date.1 Date.2 Date.3 Date.4 Date.5
A NA 0.1 0.2 NA 0.3
B 0.1 NA NA 0.3 0.2
C NA NA NA NA 0.3
E NA NA 0.1 0.2 0.1
", header = TRUE)

R: Filling Missing Values (NA) by Multiplying Two Separate Vectors

I'm having a brain-freeze.
This is what I have:
C <- c(C1, C2, C3) # A constant for every row in the data frame
r <- c(r1, r2, r3, r4) # A ratio for every column in the data frame
My data frame looks like this:
1 2 3 4
a 0.7 0.4 NA NA
b NA NA 0.3 NA
c NA 0.6 NA 0.4
I need to fill in the NA's with a multiplication of C and r so that it looks like this:
1 2 3 4
a 0.7 0.4 C1*r3 C1*r4
b C2*r1 C2*r2 0.3 C2*r4
c C3*r1 0.6 C3*r3 0.4
Notice that the multiplication is only done for the NA's and not for numbers that already exist. I know is.na is used to pick out the NA's, and it's probably just linear algebra, but my brain has quit for the day. Any help would be great.
Thanks.
If mm is your matrix , you can fill missing values like this:
mm[is.na(mm)] <- outer(C,r)[is.na(mm)]
example with data :
mm <- read.table(text=' 1 2 3 4
a 0.7 0.4 NA NA
b NA NA 0.3 NA
c NA 0.6 NA 0.4')
C <- c(1, 1, 1) # A constant for every row in the data frame
r <- c(2, 2, 2, 2)
mm[is.na(mm)] <- outer(C,r)[is.na(mm)]
# X1 X2 X3 X4
# a 0.7 0.4 2.0 2.0
# b 2.0 2.0 0.3 2.0
# c 2.0 0.6 2.0 0.4

Resources