Rで縦持ちデータの横持ちデータへの変換

Question

### 実現したいこと
現在データ解析をしております。
添付のEXCELにございます左の表を右の表の様に縦持ちデータを横持データにした後に各receiptnameに該当する物ごとの色分けをしたいと考えております。
近い表は出来上がるのですが、目的としてる表にはならず、困っております。

発生している問題・分からないこと

具体的には、完成形で年月表記にしたいところが、年月日表記のままであり、receiptnameのところにも対象となるものが複数挿入されたりなど問題が発生しています。
また、うまく色付けをしたいのですが、上記ポイントで止まってしまい、最後まで進めておりません。

エラーメッセージ

具体的には、エラーはでず出力できていますが、目的とする表にはなっておりません。

該当のソースコード

selected_data_subset1 |>
  add_row(
    actdate =
      seq.Date(
        min(selected_data_subset1$actdate),
        max(selected_data_subset1$actdate),
        by = "1 month"
      )
  ) |>
  distinct(actdate, .keep_all = TRUE) |>
  pivot_wider(
    names_from = actdate,
    names_sort = TRUE,
    values_from = receiptname
  ) |>
  drop_na(patientid) |>
  unite("receiptname", !patientid, remove = FALSE, na.rm = TRUE)

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

ソースコードを自分なりに調べてみましたが、解決方法が見つからずに至っております。

補足

特になし

Answer 1

目標としては、セルに２つ表示されるのではなく該当する月に同じ（物）プロダクトがある場合はpatientidを2行にし、一つのセルに一つのプロダクトとしたい

row_id 列(row_number())を追加してから pivot_wider() を実行します。この様にすることで、patientid + row_id(pivot_wider() におけるインデックス値)がユニークになるので期待する出力になるかと思います。

suppressMessages(library(tidyverse))

A <- data.frame(
patientid = c(1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4),
receiptname = c('a', 'b', 'a', 'c', 'd', 'b', 'd', 'a', 'c', 'd', 'b'),
actdate = as.Date(c('2020-01-15', '2020-01-15', '2020-02-20', '2020-03-10', '2020-03-10', '2020-04-05', '2020-05-25', '2020-05-25',
'2020-06-17', '2020-07-19', '2020-07-19'))
)

A <- A |>
  mutate(year_month = format(actdate, "%Y-%m")) |>
  select(-actdate) |>
  # add unique id
  mutate(row_id = row_number()) |>
  pivot_wider(
    names_from = year_month,
    names_sort = TRUE,
    values_from = receiptname
  ) |>
  select(-row_id) |>
  drop_na(patientid) |>
  unite("receiptname", !patientid, remove = FALSE, na.rm = TRUE)

A

# # A tibble: 11 × 9
#    patientid receiptname `2020-01` `2020-02` `2020-03` `2020-04` `2020-05` `2020-06` `2020-07`
#        <dbl> <chr>       <chr>     <chr>     <chr>     <chr>     <chr>     <chr>     <chr>    
#  1         1 a           a         <NA>      <NA>      <NA>      <NA>      <NA>      <NA>     
#  2         1 b           b         <NA>      <NA>      <NA>      <NA>      <NA>      <NA>     
#  3         2 a           <NA>      a         <NA>      <NA>      <NA>      <NA>      <NA>     
#  4         2 c           <NA>      <NA>      c         <NA>      <NA>      <NA>      <NA>     
#  5         2 d           <NA>      <NA>      d         <NA>      <NA>      <NA>      <NA>     
#  6         3 b           <NA>      <NA>      <NA>      b         <NA>      <NA>      <NA>     
#  7         3 d           <NA>      <NA>      <NA>      <NA>      d         <NA>      <NA>     
#  8         3 a           <NA>      <NA>      <NA>      <NA>      a         <NA>      <NA>     
#  9         4 c           <NA>      <NA>      <NA>      <NA>      <NA>      c         <NA>     
# 10         4 d           <NA>      <NA>      <NA>      <NA>      <NA>      <NA>      d        
# 11         4 b           <NA>      <NA>      <NA>      <NA>      <NA>      <NA>      b        

追記

EXCELに出力した時にaがあるセルは黄色、ｂがあるセルは青色、cがあるセルは赤色、dがあるセルは紫色に…

A[row - 1, col - 1] ではなく A[row - 1, col] ではないかと思います。

for (row in 2:(nrow(A) + 1)) {
  for (col in 2:ncol(A)) {
    cell_value <- A[row - 1, col]
    style <- setColor(cell_value)
    if (!is.null(style)) {
      addStyle(wb, sheet = 1, style = style, rows = row, cols = col, gridExpand = TRUE)
    }
  }
}

Comments

[keikmyo]

回答ありがとうございます。
試したところ問題が解決しました！
ベストアンサーに選ばせていただきました。

[keikmyo]

ありがとうございます。
概ね、目的とする表にはなりました！
一点、receiptname列にNULL＿NULL＿NULL＿やA_A_A_などと実際の表では記載がされております。
selected_data_subset1[selected_data_subset1 == "NULL"] <- ""
こちらのコードなどで試しておりますが、何か改善点などありますでしょうか？

[melian]

確認ですが、元々の selected_data_subset1 の receiptname列に NULL＿NULL＿NULL＿ などの様なデータが含まれているのか、それともピボット処理の後に含まれているのでしょうか？

[keikmyo]

コメントありがとうございます。
こちらはピポット処理の後にNULLとでてきており、元々のデータには含まれておりません。

[melian]

了解です。それでしたら is.na() を使うとよいかと思います。

selected_data_subset1[is.na(selected_data_subset1)] <- ""

[keikmyo]

ありがとうございます。
再度、こちらでチャレンジしてみたいと思います。

[keikmyo]

先日はありがとうございました。こちら解決済みとしておりますが、追加でご質問をよろしいでしょうか？
実際のデータでコードを走らせると同じセルにreceiptname上の該当する物が一緒に表示されてしまいます。
目標としては、セルに２つ表示されるのではなく該当する月に同じ（物）プロダクトがある場合はpatientidを2行にし、一つのセルに一つのプロダクトとしたいのですが、こちらが色々試しておりますが、うまく表示させることができません。上記コードの何れの箇所を変更すればよいのでしょうか？
よろしくお願いいたします。

[melian]

distinct(each_month, .keep_all = TRUE) |>

をコメントアウトして結果を確認してみてください。

[keikmyo]

ありがとうございます。少しコードを修正しました。
再度コードを記載してみましたが、うまく表示がされません。やはり同じセルにプロダクトが2個入ってしまいます。
A <- data.frame(
patientid = c(1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4),
receiptname = c('a', 'b', 'a', 'c', 'd', 'b', 'd', 'a', 'c', 'd', 'b'),
actdate = as.Date(c('2020-01-15', '2020-01-15', '2020-02-20', '2020-03-10', '2020-03-10', '2020-04-05', '2020-05-25', '2020-05-25',
'2020-06-17', '2020-07-19', '2020-07-19'))
)
A <- A %>%
mutate(year_month = format(actdate, "%Y-%m")) %>%
select(-actdate) %>%
pivot_wider(
names_from = year_month,
names_sort = TRUE,
values_from = receiptname
) |>
drop_na(patientid) |>
unite("receiptname", !patientid, remove = FALSE, na.rm = TRUE)

[melian]

なるほど、patientidが重複しているのですね。回答を編集しましたので確認してください。

[keikmyo]

ありがとうございます。うまく解決いたしました。追加の質問となって恐縮ですが、EXCELに出力した時にaがあるセルは黄色、ｂがあるセルは青色、cがあるセルは赤色、dがあるセルは紫色に変更しようと試みておりますが、こちらも下記コードを記載しておりますが、文字が入っていないところも色がついてしまっております。
下記コードの間違いがうまくエラーとして出ないため困っております。

library(openxlsx)
wb <- createWorkbook()

addWorksheet(wb, "Sheet1")
writeData(wb, sheet = 1, A)

setColor <- function(cell_value) {
if (grepl("a", cell_value, ignore.case = TRUE)) {
return(createStyle(fgFill = "#FFFF00"))
} else if (grepl("b", cell_value, ignore.case = TRUE)) {
return(createStyle(fgFill = "#0000FF"))
} else if (grepl("c", cell_value, ignore.case = TRUE)) {
return(createStyle(fgFill = "#FF0000"))
} else if (grepl("d", cell_value, ignore.case = TRUE)) {
return(createStyle(fgFill = "#800080"))
} else {
return(NULL)
}
}

for (row in 2:(nrow(A) + 1)) {
for (col in 2:ncol(A)) {
cell_value <- A[row - 1, col - 1]
style <- setColor(cell_value)
if (!is.null(style)) {
addStyle(wb, sheet = 1, style = style, rows = row, cols = col, gridExpand = TRUE)
}
}
}

[melian]

追記しました。

[keikmyo]

ありがとうございます。該当のソースコードにて実行しましたが、やはりセルの色がずれてしまっております。。。上部にアウトプットファイルも追加させていただきました

[melian]

当初、
cell_value <- A[row - 1, col - 1]
となっているコードを実行してみたところ、質問に追加された画像の様になっていました。これを、
cell_value <- A[row - 1, col]
に変更すると、回答に追加した画像の様になります。

[keikmyo]

回答ありがとうございます。
少しコードを修正したところ、うまくセルの色付けができました！いろいろとありがとうございました。