2017-11-26 5 views
2

Ich schreibe eine glänzende App und ich versuche aktualisieren Sie die Größe der Handlung in Abhängigkeit von einigen Eingaben. Das Problem ist, dass wenn die Handlung größer wird, sie nicht zu den kleineren Größen zurückkommt.R glänzend plotly Breite und Höhe nicht aktualisieren

initialize This one doesn't come back to smaller sizes

Dies ist der Code:

library(dplyr) 
library(plotly) 
library(shiny) 

dat <- data.frame(xval = sample(100,1000,replace = TRUE), 
        group1 = as.factor(sample(c("a","b","c"),1000,replace = TRUE)), 
        group2 = as.factor(sample(c("a1","a2","a3","a4"),1000, replace = TRUE)), 
        group3 = as.factor(sample(c("b1","b2","b3","b4"),1000, replace = TRUE)), 
        group4 = as.factor(sample(c("c1","c2","c3","c4"),1000, replace = TRUE))) 


create_plot <- function(dat, group, color, shape) { 
    p <- dat %>% 
     plot_ly() %>% 
     add_trace(x = ~as.numeric(get(group)), 
       y = ~xval, 
       color = ~get(group), 
       type = "box") %>% 
     add_markers(x = ~jitter(as.numeric(get(group))), 
        y = ~xval, 
        color = ~get(color), 
        symbol = ~get(shape), 
        marker = list(size = 4) 
    ) 
    p 
} 

calc_boxplot_size <- function(facet) { 

    if (facet) { 
    width <- 1000 
    height <- 700 
    } else { 
    width <- 500 
    height <- 400 
    } 
    cat(sprintf("WIDTH: %s, HEIGHT: %s", width, height), sep = "\n") 
    list(width = width, height = height) 
} 



ui <- fluidPage(
    selectizeInput("group", label = "group", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("color", label = "color", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("shape", label = "shape", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("facet", label = "facet", choices = c("none", paste0("group", 1:4)), 
       multiple = FALSE, selected = "none"), 
    textOutput("size"), 
    uiOutput("plotbox") 
) 

server <- function(input, output, session) { 

    output$plotbox <- renderUI({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    plotlyOutput("plot", height = psize$height, width = psize$width) 
    }) 

    output$size <- renderText({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    sprintf("WIDTH: %s, HEIGHT: %s", psize$width, psize$height) 
    }) 

    output$plot <- renderPlotly({ 
    if (input$facet == "none") { 
     p <- create_plot(dat, input$group, input$color, input$shape) 
    } else { 
     plots <- dat %>% 
     group_by_(.dots = input$facet) %>% 
     do(p = { 
      create_plot(., input$group, input$color, input$shape) 
     }) 
     p <- subplot(plots, shareX = TRUE, shareY = TRUE, nrows = 3, margin = 0.02) 
    } 
    }) 

} 

shinyApp(ui, server) 

Wenn ich den Code ändern die Breite und Höhe in ... %>% plotly(height = height, width = width) %>% ... aktualisiert, um es nie aktualisiert die Größe des Grundstücks.

Should be bigger

Der Code:

library(dplyr) 
library(plotly) 
library(shiny) 

dat <- data.frame(xval = sample(100,1000,replace = TRUE), 
        group1 = as.factor(sample(c("a","b","c"),1000,replace = TRUE)), 
        group2 = as.factor(sample(c("a1","a2","a3","a4"),1000, replace = TRUE)), 
        group3 = as.factor(sample(c("b1","b2","b3","b4"),1000, replace = TRUE)), 
        group4 = as.factor(sample(c("c1","c2","c3","c4"),1000, replace = TRUE))) 


create_plot <- function(dat, group, color, shape, width, height) { 
    p <- dat %>% 
     plot_ly(width = width, height = height) %>% 
     add_trace(x = ~as.numeric(get(group)), 
       y = ~xval, 
       color = ~get(group), 
       type = "box") %>% 
     add_markers(x = ~jitter(as.numeric(get(group))), 
        y = ~xval, 
        color = ~get(color), 
        symbol = ~get(shape), 
        marker = list(size = 4) 
    ) 
    p 
} 

calc_boxplot_size <- function(facet) { 

    if (facet) { 
    width <- 1000 
    height <- 700 
    } else { 
    width <- 500 
    height <- 400 
    } 
    cat(sprintf("WIDTH: %s, HEIGHT: %s", width, height), sep = "\n") 
    list(width = width, height = height) 
} 



ui <- fluidPage(
    selectizeInput("group", label = "group", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("color", label = "color", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("shape", label = "shape", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("facet", label = "facet", choices = c("none", paste0("group", 1:4)), 
       multiple = FALSE, selected = "none"), 
    textOutput("size"), 
    uiOutput("plotbox") 
) 

server <- function(input, output, session) { 

    output$plotbox <- renderUI({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    plotlyOutput("plot") 
    }) 

    output$size <- renderText({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    sprintf("WIDTH: %s, HEIGHT: %s", psize$width, psize$height) 
    }) 

    output$plot <- renderPlotly({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    if (input$facet == "none") { 
     p <- create_plot(dat, input$group, input$color, input$shape, psize$width, psize$height) 
    } else { 
     plots <- dat %>% 
     group_by_(.dots = input$facet) %>% 
     do(p = { 
      create_plot(., input$group, input$color, input$shape, psize$width, psize$height) 
     }) 
     p <- subplot(plots, shareX = TRUE, shareY = TRUE, nrows = 3, margin = 0.02) 
    } 
    }) 

} 

shinyApp(ui, server) 

es andere Möglichkeiten, um die Größe des Grundstücks, so zu aktualisieren? Bitte helfen Sie.

+0

Ich bin sicher, dass Sie sich bewusst sind, dass Sie können Plot-Diagramme für die Vergrößerung/Verkleinerung direkt von der Benutzeroberfläche aus aktualisieren. Warum verwenden Sie diese Funktion nicht und schreiben stattdessen Code? –

+0

Weil Sie manchmal den Überblick über die Handlung haben wollen und manchmal ist die Handlung so groß, dass sie nicht in die Gegend passt (nicht in meine Beispiele, sondern in die App, die ich mache). Das Zoomen ist ärgerlich, wenn Sie viele Boxplots in einem Plot haben. – potockan

Antwort

0

habe ich benutzerdefinierte Breite und Höhe Eingänge und es funktioniert ... oder vielleicht auch nur ich das Problem nicht bekommen ...

enter image description here enter image description here

library(dplyr) 
library(plotly) 
library(shiny) 

dat <- data.frame(xval = sample(100,1000,replace = TRUE), 
        group1 = as.factor(sample(c("a","b","c"),1000,replace = TRUE)), 
        group2 = as.factor(sample(c("a1","a2","a3","a4"),1000, replace = TRUE)), 
        group3 = as.factor(sample(c("b1","b2","b3","b4"),1000, replace = TRUE)), 
        group4 = as.factor(sample(c("c1","c2","c3","c4"),1000, replace = TRUE))) 


create_plot <- function(dat, group, color, shape, width, height) { 
    p <- dat %>% 
    plot_ly(width = width, height = height) %>% 
    add_trace(x = ~as.numeric(get(group)), 
       y = ~xval, 
       color = ~get(group), 
       type = "box") %>% 
    add_markers(x = ~jitter(as.numeric(get(group))), 
       y = ~xval, 
       color = ~get(color), 
       symbol = ~get(shape), 
       marker = list(size = 4) 
    ) 
    p 
} 

calc_boxplot_size <- function(facet) { 

    if (facet) { 
    width <- 1000 
    height <- 700 
    } else { 
    width <- 500 
    height <- 400 
    } 
    cat(sprintf("WIDTH: %s, HEIGHT: %s", width, height), sep = "\n") 
    list(width = width, height = height) 
} 



ui <- fluidPage(
    selectizeInput("group", label = "group", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("color", label = "color", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("shape", label = "shape", choices = paste0("group", 1:4), 
       multiple = FALSE), 
    selectizeInput("facet", label = "facet", choices = c("none", paste0("group", 1:4)), 
       multiple = FALSE, selected = "none"), 
    textOutput("size"), 
    tagList(
    textInput("plot.width", "width:", 1000), 
    textInput("plot.height", "height", 700) 
), 
    uiOutput("plotbox") 
) 

server <- function(input, output, session) { 

    output$plotbox <- renderUI({ 
    # column(9, 
    #  psize <- calc_boxplot_size((input$facet != "none")), 
    #  plotlyOutput("plot") 
    #) 

    psize <- calc_boxplot_size((input$facet != "none")) 
    plotlyOutput("plot") 

    }) 

    output$size <- renderText({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    sprintf("WIDTH: %s, HEIGHT: %s", psize$width, psize$height) 

    }) 

    output$plot <- renderPlotly({ 
    psize <- calc_boxplot_size((input$facet != "none")) 
    if (input$facet == "none") { 
     p <- create_plot(dat, input$group, input$color, input$shape, input$plot.width, input$plot.height) 
    } else { 
     plots <- dat %>% 
     group_by_(.dots = input$facet) %>% 
     do(p = { 
      create_plot(., input$group, input$color, input$shape, input$plot.width, input$plot.height) 
     }) 
     p <- subplot(plots, shareX = TRUE, shareY = TRUE, nrows = 3, margin = 0.02) 
    } 
    }) 

} 

shinyApp(ui, server) 
+1

Ja, aber ich möchte die Größe automatisch abhängig von der Funktion aktualisieren. Dieser erlaubt Ihnen, die Größe über Benutzereingabe zu aktualisieren, damit mein Problem nicht gelöst wird. – potockan

Verwandte Themen