2017-11-20 1 views
1

以下は、私の光っているアプリで使用されているコードのデモです。それは私のフルアプリにとって重要な要素をすべて持ちますが、最も重要なのは、私の問題が再現されたことです。Reactive Coding In R Shiny - これらの分割秒エラーメッセージの原因は何ですか?

私の輝いているアプリケーションの重要な部分は、別のウィジェットが特定の値に設定されている場合にのみ、特定のウィジェットが表示されることです。この場合、shotchart.inputがメインウィジェットであり、playerseason.inputウィジェットとteamgame.inputウィジェットは、shotchart.inputが特定の値に設定されている場合にのみ表示されます。私のUIでは、これらの2番目と3番目のウィジェットをuiOutput()関数に渡します。

私のサーバーでは、これら2つのウィジェットのそれぞれに対してrenderUI関数も用意されています。これらのウィジェットのドロップダウンオプションは、私の主なデータフレームの特定のフィルタリング(私の例ではありませんが、私の主なアプリケーションにあります)に依存しているので、これらのウィジェットをサーバーで作成することが重要です。

私の問題は次のとおりです。私がアプリを起動すると、1秒ごとに「文字以外の引数」エラーが発生します。次に、最初のウィジェットの値をShot Marker Graph(チームゲーム)に変更すると、もう一度分割された別のエラーが表示されます。今回は「結果の長さが0ではなく20でなければなりません。

私はこれが私のrenderPlotly()関数の内部で、私はこのようなコードの行持つためであると思う:

fname <- strsplit(input$player.id, split = ' ')[[1]][1] 

とを他のウィジェットのための反応性に依存している

this.t2 <- input$team.id 
all.pbp <- all.pbp %>% filter(team == this.t2) 

入力パラメータは$ player.idを入力し、$ team.idを入力します。私の考えでは、これらの入力パラメータは値を取得するのに〜1秒必要なので、これらのエラーは、アプリケーションを起動し、メインウィジェットを切り替えるとすぐに発生します。

これらのエラーは、ユーザーエクスペリエンスの観点から悪く見えます。さらに重要なことは、ここではrenderUIとuiOutputを正しく使用していないと思うように思います。どのようにこれらの分割された2番目のエラーメッセージ/より良いコーディング練習を取り除くための任意の考えは非常に高く評価されるだろう。ありがとう!

のApp以下:

# Pre-Processing 
all.pbp <- structure(list(team = c("BOS", "CLE", "BOS", "CLE", "BOS", "BOS", 
            "CLE", "CLE", "BOS", "CLE", "BOS", "CLE", "BOS", "CLE", "BOS", 
            "BOS", "CLE", "BOS", "BOS", "BOS"), lastname = c("Irving", "Rose", 
             "Hayward", "Love", "Tatum", "Horford", "Crowder", "Wade", "Brown", 
             "Rose", "Hayward", "Rose", "Irving", "Wade", "Irving", "Brown", 
             "Crowder", "Horford", "Brown", "Brown"), firstname = c("Kyrie", 
               "Derrick", "Gordon", "Kevin", "Jayson", "Al", "Jae", "Dwyane", 
               "Jaylen", "Derrick", "Gordon", "Derrick", "Kyrie", "Dwyane", 
               "Kyrie", "Jaylen", "Jae", "Al", "Jaylen", "Jaylen"), yloc = c(789L, 
                55L, 751L, 134L, 866L, 699L, 107L, 86L, 883L, 62L, 798L, 296L, 
                858L, 66L, 768L, 873L, 309L, 667L, 748L, 876L), xloc = c(251L, 
                  232L, 464L, 119L, 240L, 203L, 467L, 133L, 261L, 245L, 259L, 346L, 
                  257L, 398L, 141L, 248L, 197L, 133L, 468L, 255L)), .Names = c("team", 
                 "lastname", "firstname", "yloc", "xloc"), class = "data.frame", row.names = c(NA, 20L)) 

shotchart.types <- c('Shot Marker Graph (Player-Season)', 'Shot Marker Graph (Team-Game)') 
names(shotchart.types) <- shotchart.types 

# The UI 
ui <- fluidPage(fluidRow(
        column(width = 3, align = 'center', 
         h3('Chart Type'), hr(), 

         # create permanent input for shot chart type (should be 5 options) 
         selectInput(inputId = 'shotchart.input', label = 'Select Shot Chart Type:', multiple = FALSE, 
            choices = shotchart.types, selected = 'Shot Marker Graph (Player-Season)'), 

         uiOutput('playerseason.input'), 
         uiOutput('teamgame.input') 
         ), 

        # 2.C Launch the Chart 
        # ===-===-===-===-===-=== 
        column(width = 8, align = 'left', 
         plotlyOutput("shotplot") 
       ) 
       ) 
) 


# The Server 
server <- shinyServer(function(input, output) { 

    # 3.A widgets whose appearance is conditional on another widget value 
    # ===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-=== 
    # select player for player-season graph 
    output$playerseason.input <- renderUI({ 
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') { 

     all.players <- unique(paste(all.pbp$firstname, all.pbp$lastname)) 
     names(all.players) <- all.players 

     selectInput(inputId = 'player.id', label = 'Select Player:', multiple = FALSE, 
        choices = all.players, selected = 'Kyrie Irving') 
    } else{ 
     return(NULL) 
    } 
    }) 

    # select team for team-game graph 
    output$teamgame.input <- renderUI({ 
    if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') { 

     all.teams <- unique(all.pbp$team) 
     names(all.teams) <- all.teams 

     selectInput(inputId = 'team.id', label = 'Select Team:', multiple = FALSE, 
        choices = all.teams, selected = 'BOS') 

    } else{ 
     return(NULL) 
    } 
    }) 

    # 3.B The Plot 
    # ===-===-===-=== 
    output$shotplot <- renderPlotly({ 

    # first plot, based on chart type widget 
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') { 

     fname <- strsplit(input$player.id, split = ' ')[[1]][1] 
     lname <- strsplit(input$player.id, split = ' ')[[1]][2] 
     all.pbp <- all.pbp %>% filter(firstname == fname, lastname == lname) 
     print(fname); 
     print(lname); 
     print(all.pbp); 

     plot_ly(all.pbp) %>% 
     add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers') 
    } 

    # second plot, also based on chart type widget 
    else if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') { 

     this.t2 <- input$team.id 
     all.pbp <- all.pbp %>% filter(team == this.t2)  

     plot_ly(all.pbp) %>% 
     add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers') 
    } 

    }) 
}) 

shinyApp(ui, server) 
+1

私はアプリがロードされるまでレンダリングを遅らせるためにジョー・チェンからの解決策が役に立ったと評価:https://stackoverflow.com/questions/20490619/delayed-execution-in-r-shiny-app –

+0

彼が使用していますreactValues()関数は、私はしません - これはあなたが作っている提案ですか?私はrenderUIとuiOutputを代わりに使用していますが、そのリンクからのOPも条件付きパネルを使用しています。 – Canovice

+1

私は文脈が無関係だと思う。セッション$ onflushed中にreactValuesが更新され、レンダー関数の実行が妨げられます。うまくいけば、renderUIがエラーなく実行できるほど十分です。 –

答えて

1

こんにちはこれらの問題は、入力フィールドの動的なレンダリングから来ています。それらは、プロットが計算される最初に開始されません。しかし、開始されるとすぐにプロットが再計算され、すべて正常に動作します。

Shinyはこの目的のためにここでは変数が真実であるかどうか、つまり値があるかどうかをテストできます。そうでない場合、計算はサイレント警告でキャンセルされます。あなたのケースでそれがどのように機能するかは次のとおりです。私はちょうど2つの場所でreq()を追加し、それは正常に動作します。

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

    # 3.A widgets whose appearance is conditional on another widget value 
    # ===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-===-=== 
    # select player for player-season graph 
    output$playerseason.input <- renderUI({ 
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') { 

     all.players <- unique(paste(all.pbp$firstname, all.pbp$lastname)) 
     names(all.players) <- all.players 

     selectInput(inputId = 'player.id', label = 'Select Player:', multiple = FALSE, 
        choices = all.players, selected = 'Kyrie Irving') 
    } else{ 
     return(NULL) 
    } 
    }) 

    # select team for team-game graph 
    output$teamgame.input <- renderUI({ 
    if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') { 

     all.teams <- unique(all.pbp$team) 
     names(all.teams) <- all.teams 

     selectInput(inputId = 'team.id', label = 'Select Team:', multiple = FALSE, 
        choices = all.teams, selected = 'BOS') 

    } else{ 
     return(NULL) 
    } 
    }) 

    # 3.B The Plot 
    # ===-===-===-=== 
    output$shotplot <- renderPlotly({ 

    # first plot, based on chart type widget 
    if(input$shotchart.input == 'Shot Marker Graph (Player-Season)') { 
     req(input$player.id) 
     fname <- strsplit(input$player.id, split = ' ')[[1]][1] 
     lname <- strsplit(input$player.id, split = ' ')[[1]][2] 
     all.pbp <- all.pbp %>% filter(firstname == fname, lastname == lname) 
     print(fname); 
     print(lname); 
     print(all.pbp); 

     plot_ly(all.pbp) %>% 
     add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers') 
    } 

    # second plot, also based on chart type widget 
    else if(input$shotchart.input == 'Shot Marker Graph (Team-Game)') { 
     req(input$team.id) 

     this.t2 <- input$team.id 
     all.pbp <- all.pbp %>% filter(team == this.t2)  

     plot_ly(all.pbp) %>% 
     add_trace(x = ~xloc, y = ~yloc, type = 'scatter', mode = 'markers') 
    } 

    }) 
}) 
+0

MY HEROありがとう – Canovice

関連する問題