как решить реактивность - PullRequest
Новая
       8

как решить реактивность

0 голосов
/ 20 мая 2018

Я хотел бы напечатать график, но у меня есть проблема с реактивностью в моем коде Rshiny.Не могли бы вы помочь мне, пожалуйста?

Я думаю, что проблема связана с "(input $ station)" ...

Вы можете найти под моей другой таблицей: TEM для температуры и PRE для осадков: 

"SOUNAME" "year_month" "tem_type" "tem_value"
"1" "WATERFORD (TYCOR)                       " "2014-04" "V_COLD" NA
"2" "WATERFORD (TYCOR)                       " "2014-04" "COLD" "30"
"3" "WATERFORD (TYCOR)                       " "2014-04" "HOT" NA
"4" "WATERFORD (TYCOR)                       " "2014-04" "MEDIUM" NA
"5" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "V_COLD" NA
"6" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "COLD" "31"
"7" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "HOT" NA
"8" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "MEDIUM" NA
"9" "DUBLIN PHOENIX PARK                     " "2014-05" "V_COLD" NA
"10" "DUBLIN PHOENIX PARK                     " "2014-05" "COLD" "29"
"11" "DUBLIN PHOENIX PARK                     " "2014-05" "HOT" "2"
"12" "DUBLIN PHOENIX PARK                     " "2014-05" "MEDIUM" NA
"13" "WATERFORD (TYCOR)                       " "2014-05" "V_COLD" NA
"14" "WATERFORD (TYCOR)                       " "2014-05" "COLD" "31"
"15" "WATERFORD (TYCOR)                       " "2014-05" "HOT" NA
"16" "WATERFORD (TYCOR)                       " "2014-05" "MEDIUM" NA
"17" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "V_COLD" NA
"18" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "COLD" "24"
"19" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "HOT" "6"
"20" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "MEDIUM" NA
"21" "DUBLIN PHOENIX PARK                     " "2014-06" "V_COLD" NA
"22" "DUBLIN PHOENIX PARK                     " "2014-06" "COLD" "20"
"23" "DUBLIN PHOENIX PARK                     " "2014-06" "HOT" "10"
"24" "DUBLIN PHOENIX PARK                     " "2014-06" "MEDIUM" NA
"25" "WATERFORD (TYCOR)                       " "2014-06" "V_COLD" NA
"26" "WATERFORD (TYCOR)                       " "2014-06" "COLD" "17"
"27" "WATERFORD (TYCOR)                       " "2014-06" "HOT" "13"

"SOUNAME" "year_month" "pre_type" "pre_value"
"1" "WATERFORD (TYCOR)                       " "2014-04" "NONE" "14"
"2" "WATERFORD (TYCOR)                       " "2014-04" "HEAVY" "3"
"3" "WATERFORD (TYCOR)                       " "2014-04" "LIGHT" "7"
"4" "WATERFORD (TYCOR)                       " "2014-04" "MEDIUM" "6"
"5" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "NONE" "3"
"6" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "HEAVY" "6"
"7" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "LIGHT" "20"
"8" "BALLYSHANNON (CATHLEENS FALL)           " "2014-05" "MEDIUM" "2"
"9" "DUBLIN PHOENIX PARK                     " "2014-05" "NONE" "8"
"10" "DUBLIN PHOENIX PARK                     " "2014-05" "HEAVY" "2"
"11" "DUBLIN PHOENIX PARK                     " "2014-05" "LIGHT" "13"
"12" "DUBLIN PHOENIX PARK                     " "2014-05" "MEDIUM" "8"
"13" "WATERFORD (TYCOR)                       " "2014-05" "NONE" "15"
"14" "WATERFORD (TYCOR)                       " "2014-05" "HEAVY" "3"
"15" "WATERFORD (TYCOR)                       " "2014-05" "LIGHT" "10"
"16" "WATERFORD (TYCOR)                       " "2014-05" "MEDIUM" "3"
"17" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "NONE" "16"
"18" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "HEAVY" "2"
"19" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "LIGHT" "9"
"20" "BALLYSHANNON (CATHLEENS FALL)           " "2014-06" "MEDIUM" "2"
"21" "DUBLIN PHOENIX PARK                     " "2014-06" "NONE" "18"
"22" "DUBLIN PHOENIX PARK                     " "2014-06" "HEAVY" "1"
"23" "DUBLIN PHOENIX PARK                     " "2014-06" "LIGHT" "8"
"24" "DUBLIN PHOENIX PARK                     " "2014-06" "MEDIUM" "3"
"25" "WATERFORD (TYCOR)                       " "2014-06" "NONE" "17"
"26" "WATERFORD (TYCOR)                       " "2014-06" "HEAVY" "2"
"27" "WATERFORD (TYCOR)                       " "2014-06" "LIGHT" "9"
"28" "WATERFORD (TYCOR)                       " "2014-06" "MEDIUM" "2"
"29" "BALLYSHANNON (CATHLEENS FALL)           " "2014-07" "NONE" "3"
"30" "BALLYSHANNON (CATHLEENS FALL)           " "2014-07" "HEAVY" "3"
"31" "BALLYSHANNON (CATHLEENS FALL)           " "2014-07" "LIGHT" "22"
"32" "BALLYSHANNON (CATHLEENS FALL)           " "2014-07" "MEDIUM" "3"

Ниже приведен код для Rshiny.Я хотел бы иметь график, я хотел бы иметь диаграмму с раскрывающимся списком для выбора городов, которые меняются в зависимости от городов ... 

library("shiny")
library("markdown")
library("ggplot2")

PRE <- read.table("E:/PRE.txt",sep = " ",header = TRUE)
TEM <- read.table("E:/TEM.txt",sep = " ",header = TRUE)

test1 <- PRE[5:8,]
test2 <- PRE[17:20,]
test3 <- PRE[29:32,]
PRE_B <- rbind(test1,test2,test3)
test1 <- TEM[5:8,]
test2 <- TEM[17:20,]
test3 <- TEM[29:32,]
TEM_B <- rbind(test1,test2,test3)

TEM_B$SOUNAME <- as.factor(TEM_B$SOUNAME)
TEM_B$tem_type <- as.factor(TEM_B$tem_type)
TEM_B$tem_value <- as.numeric(TEM_B$tem_value)
PRE_B$SOUNAME <- as.factor(PRE_B$SOUNAME)
PRE_B$pre_type <- as.factor(PRE_B$pre_type)
PRE_B$pre_value <- as.integer(PRE_B$pre_value)

#WATERFORD
test1 <- PRE[1:4,]
test2 <- PRE[13:16,]
test3 <- PRE[25:28,]
PRE_W <- rbind(test1,test2,test3)
test1 <- TEM[1:4,]
test2 <- TEM[13:16,]
test3 <- TEM[25:28,]
TEM_W <- rbind(test1,test2,test3)
TEM_W$SOUNAME <- as.factor(TEM_W$SOUNAME)
TEM_W$tem_type <- as.factor(TEM_W$tem_type)
TEM_W$tem_value <- as.numeric(TEM_W$tem_value)

PRE_W$SOUNAME <- as.factor(PRE_W$SOUNAME)
PRE_W$pre_type <- as.factor(PRE_W$pre_type)
PRE_W$pre_value <- as.integer(PRE_W$pre_value)
test1 <- PRE[9:12,]
test2 <- PRE[21:24,]
PRE_D <- rbind(test1,test2)
test1 <- TEM[9:12,]
test2 <- TEM[21:24,]
TEM_D <- rbind(test1,test2)

TEM_D$SOUNAME <- as.factor(TEM_D$SOUNAME)
TEM_D$tem_type <- as.factor(TEM_D$tem_type)
TEM_D$tem_value <- as.numeric(TEM_D$tem_value)

PRE_D$SOUNAME <- as.factor(PRE_D$SOUNAME)
PRE_D$pre_type <- as.factor(PRE_D$pre_type)
PRE_D$pre_value <- as.integer(PRE_D$pre_value)

ui<-fluidPage(
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      selectInput("station",
                  label = h2("City"),
                  choices=list("Ballyshannon"="BALLYSHANNON (CATHLEENS FALL)" ,
                               "Waterford"="WATERFORD (TYCOR)",
                               "Dublin"="DUBLIN PHOENIX PARK"
                  ),
                  selected="BALLYSHANNON (CATHLEENS FALL)"),
      h2("Species"),
      checkboxInput("ani",label="print", value=FALSE),
      h2("Save the first plot")

    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("plot1"),
      plotOutput("plot2")
    )
  ))

server<-function(input, output) {
  choice1 <- function(nomstation) {
    switch(nomstation,
           "BALLYSHANNON (CATHLEENS FALL)"=y<-TEM_B,
            "WATERFORD (TYCOR)"=y<-TEM_W,
           "DUBLIN PHOENIX PARK"=y<-TEM_D
    )
    return(y)
  }
  choice2 <- function(nomstation) {
    switch(nomstation,
           "BALLYSHANNON (CATHLEENS FALL)"=y<-PRE_B,
           "WATERFORD (TYCOR)"=y<-PRE_W,
           "DUBLIN PHOENIX PARK"=y<-PRE_D
    )
    return(y)
  }  

  station<-reactive(input$station)
  tema<-choice1(input$station)
  prea<-choice2(input$station)
  plottdour <- function(pre,tem){

    ggplot(data = pre, aes(x = pre$year_month, 
                             y = pre$pre_value, 
                             fill = pre$pre_type,width=0.2)) + 
      geom_bar(aes(x = as.numeric(year_month)+0.25, 
                   y = pre$pre_value, 
                   fill = pre$pre_type),
               stat = "identity",position = position_stack()) + 
      xlab("date") + ylab ("Number of days of precipitation") + 
      ggtitle("Precipitation per month - BIRR") + labs(fill = "Frequency")+
      geom_bar(data=TEM_D,aes(x=as.numeric(tem$year_month)-0.25,
                              y=tem$tem_value,
                              fill=tem$tem_type), stat = "identity",position = position_stack()) +
      xlab("date") + ylab("Number of days of temperature") + 
      ggtitle("Temperature per month - BIRR") + labs(fill = "Frequency")+
      theme(panel.background=element_blank())
    }

Z<-plottdour(tema,prea)

output$plot1<- renderPlot(
  Z
)
}
shinyApp(server=server,ui=ui)

1 Ответ

0 голосов
/ 20 мая 2018

Я не запускал для воспроизведения проблемы, но кажется, что (Пожалуйста, просмотрите Как сделать отличный воспроизводимый пример R? )

Ваша реактивная функция никогда не вызывается 

station<-reactive(input$station)

Измените tema и prea на реактивную функцию вызывающей станции 

tema<-reactive(choice1(station()))

prea<-reactive( choice2(station()))

Возможно, вы хотите, чтобы tema и prea были реактивными 

tema<-reactive({
  choice1(input$station)
})

prea<-reactive({
  choice2(input$station)
})

Z<-plottdour(tema(),prea())

У меня сработал следующий отсканированный код,К сожалению, только Дублин подготовил сюжет, у остальных есть проблемы.

server<-function(input, output) {
  choice1 <- function(nomstation) {
    switch(nomstation,
           "BALLYSHANNON (CATHLEENS FALL)"=y<-TEM_B,
           "WATERFORD (TYCOR)"=y<-TEM_W,
           "DUBLIN PHOENIX PARK"=y<-TEM_D
    )
    return(y)
  }
  choice2 <- function(nomstation) {
    switch(nomstation,
           "BALLYSHANNON (CATHLEENS FALL)"=y<-PRE_B,
           "WATERFORD (TYCOR)"=y<-PRE_W,
           "DUBLIN PHOENIX PARK"=y<-PRE_D
    )
    return(y)
  }  

  tema<-reactive({
    choice1(input$station)
  })

  prea<-reactive({
    choice2(input$station)
  })

  output$plot1<- renderPlot(
    {
    pre <- prea()
    tem <- tema()
    print(pre)
    ggplot(data = pre, aes(x = pre$year_month, 
                           y = pre$pre_value, 
                           fill = pre$pre_type,width=0.2)) + 
      geom_bar(aes(x = as.numeric(pre$year_month)+0.25, 
                   y = pre$pre_value, 
                   fill = pre$pre_type),
               stat = "identity",position = position_stack()) + 
      xlab("date") + ylab ("Number of days of precipitation") + 
      ggtitle("Precipitation per month - BIRR") + labs(fill = "Frequency")+
      geom_bar(data=TEM_D,aes(x=as.numeric(tem$year_month)-0.25,
                              y=tem$tem_value,
                              fill=tem$tem_type), stat = "identity",position = position_stack()) +
      xlab("date") + ylab("Number of days of temperature") + 
      ggtitle("Temperature per month - BIRR") + labs(fill = "Frequency")+
      theme(panel.background=element_blank())
    }
  )
}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...