Использование Observe или другой реактивной функции для вывода одной ячейки данных в Shiny - PullRequest
0 голосов
/ 22 октября 2018

Я застрял на последнем и наиболее важном этапе создания моего первого довольно простого веб-приложения с использованием Shiny, и я борюсь с тем, что, по моему мнению, должно быть довольно простой задачей.Идея состоит в том, чтобы приложение наблюдало два входа, а затем выводило одно значение из кадра данных на основе их обоих.

Пример кода, чтобы сделать его очень четким.

Server
    DF X Y Z
    1  A B C
    2  C D E
    3  F G H

UI
    InputA: Row - 2
    InputB: Column - Z

    Output: E

Намомент, когда я столкнулся с общей стеной с этим, потому что я не получаю ошибку.Приложение запускается без проблем, и все остальные виджеты на этой вкладке и другие работают.На данный момент текстовые поля просто ничего не делают.Можно ввести значения в первые два, но затем ничего не выводится и сообщение об ошибке не предоставляется.Это расстраивает, потому что кажется, что я упускаю что-то очень очевидное.

Вот фактический код сервера

server <- function(input, output, session) {
#Download Data and create data table.
  rlwin <- read.csv("rlwinClean.csv")
...
observe({
    Lead <- as.character(input$Lead)
    CalcTime <- as.character(input$CalcTime)
    addtext <- paste(rlwin[rlwin$Time == CalcTime, Lead])
    updateTextInput(session,"winProbability", value=addtext)
    })
 }
...

Интерфейс пользователя:

ui <- (navbarPage(theme=shinytheme("sandstone"), title=h3("Rocket League Win Probability"),
              #Tab1 ----
              tabPanel("Win Probability Model",
                       #The Plot
                       plotOutput("modPlot", height="800px"),
                       #Probabililty Calculator
                       h4("Win Probability Calculator"),
                       textInput(inputId="CalcTime", label="Enter Time on Clock Remaining in Game", placeholder="0:00 to 5:00"),
                       textInput(inputId="Lead", label="Enter Lead or Deficit", placeholder="-4 to 4"),
                       br(""),
                       textInput(inputId="winProbability",label="Win Probability",placeholder="50%"),
                       br("")
                       ),

...

Редактировать: Нашел ответ на это.Вероятно, он немного длинноватый

Сервер

...
observeEvent(input$runCalc,{
  time <- subset(react, GameClock == input$CalcTime)
  all <- subset(time, select = input$Lead)
  val <- paste(all)

updateTextInput(session, inputId = "probText", value = val)
})
....

Пользовательский интерфейс фактически не изменился

Ответы [ 2 ]

0 голосов
/ 23 октября 2018

Следующий код работает для меня.Обратите внимание, что я переименовал некоторые из ваших входных данных, потому что было трудно отслеживать, где ваши входные данные должны были использоваться.

Произошла ошибка, поскольку addText в исходном коде было пустым (логические условияне вернул записей).Ниже вы увидите, как я распечатал вывод на консоль для отладки.

library(shiny)

ui <- (navbarPage( title=h3("Rocket League Win Probability"),
                  #Tab1 ----
                  tabPanel("Win Probability Model",
                           textInput(inputId="column_name", label="Column name", placeholder="X, Y or Z"),
                           textInput(inputId="row_number", label="Row number", placeholder="1, 2 or 3"),
                           br(""),
                           textInput(inputId="winProbability",label="Win Probability",placeholder="50%"),
                           br("")
                  )
))

server <- function(input, output, session) {
  #Download Data and create data table.
  rlwin = data.frame(DF = c(1,2,3), X = c("A","B","C"), Y = c("B","D","G"), Z = c("C","E","H"))

  observe({
    col_name <- as.character(input$column_name)
    row_num <- input$row_number
    addtext <- paste(rlwin[row_num, names(rlwin) == col_name])
    # print("debug print out")
    # print(col_name)
    # print(row_num)
    # print(addtext)
    updateTextInput(session,"winProbability", value=addtext)
  })
}

shinyApp(ui, server)
0 голосов
/ 23 октября 2018

Попробуйте назначить наблюдателя

my_observer <- observe({ .... })
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...