2015-04-17 9 views
5

Sto usando Shiny insieme a RMarkdown per produrre un documento interattivo, come descritto here.Come controllare l'altezza/dimensione del grafico in RMarkdown interattivo (con Shiny)

utilizzando il seguente codice, sono riuscito a tracciare una mappa interattiva

```{r, echo=FALSE, warning=FALSE, message=FALSE} 

g2g14 <- readOGR("input//geodata", "g2g14") # no projection needs to be specified 
old_geodata <- [email protected] 

inputPanel(
    selectInput("map.party", label = "Partei", choices = unique(long_data$Partei), selected = "FDP"), 
    selectInput("map.year", label = "Wahljahr", choices = unique(format.Date(long_data$Jahr, "%Y")), selected = "1971") 
) 

renderPlot({ 
    partydata <- long_data %>% 
    filter(Partei == input$map.party & Jahr == as.Date(input$map.year, "%Y")) 
    [email protected] <- old_geodata 
    [email protected] <- merge([email protected], partydata, by.x = "GMDNR",by.y ="BFSNr") 

    cols <- brewer.pal(5, "Purples") 
    brks <- seq(0,100,20) 
    colsForMap <- cols[findInterval([email protected]$Staerke, vec = brks[1:5])] 

    plot(g2g14, col = colsForMap, border = "white") 
    legend("topleft", legend = levels(cut([email protected]$Staerke, brks)), fill = cols, border = "white", title = "Parteistärke in %") 

}) 

Il problema: La mappa è ben scalato quando si esegue il codice dalla console, ma nel documento interattivo, la trama è troppo piccolo :

enter image description here

Questo probabilmente deriva dalla limitata altezza della regione stampa. Ho già provato a impostare un numero molto grande di fig.height = 20 nelle opzioni del blocco, ma senza risultati. Cosa fare?

risposta

2

È possibile aggiungere solo le opzioni width e height in renderPlot. Digitare ?renderPlot per ulteriori informazioni.

Nel tuo caso,

renderPlot({ 
    partydata <- long_data %>% 
    filter(Partei == input$map.party & Jahr == as.Date(input$map.year, "%Y")) 
    [email protected] <- old_geodata 
    [email protected] <- merge([email protected], partydata, by.x = "GMDNR",by.y ="BFSNr") 

    cols <- brewer.pal(5, "Purples") 
    brks <- seq(0,100,20) 
    colsForMap <- cols[findInterval([email protected]$Staerke, vec = brks[1:5])] 

    plot(g2g14, col = colsForMap, border = "white") 
    legend("topleft", legend = levels(cut([email protected]$Staerke, brks)), fill = cols, border = "white", title = "Parteistärke in %") 
}, width = 1200, height = 900) ## <--- add outside the curly braces 
3

È possibile farlo con un solo passo in più - aggiungere un renderUI:

```{r, echo=FALSE, warning=FALSE, message=FALSE} 

g2g14 <- readOGR("input//geodata", "g2g14") # no projection needs to be specified 
old_geodata <- [email protected] 

inputPanel(
    selectInput("map.party", label = "Partei", choices = unique(long_data$Partei), selected = "FDP"), 
    selectInput("map.year", label = "Wahljahr", choices = unique(format.Date(long_data$Jahr, "%Y")), selected = "1971") 
) 

output$unsized <- renderPlot({ 
    partydata <- long_data %>% 
    filter(Partei == input$map.party & Jahr == as.Date(input$map.year, "%Y")) 
    [email protected] <- old_geodata 
    [email protected] <- merge([email protected], partydata, by.x = "GMDNR",by.y ="BFSNr") 

    cols <- brewer.pal(5, "Purples") 
    brks <- seq(0,100,20) 
    colsForMap <- cols[findInterval([email protected]$Staerke, vec = brks[1:5])] 

    plot(g2g14, col = colsForMap, border = "white") 
    legend("topleft", legend = levels(cut([email protected]$Staerke, brks)), fill = cols, border = "white", title = "Parteistärke in %") 

}) 

renderUI({ 
    plotOutput("unsized", height = 500, width = 500) 
}) 
``` 

Testato con il documento di esempio che si crea quando si avvia una nuova doc RMD-lucido:

```{r, echo=FALSE} 
inputPanel(
    selectInput("n_breaks", label = "Number of bins:", 
       choices = c(10, 20, 35, 50), selected = 20), 

    sliderInput("bw_adjust", label = "Bandwidth adjustment:", 
       min = 0.2, max = 2, value = 1, step = 0.2) 
) 

output$unsized <- renderPlot({ 
    hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input$n_breaks), 
     xlab = "Duration (minutes)", main = "Geyser eruption duration") 

    dens <- density(faithful$eruptions, adjust = input$bw_adjust) 
    lines(dens, col = "blue") 
}) 

renderUI({ 
    plotOutput("unsized", height = 250, width = 250) 
}) 

``` 
+0

Questa soluzione funziona anche con plotlyOutput(). – FacyMacFacyFace

Problemi correlati