Combining two pivot tables for one view

Hello,

I want to condense these two tables together into one. Currently both produce the right data. For the final table I want, the values from df_data_to_show should show in the cells of the table while the formatting within the table should be based on the corresponding cells from df_data_to_color . If a value is less than 5 in a cell for df_data_to_color then the corresponding cell in df_data_to_show should be formatted in red.

I am not entirely sure how I would go about using one table on top of another to get this formatting sorted. Does anyone know how?

library(radiant.data)
library(DT)
library(dplyr)

#this data needs to show on the pivot table
df_data_to_show <- pivotr(diamonds, cvars = c("clarity","cut","color"), nvar = "price", fun = "sum") %>% dtab()

df_data_to_show$x$data
#>          cut color    I1    SI2    SI1    VS2    VS1   VVS2   VVS1    IF  Total
#> 1       Fair     D    NA  34428  27750   5688     NA     NA    875    NA  68741
#> 2       Fair     E  1232  26484  13094   2551     NA    738     NA    NA  44099
#> 3       Fair     F 10852   3633  24775  14812  16797     NA  12648  3205  86722
#> 4       Fair     G  1954  25521  16846  11654   3419   3323     NA    NA  62717
#> 5       Fair     H 10152  38344  38153   7516  26427     NA     NA    NA 120592
#> 6       Fair     I  6268  13440   2804   3867   3065     NA     NA    NA  29444
#> 7       Fair     J  2304  23181    497     NA  16732     NA     NA    NA  42714
#> 8       Good     D  4346  59491  21960   6361   4522  19324   4274    NA 120278
#> 9       Good     E  2608  77762  75916  62827  14774   2511   2129    NA 238527
#> 10      Good     F  3354  59098  40587  47473  21560     NA  15886  1429 189387
#> 11      Good     G  7026  43708  47079  34603  34942  10284  26112   895 204649
#> 12      Good     H    NA  38845  47938  35801   8032  15198    638    NA 146452
#> 13      Good     I    NA  11686  82335  11858  38485   5221   9301   945 159831
#> 14      Good     J    NA  36827  33588   5202   1128     NA     NA    NA  76745
#> 15 Very Good     D    NA  83312  57617  42237  36710  14682   1426 18114 254098
#> 16 Very Good     E  6707 164585 112414  90421  45633  46216  16852 16474 499302
#> 17 Very Good     F 10640  90164 173023 104353  57590  24961  15475 22877 499083
#> 18 Very Good     G  2988 133754  91859  63196  90789  97253  24230  2151 506220
#> 19 Very Good     H  2850  73086 124936  71239 103507  15029   6475  2571 399693
#> 20 Very Good     I    NA  47089 102178 101361  47980   1289  11335  7951 319183
#> 21 Very Good     J    NA  74032  69433  44767   2849  10161   2042    NA 203284
#> 22   Premium     D 13119  60845 146063  36107  75983  12910   5952    NA 350979
#> 23   Premium     E  3572  96571 132717 135139  70399  32273   7701  6144 484516
#> 24   Premium     F  5896 144000 100753 135135  59548  15123   7718 18160 486333
#> 25   Premium     G 19580 148256 111278 180735 100370  39591  18677  1847 620334
#> 26   Premium     H 13321 203818 160108 161620  98884  17926  10046  3028 668751
#> 27   Premium     I  6436 126824 112927  91604  50340  23292   4553  3729 419705
#> 28   Premium     J  2195  93865  42461  96399  79836  12850    994  9596 338196
#> 29     Ideal     D    NA  36893 111255 128776  78128  60124  15407  4216 434799
#> 30     Ideal     E    NA 117900 126845 118332  58749  81276  42797  7323 553222
#> 31     Ideal     F 23323 114836 137310 153054 108434 132094  90199 44013 803263
#> 32     Ideal     G    NA 108961 102594 206233 176063 186596 167161 28904 976512
#> 33     Ideal     H  7068 136811 201787 128418  40020  23152  27539 29354 594149
#> 34     Ideal     I    NA 115069 113838  81508  72743  40227  26039  5263 454687
#> 35     Ideal     J    NA  34881  78256 106134  30380   4317   9814   569 264351

#the cells above should be coloured in based on the observations here (if less than 5, the cell needs to be flagged red)
df_data_to_color <- pivotr(diamonds, cvars = c("clarity","cut","color"), nvar = "price", fun = "n_obs") %>% dtab()

df_data_to_color$x$data
#>          cut color I1 SI2 SI1 VS2 VS1 VVS2 VVS1 IF Total
#> 1       Fair     D NA   8   4   2  NA   NA    1 NA    15
#> 2       Fair     E  1   5   5   2  NA    1   NA NA    14
#> 3       Fair     F  2   1   4   4   4   NA    1  1    17
#> 4       Fair     G  1   5   5   2   2    1   NA NA    16
#> 5       Fair     H  3   4   9   2   3   NA   NA NA    21
#> 6       Fair     I  4   2   1   2   2   NA   NA NA    11
#> 7       Fair     J  1   3   1  NA   2   NA   NA NA     7
#> 8       Good     D  1  14   9   3   3    4    1 NA    35
#> 9       Good     E  1  16  22  15   5    1    2 NA    62
#> 10      Good     F  1  11  14  12   8   NA    7  2    55
#> 11      Good     G  1   7  10   8   7    3    3  1    40
#> 12      Good     H NA   7  13  10   3    3    1 NA    37
#> 13      Good     I NA   2  14   2   5    1    1  1    26
#> 14      Good     J NA   5  11   2   2   NA   NA NA    20
#> 15 Very Good     D NA  18  21  17  10    8    2  1    77
#> 16 Very Good     E  2  30  37  26   9   25    7  4   140
#> 17 Very Good     F  2  24  40  23  25   14    4  4   136
#> 18 Very Good     G  1  29  23  17  22   21   16  2   131
#> 19 Very Good     H  1  14  21  20  19   12    6  2    95
#> 20 Very Good     I NA   7  18  16  11    1    4  2    59
#> 21 Very Good     J NA  10  11  12   3    2    1 NA    39
#> 22   Premium     D  3  13  38  12  13    9    4 NA    92
#> 23   Premium     E  1  25  47  41  13    7    7  3   144
#> 24   Premium     F  2  23  25  36  17    6    4  6   119
#> 25   Premium     G  2  35  26  42  30   10    9  2   156
#> 26   Premium     H  3  31  31  25  23    5   11  3   132
#> 27   Premium     I  1  21  20  17  14    4    3  3    83
#> 28   Premium     J  1   9   9  12  10    2    1  1    45
#> 29     Ideal     D NA  15  39  55  24   20    9  1   163
#> 30     Ideal     E NA  30  36  55  25   22   21  5   194
#> 31     Ideal     F  4  34  42  53  29   29   29 18   238
#> 32     Ideal     G NA  21  31  50  51   43   42 16   254
#> 33     Ideal     H  1  30  43  31  22   13   14 15   169
#> 34     Ideal     I NA  14  23  19  18   14   12  5   105
#> 35     Ideal     J NA   6  18  16   8    3    1  1    53

#somehow combining the two tables 

Created on 2020-10-07 by the reprex package (v0.3.0)

Any help on this? :slight_smile:

PivotR is a very specific thing, either its syntax allows what you want to do or it doesn't...
If its important to conditionally colour a table probably a different table framework like DT or gt would be more appropriate

Just my 2c

@nirgrahamuk, the call %>% dtab() makes it a DT compatible table.

@nirgrahamuk I am able to replace the values of the one table with another with df_data_to_color$x$data <- df_data_to_show$x$data but I need to stop the formatting from updating essentially. Maybe you have some ideas?

library(radiant.data)
library(DT)
library(tidyverse)


df_data_to_show <- pivotr(diamonds, cvars = c("clarity", "cut", "color"), nvar = "price", fun = "sum") %>% dtab()

df_data_to_show$x$data
#>          cut color    I1    SI2    SI1    VS2    VS1   VVS2   VVS1    IF  Total
#> 1       Fair     D    NA  34428  27750   5688     NA     NA    875    NA  68741
#> 2       Fair     E  1232  26484  13094   2551     NA    738     NA    NA  44099
#> 3       Fair     F 10852   3633  24775  14812  16797     NA  12648  3205  86722
#> 4       Fair     G  1954  25521  16846  11654   3419   3323     NA    NA  62717
#> 5       Fair     H 10152  38344  38153   7516  26427     NA     NA    NA 120592
#> 6       Fair     I  6268  13440   2804   3867   3065     NA     NA    NA  29444
#> 7       Fair     J  2304  23181    497     NA  16732     NA     NA    NA  42714
#> 8       Good     D  4346  59491  21960   6361   4522  19324   4274    NA 120278
#> 9       Good     E  2608  77762  75916  62827  14774   2511   2129    NA 238527
#> 10      Good     F  3354  59098  40587  47473  21560     NA  15886  1429 189387
#> 11      Good     G  7026  43708  47079  34603  34942  10284  26112   895 204649
#> 12      Good     H    NA  38845  47938  35801   8032  15198    638    NA 146452
#> 13      Good     I    NA  11686  82335  11858  38485   5221   9301   945 159831
#> 14      Good     J    NA  36827  33588   5202   1128     NA     NA    NA  76745
#> 15 Very Good     D    NA  83312  57617  42237  36710  14682   1426 18114 254098
#> 16 Very Good     E  6707 164585 112414  90421  45633  46216  16852 16474 499302
#> 17 Very Good     F 10640  90164 173023 104353  57590  24961  15475 22877 499083
#> 18 Very Good     G  2988 133754  91859  63196  90789  97253  24230  2151 506220
#> 19 Very Good     H  2850  73086 124936  71239 103507  15029   6475  2571 399693
#> 20 Very Good     I    NA  47089 102178 101361  47980   1289  11335  7951 319183
#> 21 Very Good     J    NA  74032  69433  44767   2849  10161   2042    NA 203284
#> 22   Premium     D 13119  60845 146063  36107  75983  12910   5952    NA 350979
#> 23   Premium     E  3572  96571 132717 135139  70399  32273   7701  6144 484516
#> 24   Premium     F  5896 144000 100753 135135  59548  15123   7718 18160 486333
#> 25   Premium     G 19580 148256 111278 180735 100370  39591  18677  1847 620334
#> 26   Premium     H 13321 203818 160108 161620  98884  17926  10046  3028 668751
#> 27   Premium     I  6436 126824 112927  91604  50340  23292   4553  3729 419705
#> 28   Premium     J  2195  93865  42461  96399  79836  12850    994  9596 338196
#> 29     Ideal     D    NA  36893 111255 128776  78128  60124  15407  4216 434799
#> 30     Ideal     E    NA 117900 126845 118332  58749  81276  42797  7323 553222
#> 31     Ideal     F 23323 114836 137310 153054 108434 132094  90199 44013 803263
#> 32     Ideal     G    NA 108961 102594 206233 176063 186596 167161 28904 976512
#> 33     Ideal     H  7068 136811 201787 128418  40020  23152  27539 29354 594149
#> 34     Ideal     I    NA 115069 113838  81508  72743  40227  26039  5263 454687
#> 35     Ideal     J    NA  34881  78256 106134  30380   4317   9814   569 264351


df_data_to_color <- pivotr(diamonds, cvars = c("clarity", "cut", "color"), nvar = "price", fun = "n_obs") %>%
  dtab() %>%
  formatStyle(
    "SI2",
    backgroundColor  = styleInterval(c(5, 10), c("red", "", ""))
  )




df_data_to_color$x$data <- df_data_to_show$x$data

#TO run
#df_data_to_color

a first attempt using gt()

library(tidyverse)
library(gt)


#data table
(hiris <- head(iris) %>% select(Sepal.Length,Sepal.Width))

set.seed(42)
#format table
(ftb <- matrix(sample.int(2,size=12,replace=TRUE),nrow = 6,ncol=2) %>% 
  as.data.frame() %>% 
  setNames(names(hiris)))

mapper <- function(df,v){
        tab_style(df,
          style=cell_fill(color="lightblue"),
          locations = cells_body(columns = vars({{v}}),
                                 rows = which(ftb[[{{v}}]]==2))
        )
      }
    
hiris %>% gt() %>% 
  mapper(v="Sepal.Length") %>% 
  mapper(v="Sepal.Width")

That can definitely work. Is there a way to do that as simply in DT?

I don't know too much about gt but is there a way to convert from gt to DT?

I don't know but I doubt it.
You can place it in an app like this though


library(shiny)

ui <- fluidPage(
  gt::gt_output("mytable")
)

server <- function(input, output, session) {
  output$mytable <- render_gt(
    mygt # have a gt here
  )
}

shinyApp(ui, server)

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.