在 Shiny 中控制多个凹坑图的布局 [英] Controlling Layout of Multiple Dimple Charts in Shiny

问题描述

我一直在按照此处的示例研究交互式人口金字塔交互式人口金字塔 .具体来说，我修改了用于人口金字塔的 Dimple.js 实现的代码.在 RStudio 内一切正常，但最终产品最好作为 Shiny 应用程序使用.部署到 Shiny 应用程序时，它运行良好，但我无法控制图表的大小及其位置.我打算在同一页面上有 4 个图表，理想的布局是 4 个象限(2 行和 2 列)，每个象限都有自己的可视化.目前我没有看到如何通过 R 或 Dimple.js 本身来控制我的图表大小或 Dimple.js 图表的布局.对此的任何帮助将不胜感激我当前的代码如下:

I have been working on interactive population pyramids as per the examples here Interactive Population Pyramids . Specifically, I have modified the code used for the Dimple.js implementation of a population pyramid. Within RStudio everything works well, however the end product would best be served as a Shiny App. When deploying to a Shiny app, it works well but I cannot control the size of the chart nor its placement. I intend to have 4 charts on the same page and the ideal layout would be for 4 quadrants (2 rows and 2 columns) each with its own visualization. At the moment am not seeing how I can control my chart sizes nor layout of my Dimple.js charts either via R or Dimple.js itself. Any help to this end would be greatly appreciated My current code is as below:

library(shiny)
library(rcdimple)
library(curl)  #devtools::install_github("jeroenooms/curl")
library(plyr)  # for round_any
library(rCharts)

df <- read.csv(curl("https://raw.githubusercontent.com/kilimba/data/master/data2.csv"))
agegroup_mapping <- read.csv(curl("https://raw.githubusercontent.com/kilimba/data/master/agegroup.csv"))
df <- merge(df,agegroup_mapping,by.x="agegrp",by.y="agegroup")
# Max and minimum year to determine range of years to animate by
maxYear <- max(df$year)
minYear <- min(df$year)
# maximum and minimum values for population to determine x-axis
max_x <- round_any(max(df$n), 1000, f = ceiling)
min_x <- round_any(min(-1*df$n), 1000, f = floor)

getData <- function(startyr,endyear) {
  df <- subset(df,(year >= startyr & year <= endyear))
  return(df)
}

# DimpleJS pyramid

dPyramid <- function(startyear, endyear, colors=NULL) {
  #endyear = endyear + 3 #to test storyboard
  dat <- getData(startyear, endyear)
  dat$n <- ifelse(dat$sex == 'MAL', -1 * dat$n, 1 * dat$n)
  dat$gencode <- ifelse(dat$sex == 'MAL', 1, 2)

  d1 <- dimple(
    x = "n", 
    y = "agegrp", 
    groups = "sex", 
    data = dat, 
    type = 'bar')


  d1 <- yAxis(d1, type = "addCategoryAxis", orderRule = "ord")
  d1 <- xAxis(d1,type = "addMeasureAxis")
  d1 <- add_legend( d1,x = 60, y = 10, width = 700, height = 20, horizontalAlign = "right" )
  # Ensure fixed x-axis indepencent of year selected
  d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)

  if (!is.null(colors)){
    d1 <- colorAxis(
      d1,
      type = "addColorAxis", 
      colorSeries = "gencode", 
      palette = colors
    )
  }

  if (endyear - startyear >= 1) {
    d1 <- tack(d1, options = list( storyboard = "year" ) )
#     max_x <- round_any(max(dat$n), 1000, f = ceiling)
#     min_x <- round_any(min(dat$n), 1000, f = floor)
#     d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)
  }

  d1
}


#ui.R

# Define UI for application that draws a outcome pyramid
ui <- shinyUI(fluidPage(

  # Application title
  titlePanel("Options"),

  sidebarLayout(
    sidebarPanel(
      checkboxInput("doAnimate", "Animate Pyramid",value = TRUE),
      tags$p("(Uncheck to select specific year)"),
      conditionalPanel(
        condition = "input.doAnimate == false",
        selectInput(    
                  inputId = "startyr",
                  label = "Select Pyramid Year",
                  c(2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014)),
                  width = 2
      ),
      selectInput(inputId = "agegrp",
                  label = "Choose Age Group",
                  choices = c("0-4",
                              "5-9",
                              "10-14",
                              "15-19",
                              "20-24",
                              "25-29",
                              "30-34",
                              "35-39",
                              "40-44",
                              "45-49",
                              "50-54",
                              "55-59",
                              "60-64",
                              "65-69",
                              "70-74",
                              "75-79",
                              "80-84",
                              "85+"
                  ),
                  selected = "0-4")
    ),

    # Show a plot of the generated pyramid
    mainPanel("Multi-Panel Visualizations",
      fluidRow(style="height:300px;"
               ,column(width = 6,dimpleOutput("distPlot",height="100%", width="100%"))
               ,column(width = 6,showOutput("distPlot2","nvd3"))
      )
      ,fluidRow(style="height:300px;"
                ,column(width = 6,dimpleOutput("distPlot3",height="100%"))
                ,column(width = 6,dimpleOutput("distPlot4",height="100%"))
      )
    )
  )
))


# Define server logic required to draw a population pyramid
server <- shinyServer(function(input, output) {

  observe({

    if(input$doAnimate){

    output$distPlot <- renderDimple({
      dPyramid(minYear, maxYear)
    })

  }else{

    output$distPlot <- renderDimple({
      startyear <- as.numeric(input$startyr)
      # Start year and end year are equal we only want cross-sectional pyramid
      # for a single selected year
      dPyramid(startyear, startyear)
    })    
  }
  })
   # Top right quadrant, line-chart
  output$distPlot2 <- renderChart2({

    selection <- subset(df,mapping == input$agegrp)

    plot <- nPlot(n ~ year,
                  data = selection,
                  type = "lineChart",
                  group = "sex")

    # Add axis labels and format the tooltip
    plot$yAxis(axisLabel = "Population", width = 62)

    plot$xAxis(axisLabel = "Year")

    plot$save("ac.html")
    return(plot)    

  })


  output$distPlot3 <- renderDimple({
    startyear <- as.numeric(input$startyr)
    # Both arguments currently for the same thing, startyear, but eventually will want to 
    # process a range of years
    dPyramid(startyear, startyear)
  })
  output$distPlot4 <- renderDimple({
    startyear <- as.numeric(input$startyr)
    # Both arguments currently for the same thing, startyear, but eventually will want to 
    # process a range of years
    dPyramid(startyear, startyear)
  })
})


#shinyApp(ui,server)

它使用的数据可以在这里找到:https://raw.githubusercontent.com/kilimba/data/master/data2.csv

And the data it uses can be found here: https://raw.githubusercontent.com/kilimba/data/master/data2.csv

推荐答案

这可以通过 rCharts 来完成，但是由于 rcdimple https://github.com/timelyportfolio/rcdimple 是 发布 并受益于 htmlwidgets 的基础设施，我强烈建议继续使用它.如果您希望看到 rCharts 答案，请告诉我.

This can be accomplished by rCharts, but since rcdimple https://github.com/timelyportfolio/rcdimple was released and benefits from the infrastructure of htmlwidgets, I would strongly recommend using it going forward. Let me know if you would prefer to see the rCharts answer.

library(shiny)
library(rcdimple)
library(curl)  #devtools::install_github("jeroenooms/curl")
library(plyr)  # for round_any

df <- read.csv(curl("https://raw.githubusercontent.com/kilimba/data/master/data2.csv"))
df$year <- df$ExpYear
df$sex <- df$Sex
df$agegrp <- df$AgeGroup

getData <- function(startyr,endyear) {
  df <- subset(df,(year >= startyr & year <= endyear))
  return(df)
}

# DimpleJS pyramid

dPyramid <- function(startyear, endyear, colors=NULL) {
  #endyear = endyear + 3 to test storyboard
  dat <- getData(startyear, endyear)
  dat$n <- ifelse(dat$sex == 'MAL', -1 * dat$n, 1 * dat$n)
  dat$gencode <- ifelse(dat$sex == 'MAL', 1, 2)

  d1 <- dimple(
    x = "n", 
    y = "agegrp", 
    groups = "sex", 
    data = dat, 
    type = 'bar')


  d1 <- yAxis(d1, type = "addCategoryAxis", orderRule = "ord")
  d1 <- xAxis(d1,type = "addMeasureAxis")
  d1 <- add_legend( d1,x = 60, y = 10, width = 700, height = 20, horizontalAlign = "right" )

  if (!is.null(colors)){
    d1 <- colorAxis(
      d1,
      type = "addColorAxis", 
      colorSeries = "gencode", 
      palette = colors
    )
  }

  if (endyear - startyear >= 1) {
    d1 <- tack(d1, options = list( storyboard = "year" ) )
    max_x <- round_any(max(dat$n), 1000, f = ceiling)
    min_x <- round_any(min(dat$n), 1000, f = floor)
    d1 <- xAxis(d1, overrideMax = max_x, overrideMin = min_x)
  }

  d1
}


#ui.R

# Define UI for application that draws a outcome pyramid
ui <- shinyUI(fluidPage(

  # Application title
  titlePanel("Outcome Pyramid"),

  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "startyr",
                  label = "Select Start Year",
                  c(2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014))
    ),

    # Show a plot of the generated pyramid
    mainPanel(
      fluidRow(style="height:300px;"
        ,column(width = 6,dimpleOutput("distPlot",height="100%"))
        ,column(width = 6,dimpleOutput("distPlot2",height="100%"))
      )
      ,fluidRow(style="height:300px;"
        ,column(width = 6,dimpleOutput("distPlot3",height="100%"))
        ,column(width = 6,dimpleOutput("distPlot4",height="100%"))
      )
    )
  )
))


# Define server logic required to draw a population pyramid
server <- shinyServer(function(input, output) {

  output$distPlot <- renderDimple({
    startyear <- as.numeric(input$startyr)
    # Both arguments currently for the same thing, startyear, but eventually will want to 
    # process a range of years
    dPyramid(startyear, startyear)
  })
  output$distPlot2 <- renderDimple({
    startyear <- as.numeric(input$startyr)
    # Both arguments currently for the same thing, startyear, but eventually will want to 
    # process a range of years
    dPyramid(startyear, startyear)
  })
  output$distPlot3 <- renderDimple({
    startyear <- as.numeric(input$startyr)
    # Both arguments currently for the same thing, startyear, but eventually will want to 
    # process a range of years
    dPyramid(startyear, startyear)
  })
  output$distPlot4 <- renderDimple({
    startyear <- as.numeric(input$startyr)
    # Both arguments currently for the same thing, startyear, but eventually will want to 
    # process a range of years
    dPyramid(startyear, startyear)
  })
})


shinyApp(ui,server)

这篇关于在 Shiny 中控制多个凹坑图的布局的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！