Как настроить FluidRow в Shiny - PullRequest
Новая
       8

Как настроить FluidRow в Shiny

0 голосов
/ 05 сентября 2018

Так что я пытаюсь создать этот вывод, но в виде панели с использованием Shiny. Следует отметить, что это моя вторая неделя с использованием Shiny, поэтому я очень неопытный.

Рисунок

Вот мой код: 

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(gapminder)


gm <- gapminder 
gm <- transform(gm, pop = as.numeric(pop))

cgm <- gm %>% group_by(continent,year) %>% summarise(totpop=sum(pop),avglifeExp=sum(pop*lifeExp)/totpop,avggdpPercap=sum(pop*gdpPercap)/totpop, numCountries=n())

body <- dashboardBody(

    fluidRow(

     tabBox(
      title = "Population",
      id = "proj", width=12,      
      tabPanel("Visualization", plotOutput("ggp"),    
      tabPanel("GapMinder Data", dataTableOutput("table")),
      tabPanel("Aggregated GapMinder Data", dataTableOutput("table1"))
    )

  )
),
    fluidRow(sliderInput("slider1", label = h3("Year"), min = 1952, 
        max = 2007, value = 1952, step = 5, sep ="", width="100%"))
)

# This is UI, it has a clean look because we defined body up above. 
ui <- dashboardPage(
    dashboardHeader(title = "Module 2"),
    dashboardSidebar(
        helpText("GapMinder Data: Worldwide average life expectancy, population and GPD per Capita 1952-2007"),
        menuItem),
    body
  )

# This is server function is the same as in the layout practice. 
server <- function(input, output) {

      output$tabPanelSelected <- renderText({
        input$proj

      })

      output$ggp <- renderPlot({ 

          p <- ggplot(data=subset(gm, year==input$Year), aes(x=lifeExp)) +  geom_density(alpha=.2, fill="red") + xlab("Life Expectancy")

          q <- ggplot(data=subset(cgm,year==input$Year), aes(x=continent, y=totpop, fill=continent)) + geom_bar(stat="identity")            

          r <- ggplot(data=subset(cgm,year==input$Year), aes(x=continent, y=avggdpPercap, fill=continent)) + geom_bar(stat="identity")  
      print(p)
      print(q)
      print(r)   
  })

    output$table <- renderDataTable({gm})
    output$table1 <- renderDataTable({cgm})
}

shinyApp(ui=ui, server=server)

Вот сообщение об ошибке, которое я получаю: Сообщение об ошибке

Так что я не могу понять, что происходит с моим кодом в теле. Я думаю, что код пользовательского интерфейса в порядке, и я почти уверен, что мой серверный код не в синтаксисе, но сообщение об ошибке на самом деле не позволяет мне его декодировать. Есть идеи?

1 Ответ

0 голосов
/ 05 сентября 2018

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

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(gapminder)


gm <- gapminder 
gm <- transform(gm, pop = as.numeric(pop))

cgm <- gm %>% group_by(continent,year) %>% summarise(totpop = sum(pop),avglifeExp = sum(pop*lifeExp)/totpop,avggdpPercap = sum(pop*gdpPercap)/totpop, numCountries=n())


# This is UI, it has a clean look because we defined body up above. 
ui <- dashboardPage(
  dashboardHeader(title = "Module 2"),

  dashboardSidebar(
    helpText("GapMinder Data: Worldwide average life expectancy, population and GPD per Capita 1952-2007")
    ),

  dashboardBody(

  #  fluidRow(
      # 
      # tabBox(
      #   title = "Population",
      #   id = "proj",      
        tabPanel("Visualization",
                 fluidRow(
                   column(4,
                          plotOutput("ggp")),
                   column(4,
                          plotOutput("ggp2")),
                   column(4,
                          plotOutput("ggp3"))

                 )
                 #tabPanel("GapMinder Data", dataTableOutput("table")),
                 #tabPanel("Aggregated GapMinder Data", dataTableOutput("table1"))
      #   )
      #   
      # )
    ),
    fluidRow(sliderInput("slider1", label = h3("Year"), min = 1952, 
                         max = 2007, value = 1952, step = 5, sep = "", width="100%"))
  )
)

# This is server function is the same as in the layout practice. 
server <- function(input, output, session) {
  session$onSessionEnded(stopApp)
  # output$tabPanelSelected <- renderText({
  #   input$proj
  #   
  # })

  output$ggp <- renderPlot({ 

    ggplot(data = subset(gm, year = input$Year), aes(x = lifeExp)) +  geom_density(alpha = 0.2, fill = "red") + xlab("Life Expectancy")
  })
  output$ggp2 <- renderPlot({
    ggplot(data = subset(cgm,year = input$Year), aes(x = continent, y = totpop, fill = continent)) + geom_bar(stat = "identity")            
  })
  output$ggp3 <- renderPlot({
    ggplot(data = subset(cgm,year = input$Year), aes(x = continent, y = avggdpPercap, fill = continent)) + geom_bar(stat = "identity")  
    # print(p)
    # print(q)
    # print(r)   
  })

  #output$table <- renderDataTable({gm})
  #output$table1 <- renderDataTable({cgm})
}

shinyApp(ui = ui, server = server)

С минимальным знанием блеска я чувствовал, что есть несколько причин, почему вы не получаете никаких заговоров.

  1. Вы не реализовали menuItem полностью. Просто удалив это menuItem, вы могли видеть, что больше не получаете вышеупомянутую ошибку.
  2. == является оператором сравнения, а не оператором присваивания. Поэтому замените == на = в ggplot. Теперь вы можете увидеть хотя бы один сюжет.
  3. Для каждого графика вам нужно определить его отдельно в UI, чтобы вы могли назначьте этот идентификатор позже в server коде и определите этот график индивидуально.

Я предполагаю, что вы можете улучшить код в соответствии с вашими требованиями. Если вы застряли где-нибудь, где мы здесь, чтобы помочь вам. Удачи.

...