2017-07-19 5 views
3

に合わせてサイズを変更しないことは、私のコードです:ggiraphプロットはページここ

library(shiny) 
library(ggplot2) 
library(ggiraph) 

df <- data.frame(achseX = LETTERS[1:24], achseY = 1:24, facetX = as.factor(rep(1:4, each = 6))) 

server <- function(input, output) { 
    output$ggplot <- renderPlot({ 
    ggplot(data = df) + geom_bar_interactive(aes(tooltip = achseY, x = achseX, y = achseY), stat = "identity") + 
     theme_minimal() + facet_grid(.~ facetX, scales = "free_x") 
    }) 


    output$plot <- renderggiraph({ 
    gg <- ggplot(data = df) + geom_bar_interactive(aes(tooltip = achseY, x = achseX, y = achseY), stat = "identity") + 
     theme_minimal() + facet_grid(.~ facetX, scales = "free_x") 
    return(ggiraph(code = print(gg), selection_type = "multiple", zoom_max = 4, 
        hover_css = "fill:#FF3333;stroke:black;cursor:pointer;", 
        selected_css = "fill:#FF3333;stroke:black;")) 
    }) 
} 

ui <- fluidPage(
    "GGPLOT2:", 
    plotOutput("ggplot"), 
    "GGIRAPH:", 
    ggiraphOutput("plot", width = "500px", height = "1000px") 
) 

shinyApp(ui = ui, server = server) 

結果は次のようになります。 enter image description here

あなたがコード内で見ることができるように、最初のbarplotがggplotですそれは必要な方法で動作します。サイトに応答し、長方形の形式を持ちます。 ggiraphは代わりに正方形のままで、ページに収まらない。

どうすればggplotをggplotのようにすることができますか?

幅と高さの引数を組み合わせて試したところ、width = "auto"height = "auto"も含まれています。これにより、ggiraphはページにフィットしましたが、依然として正方形のフォーマットになりました。

答えて

1

uiは、ある程度のjsコードで反応させることができます。答えはthisの行に沿ったものです。

違いは、ggiraph関数は入力をインチ単位で入力する必要があるため、ピクセルをインチに変換する必要がある点です。その式はinches = pixels/dpiです。したがって、ui内のjsコードはウィンドウの高さを渡し、スクリーンのdpiと共にインチからの長さを計算してからggiraph関数に渡すことができ、プロットをuiに応答させます。

私はこれを正確に行うためにあなたの例を修正しました。それが役に立てば幸い!

library(shiny) 
library(ggplot2) 
library(ggiraph) 

df <- data.frame(achseX = LETTERS[1:24], achseY = 1:24, facetX = as.factor(rep(1:4, each = 6))) 

server <- function(input, output, session) { 
    output$ggplot <- renderPlot({ 
    ggplot(data = df) + geom_bar_interactive(aes(tooltip = achseY, x = achseX, y = achseY), stat = "identity") + 
     theme_minimal() + facet_grid(.~ facetX, scales = "free_x") 
    }) 


    output$plot <- renderggiraph({ 
    gg <- ggplot(data = df) + geom_bar_interactive(aes(tooltip = achseY, x = achseX, y = achseY), stat = "identity") + 
     theme_minimal() + facet_grid(.~ facetX, scales = "free_x") 
    return(ggiraph(code = print(gg), selection_type = "multiple", zoom_max = 4, 
        hover_css = "fill:#FF3333;stroke:black;cursor:pointer;", 
        selected_css = "fill:#FF3333;stroke:black;", 
        width_svg = (0.8*input$pltChange$width/input$pltChange$dpi), 
        height_svg = (0.5*input$pltChange$height/input$pltChange$dpi) 
        )) 
    }) 
} 

ui <- fluidPage(

    tags$body(tags$div(id="ppitest", style="width:1in;visible:hidden;padding:0px")), 

    tags$script('$(document).on("shiny:connected", function(e) { 
            var w = window.innerWidth; 
            var h = window.innerHeight; 
            var d = document.getElementById("ppitest").offsetWidth; 
            var obj = {width: w, height: h, dpi: d}; 
            Shiny.onInputChange("pltChange", obj); 
           }); 
           $(window).resize(function(e) { 
            var w = $(this).width(); 
            var h = $(this).height(); 
            var d = document.getElementById("ppitest").offsetWidth; 
            var obj = {width: w, height: h, dpi: d}; 
            Shiny.onInputChange("pltChange", obj); 
           }); 
          '), 


    "GGPLOT2:", 
    plotOutput("ggplot"), 
    "GGIRAPH:", 
    ggiraphOutput("plot") 
) 

shinyApp(ui = ui, server = server) 
関連する問題