Передайте параметр реактивной функции

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

У меня есть диаграмма с осями X и Y, которые могут меняться в зависимости от ввода пользователя. Пользователь сможет щелкнуть диаграмму, и у меня есть текстовый дисплей, который говорит что-то вроде: «Вы выбрали (имя метки x) значение xxx и (имя метки y) значение yyy. '. Очевидно, что если имя метки x или y начинается с гласной, я хотел бы использовать «an», а не «a». На данный момент я дважды написал эту функцию в серверном модуле, но это не очень элегантно.

Есть ли способ определить функцию внутри функции сервера, которой я могу просто отправить имя метки и которая будет просто возвращать 'a' или 'an'? Код ниже. Обратите внимание, что набор данных Pokemon путешествует с пакетом highcharter и может быть загружен с CRAN.

library(ggplot2)
library(highcharter)

myData <- pokemon

ui <- fluidPage(
  # Some custom CSS for a smaller font for preformatted text
  tags$head(
    tags$style(HTML("
                    pre, table.table {
                    font-size: smaller;
                    }
                    "))
    ),
  tags$head(tags$style(type = "text/css", ".shiny-text-output, .well{background-color: #EFF8CD;}")),

  fluidRow(
    column(width = 3
           ),
    column(width = 5,
           plotOutput("plot1", height = 450,
                      # Equivalent to: click = clickOpts(id = "plot_click")
                      click = "plot_click"
           )
    ),
    column(width = 4,
           ## Text output here.
             wellPanel(
               h4("Your results"),
               htmlOutput("chartDetails")
             )
           )
  )
)


server <- function(input, output) {
  output$plot1 <- renderPlot({
      ggplot(myData, aes(weight, attack)) + geom_point()
    }
  )

  ## Extract some values when plot is clicked
  inputX <- reactive({
    if (is.null(input$plot_click$x))
        {
          -999
          }
    else
      {
        round(input$plot_click$x, 0)
      }
    })
  inputY <- reactive({
    if (is.null(input$plot_click$y))
    {
    -999
    }
    else
    {
     round(input$plot_click$y, 0) 
    }
  })

  labelX <- eventReactive(input$plot_click, {
    input$plot_click$mapping$x
  })
  labelY <- eventReactive(input$plot_click,{
    input$plot_click$mapping$y
  })

  ## count the number of points that have a higher x and y.
  mySubset <- eventReactive(input$plot_click, {
    #myFirstSubset <- subset(myData, weight > inputX())
    subset(myData, labelX() > inputX() & labelY() > inputY())
    })


  ## Create relevant strings out of the inputX and inputY values.
  stringX <- reactive({
    if (inputX() > -999)
    {
      myString <- "You have selected"
      if (substr(labelX(), 1,1) %in% c("a", "e", "i", "o", "u"))
      {
        myString <- paste(myString, "an")
      }
      else
      {
        myString <- paste(myString, "a")
      }
      paste(myString, labelX(), "of", inputX())
    }
    else
    {
      ""
    }
  })

  stringY <- reactive({
    if (inputY() > -999)
    {
      myString <- "and"
      if (substr(labelY(), 1,1) %in% c("a", "e", "i", "o", "u"))
      {
        myString <- paste(myString, "an")
      }
      else
      {
        myString <- paste(myString, "a")
      }
      paste(myString, labelY(), "of", inputY())
    }
    else
    {
      ""
    }
  })

  stringCount <- reactive({
    if (inputY() > -999 && inputX() > -999)
    {
      paste("The number of records with higher",labelX(), "and", labelY(), "is", nrow(mySubset()))
    }
    else
    {
      ""
    }
  })

  ## Post the results to the chart details well.
  output$chartDetails <- renderUI({
    if (inputX() > -999 && inputY() > -999) {

    HTML(paste(stringX(), "<br>",
               stringY(), "<br>",
               stringCount()))
    }
    else
    {
      HTML("Click on the chart")
    }

  })

}

    shinyApp(ui, server)

r ggplot2 shiny r-highcharter
person Hester Lyons    schedule 29.01.2018    source источник
comment
Вы можете определить обычную функцию, которая проверяет первый символ и возвращает или только за пределами пользовательского интерфейса и сервера, или в global.R.   -  person Dieter Menne    schedule 29.01.2018
comment
Спасибо. Честно говоря, я сегодня не вижу леса за деревьями. Я отправлю рабочий ответ.   -  person Hester Lyons    schedule 29.01.2018

Ответы (2)


arrow_upward
0
arrow_downward

Я не знаю точно, хотите ли вы этого, но вы можете заменить две функции на функцию гласной

vowel <- function(myString, label){
    if (substr(label, 1,1) %in% c("a", "e", "i", "o", "u"))
   {
     myString <- paste(myString, "an")
   }
   else
   {
     myString <- paste(myString, "a")
   }
   return(myString)
 }

 ## Create relevant strings out of the inputX and inputY values.
 stringX <- reactive({
   if (inputX() > -999)
   {
     myString <- "You have selected"

     paste(vowel(myString,labelX()), labelX(), "of", inputX())
   }
   else
   {
     ""
   }
 })

 stringY <- reactive({
   if (inputY() > -999)
   {
     myString <- "and"

     paste(vowel(myString,labelY()), labelY(), "of", inputY())
   }
   else
   {
     ""
   }
 })
person Winicius Sabino    schedule 29.01.2018

arrow_upward
2
arrow_downward

Простое решение, предложенное Дитером Менне, выглядит следующим образом:

Вне функций пользовательского интерфейса / сервера:

myConnective <- function(aString) {
  if (substr(aString, 1,1) %in% c("a", "e", "i", "o", "u"))
  {
    myString <- "an"
  }
  else
  {
    myString <- "a"
  }
  return(myString)
}

Затем внутри функции сервера:

stringX <- reactive({
    if (inputX() > -999)
    {
      paste("You have selected", myConnective(labelX()), labelX(), "of", inputX() )
    }
    else
    {
      ""
    }
  })
person Hester Lyons    schedule 29.01.2018