5

私はこの表のように見えるが、より大きな遺伝子データを扱っています:

ID allele.a allele.b
A      115       90
A      115       90
A      116       90
B      120       82
B      120       82
B      120      82M

私の目標は、ID ごとに、どの対立遺伝子が各 ID グループの最初の行にリストされている対立遺伝子と一致しないかを強調することです。データを適切にフォーマットされた Excel ファイルにエクスポートする必要があります。

ここに私が欲しいものがあります:

望ましい結果

次のスクリプトでそこに到達できますが、実際のスクリプトには約 67 個の「ID」、1000 行のデータ、および 37 列が含まれます。実行に約 5 分かかるため、処理時間を大幅に短縮するソリューションを見つけたいと考えています。tidyverse からの "do" ソリューションかもしれませんが、それがどのように見えるかはわかりません。

テスト用の data.frame を含むスクリプトは次のとおりです。速度テスト用のより大きなテスト data.frame も含まれています。

library(xlsx)
library(openxlsx)
library(tidyverse)

# Small data.frame
dframe <- data.frame(ID = c("A", "A", "A", "B", "B", "B"),
                     allele.a = c("115", "115", "116", "120", "120", "120"),
                     allele.b = c("90", "90", "90", "82", "82", "82M"),
                     stringsAsFactors = F)

# Bigger data.frame for speed test
# dframe <- data.frame(ID = rep(letters, each = 30),
#                      allele.a = rep(as.character(round(rnorm(n = 30, mean = 100, sd = 0.3), 0)), 26),
#                      allele.b = rep(as.character(round(rnorm(n = 30, mean = 90, sd = 0.3), 0)), 26),
#                      allele.c = rep(as.character(round(rnorm(n = 30, mean = 80, sd = 0.3), 0)), 26),
#                      allele.d = rep(as.character(round(rnorm(n = 30, mean = 70, sd = 0.3), 0)), 26),
#                      allele.e = rep(as.character(round(rnorm(n = 30, mean = 60, sd = 0.3), 0)), 26),
#                      allele.f = rep(as.character(round(rnorm(n = 30, mean = 50, sd = 0.3), 0)), 26),
#                      allele.g = rep(as.character(round(rnorm(n = 30, mean = 40, sd = 0.3), 0)), 26),
#                      allele.h = rep(as.character(round(rnorm(n = 30, mean = 30, sd = 0.3), 0)), 26),
#                      allele.i = rep(as.character(round(rnorm(n = 30, mean = 20, sd = 0.3), 0)), 26),
#                      allele.j = rep(as.character(round(rnorm(n = 30, mean = 10, sd = 0.3), 0)), 26),
#                      stringsAsFactors = F)



# Create a new excel workbook ----
wb <- createWorkbook()

# Add a worksheets
addWorksheet(wb, sheet = 1, gridLines = TRUE)

# add the data to the worksheet        
writeData(wb, sheet = 1, dframe, rowNames = FALSE)      

# Create a style to show alleles that do not match the first row.
style_Red_NoMatch <- createStyle(fontColour = "#FFFFFF", # white text
                                 bgFill = "#CC0000", # Dark red background
                                 textDecoration = c("BOLD")) # bold text

Groups <- unique(dframe$ID)

start_time <- Sys.time()
# For each unique group, 
for(i in 1:length(Groups)){

  # Print a message telling us where the script is processing in the file.
  print(paste("Formatting unique group ", i, "/", length(Groups), sep = ""))

  # What are the allele values of the *first* individual in the group?
  Allele.values <- dframe %>% 
    filter(ID == Groups[i]) %>% 
    slice(1) %>% 
    select(2:ncol(dframe)) %>% 
    as.character()

  # for each column that has allele values in it,
  for (j in 1:length(Allele.values)){
    # format the rest of the rows so that a value that does not match the first value gets red style


    conditionalFormatting(wb, sheet = 1, 
                          style_Red_NoMatch, 
                          rows = (which(dframe$ID == Groups[i]) + 1), 
                          cols = 1+j,  rule=paste("<>\"", Allele.values[j], "\"", sep = ""))
  }

}
end_time <- Sys.time()
end_time - start_time

saveWorkbook(wb, "Example.xlsx", overwrite = TRUE)
4

1 に答える 1