объединить два кадра данных с маркировкой ячейки цветом при записи .xlsx в R - PullRequest
Новая
       22

объединить два кадра данных с маркировкой ячейки цветом при записи .xlsx в R

1 голос
/ 10 июля 2019

у меня есть два кадра данных 

prop=structure(list(KOD_NAR.id = structure(c(1L, 1L, 2L, 9L, 15L, 
16L, 17L, 3L, 4L, 18L, 5L, 6L, 19L, 20L, 7L, 8L, 21L, 10L, 11L, 
12L, 13L, 14L), .Label = c("", "-1", "04А  ", "04Б  ", "05А  ", 
"05Б  ", "07Д  ", "07С  ", "1", "10", "11", "12Г  ", "13", "15", 
"2", "3", "4", "5", "6", "7", "9"), class = "factor"), X1000494 = structure(c(4L, 
2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 3L), .Label = c("", "0.00425531914893617", "0.0106382978723404", 
"0.848936170212766"), class = "factor"), X1000495 = structure(c(4L, 
2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 3L), .Label = c("", "0.00651465798045603", "0.0293159609120521", 
"0.892508143322475"), class = "factor"), X1000496 = structure(c(4L, 
2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
1L, 1L, 1L, 1L, 3L), .Label = c("", "0.00366300366300366", "0.0366300366300366", 
"0.835164835164835"), class = "factor"), X1000500 = structure(c(3L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 2L), .Label = c("", "0.0161290322580645", "1.09032258064516"
), class = "factor")), .Names = c("KOD_NAR.id", "X1000494", "X1000495", 
"X1000496", "X1000500"), class = "data.frame", row.names = c(NA, 
-22L))

Второй 

mash=structure(list(KOD_NAR.id = structure(c(1L, 8L, 16L, 17L, 18L, 
2L, 3L, 19L, 4L, 5L, 20L, 21L, 6L, 7L, 22L, 9L, 10L, 11L, 12L, 
13L, 14L, 15L), .Label = c("-1", "04А  ", "04Б  ", "05А  ", "05Б  ", 
"07Д  ", "07С  ", "1", "10", "11", "12Г  ", "13", "15", "16", 
"16А  ", "2", "3", "4", "5", "6", "7", "9"), class = "factor"), 
    X1000494 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, 0L, 0L, NA), X1000495 = c(NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, 1L, 1L, NA), X1000496 = c(NA, NA, NA, NA, NA, 
    NA, NA, 0L, NA, NA, NA, NA, NA, NA, 0L, NA, NA, NA, NA, 2L, 
    0L, NA), X1000500 = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0L, 0L, NA)), .Names = c("KOD_NAR.id", 
"X1000494", "X1000495", "X1000496", "X1000500"), class = "data.frame", row.names = c(NA, 
-22L))

Я хочу объединить эти кадры данных, но особым образом, а именно: структура файла такова, что по строкам - код ошибки драйвера, а по столбцам - идентификатор драйвера. Как я могу присоединиться к метрическим данным prop dataframe к номинальным данным mash dataframe с помощью соответствующего KOD_NAR.id. а затем после объединения загрузить файл Excel (write.xlsx) с отмеченными ячейками по цвету. Если в ячейке в скобках 0, то цвет зеленый, если 1, то цвет желтый, если 2, то цвет ячеек красный

Итак, вывод: enter image description here

есть ли способ сделать это?

1 Ответ

1 голос
/ 10 июля 2019

Я уверен, что есть более изящные способы сделать это (я плохо обращаюсь с), но этот работает.

Возникла небольшая проблема с предоставленными вами наборами данных 

library(openxlsx)   
library(tidyr)

style0=createStyle(fgFill = "green") #here you can change colors
style1=createStyle(fgFill = "yellow")
style2=createStyle(fgFill = "red")

prop$KOD_NAR.id=as.character(prop$KOD_NAR.id)

prop$KOD_NAR.id[1:2]=c("16","16a") #there must have been something wrong with the data, these two codes found in mash are not in prop
prop$KOD_NAR.id=factor(prop$KOD_NAR.id)
mash_long=mash %>% gather(key="ID",value="mash",-KOD_NAR.id)
prop_long=prop %>% gather(key="ID",value="prop",-KOD_NAR.id)

df=full_join(mash_long,prop_long) # KOD_NAR.id in prop had empty cells
df$mash[is.na(df$mash)]=""
df$prop[is.na(df$prop)]=""
df$cellcontent=ifelse(df$mash=="",df$prop,paste0(df$prop," (",df$mash,")"))

df_write=df %>% select(ID,cellcontent,KOD_NAR.id,starts_with("X")) %>% spread(ID,cellcontent)

wb=createWorkbook("workbook")
addWorksheet(wb,"Info")
writeData(wb,sheet = 1,df_write)
for(i in 2:ncol(df_write)){
  for(k in 1:nrow(df_write)){
    if(grepl("\\(",df_write[k,i])){
      addStyle(wb=wb,sheet = 1,rows = k+1,cols = i, #there will be a header row
               style=get(paste0("style",gsub(".*\\((\\d+)\\)","\\1",df_write[k,i]))))
    }
  }
}
saveWorkbook(wb,"example.xlsx",overwrite = T)
...