Help creating dynamic tables based on drag and drop GUI

Hi! This is a really specific question but the R Community has been so wonderful with code help I figured it's worth a shot. I want to make a dynamic table GUI where the user can drag blocks to perform aggregate functions.

If you drag in the mean block, you can see in the Table area that we take the mean of the dataframe. If you drag in the ANOVA block, you can get the p-value of the dataframe, and even filter out one of the three groups in the dataset. By changing the dropdown the p-value dynamically changes in the table.

I want to rbind each block generated dataframe together, while making sure when the user changes the dropdown the p-value still changes. This is further complicated by the user dragging in another ANOVA block (filtered by a different group).

I need to be able to use the proper ANOVA block index to grab the correct dropdown menu to create a stacked table of values and I've used the make.unique function as an attempt to be able to use the unique indexes

Input

ttest_troubleshoot

Desired Output Table

Aggregate    Value
ANOVA        0.46
MEAN         210
ANOVA        0.64

The blocks work individually (if you only drag in ONLY the mean block, or ONLY one ANOVA block, but I want the blocks to work in every combination)

Anyone have any ideas, general or specific?
Any help appreciated!!!

library(shinyjqui)

# creating a vector of blocks - note the two ANOVA blocks
# we can use make.unique to create an index for each block and it's dropdown menu
test <- make.unique(c("ANOVA", "mean", "ANOVA"))

data <- data.frame(numeric = c(10,20,300,40,500,60,70,800,90),
          categorical = c("one", "two", "three", "one", "two", "three", "one", "two", "three"),
          dropdown = c(rep("grp_1", 3), rep("grp_2", 3), rep("grp_3", 3)))

aggBlocks <- function(data, name)
{
  div(style = "
      text-align: center;
      font-size: 12px;
      background-color: #A9A9A9;
      border-radius: 10px;
      color: black; margin-bottom: 5px;
      ",
      drag = name,
      id = name,
      if (grepl('^ANOVA', name)) {
        selectInput(name, "ANOVA", choices = c("grp_1", "grp_2", "grp_3"), selectize = FALSE)
      } else {
        name
      }
  )
}


library(shiny)

ui <- fluidPage(
  
  sidebarPanel(
    
    fluidRow(
      column(6, 
             # create the blocks
             jqui_sortable(div(id = "row_source",
                               lapply(test, aggBlocks, data = test), 
                               style = "min-height: 200px; border:2px solid #000000"),
                           options = list(connectWith = "#row_dest"))),
      # create drag area
      column(6, jqui_sortable(div(id = "row_dest",
                                  style = "min-height: 200px; border:2px solid #000000"),
                              options = list(connectWith = "#row_source")))
    )
  ),
  
  
  mainPanel(
    fluidRow(
      column(6, h1("Debug"), 
             h4("Each block is seen in order of the drop area, with drop downs stored as 'word'. Bring the blocks into the drop zone and switch their orders and dropdowns"), 
             tableOutput('debug')),
      column(6, h2("Table"), 
             h4("Create stacked dataframes based on the selected drop down, where Aggregate = the block that was dragged, and Value = either a p-value or the meam of numeric"),
             tableOutput('table'))
    )
  )
)


server <- function(input, output, session) {
  
  d <-  reactive({
  req(length(input$row_dest_order) > 0)
  dat <- data.frame(input$row_dest_order)
  for (i in 1:nrow(dat)) {
    if (grepl('^ANOVA', dat$id[i])) {
      dat$word[i] <- input[[dat$id[i]]]
    } else {
      dat$word[i] <- NA
    }
  }
  dat
  })
  
  output$debug <- renderTable({
    d()
  })
  
  row <- reactive({ str_replace_all(input$row_dest_order$text, "[\r\n]" , "")  })
  datalist = list()
  
  dataFrame <- reactive({
    for (i in 1:length(row())) {
      if (row()[i] == "mean") {
        t <- data %>% summarise(mean = mean(numeric))
        d <- data.frame(Aggregate = "mean", Value = t$mean)
        datalist[[i]] <- d
      } else {
        # filter the value in the anova block's selected group
        # this needs to be indexed by the proper block in the proper order
        # and if the user switches around blocks or changes the p-value
        # the new value needs to be reflected
        t <- data %>% filter(dropdown != d()$word[i])
        ttest <- tidy(aov(numeric ~ dropdown, data=t))
        d <- data.frame(Aggregae = "ANOVA", Value = ttest$p.value[1])
        datalist[[i]] <- d
      }
    }
    big_data = do.call(rbind, datalist)
  })
  
  output$table <- renderTable({
    dataFrame()
  })
  
}

shinyApp(ui, server)

Hi @MayaGans. Your code work properly except a minor mistake that the column name of mean is Aggregate and the column name of ANOVA is Aggregae (missing a "t"). So, the data frame cannot rbind.

1 Like

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