光沢のある反応性のあるデータフレーム内のユークリッド距離を計算する

Question

dataframeshinyの反応型に変換しようとしています。私は以下のコードで関数を反応性データフレームbathy_new()に使用したいと思います。ここで

は再現例です。ここ

library(shiny) 
ui <- fluidRow(
    numericInput(inputId = "n", "Group ", value = 1), 
    plotOutput(outputId = "plot") 
) 

server <- function(input, output){ 
    bathy <- structure(list(`Corrected Time` = structure(c(
    1512040500, 1512040500, 
    1512040501, 1512040502, 1512040502, 1512040503 
), class = c(
    "POSIXct", 
    "POSIXt" 
), tzone = "UTC"), Longitude = c(
    -87.169858, -87.169858, 
    -87.1698618, -87.1698652, -87.1698652, -87.16986785 
), Latitude = c(
    33.7578743, 
    33.7578743, 33.75788237, 33.75789018, 33.75789018, 33.75789717 
), `Depth (m)` = c(
    3.95096, 3.82296, 3.63096, 3.57096, 3.48096, 
    3.32096 
), easting = c(
    484269.60819222, 484269.60819222, 484269.257751374, 
    484268.944306767, 484268.944306767, 484268.700169299 
), northing = c(
    3735323.04565401, 
    3735323.04565401, 3735323.94098565, 3735324.80742908, 3735324.80742908, 
    3735325.58284154 
), diff = c(0, 0, 0, 0, 0, 0), group = c(
    1, 1, 
    1, 2, 2, 2 
)), .Names = c(
    "Corrected Time", "Longitude", "Latitude", 
    "Depth (m)", "easting", "northing", "diff", "group" 
), row.names = c(
    NA, 
    -6L 
), class = c("tbl_df", "tbl", "data.frame")) 



    euc.dist <- function(x1, y1, x2, y2){ 
    distance <- sqrt((x2-x1)^2 + (y2-y1)^2) 
    return(distance) 
    } 
    # 
    bathy_new <- reactive({ 
    bathy %>% dplyr::filter(group == input$n) 
    }) 

    test <- bathy_new() 

    dist <- NULL 
    for (i in 1:nrow(test)){ 
    dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting, 
        y1 = test[i, "northing"] %>% .$northing, 
        x2 = test[i+1, 'easting'] %>% .$easting, 
        y2 = test[i+1, 'northing'] %>% .$northing) 
    } 
    test$dist <- dist 

    output$plot <- renderPlot(
    qplot(cumsum(test$dist), bathy_new()$`Depth (m)`) 
) 
} 

shinyApp(ui, server) 

データは、私の元のセットに比べて非常に小さいデータです。しかし、目標は各グループのポイント間の距離を見つけることです。この小さなデータセットでは、2つのグループがあります。 1と2

私は次のようなエラーに

Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

を得続ける私は、反応性データに対処する方法がわからうまく光沢の外にこのコードを実行することはできませんが。

これは、エラーがあるコードの塊です：

test <- bathy_new() 

     dist <- NULL 
     for (i in 1:nrow(test)){ 
     dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting, 
         y1 = test[i, "northing"] %>% .$northing, 
         x2 = test[i+1, 'easting'] %>% .$easting, 
         y2 = test[i+1, 'northing'] %>% .$northing) 
     } 
     test$dist <- dist 

は最終的に、私は、累積距離cum(dist)と深さDepth (m)をプロットしたいです。

Answer 1

実際にtest変数にreactiveを割り当てようとしたためです。これは反応式やオブザーバーの内部からのみ行うことができます。

したがって、そのコードをrenderPlotなどの反応式の中に配置する必要があります。

output$plot <- renderPlot({ 
    test <- bathy_new() 

    dist <- NULL 
    for (i in 1:(nrow(test) - 1)){ 
     dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting, 
         y1 = test[i, "northing"] %>% .$northing, 
         x2 = test[i+1, 'easting'] %>% .$easting, 
         y2 = test[i+1, 'northing'] %>% .$northing) 
    } 

    test$dist <- dist 
    qplot(cumsum(test$dist), bathy_new()$`Depth (m)`) 
    }) 

これはエラーを取り除く必要があります、しかし、私はあなたが同様にあなたのforループといくつかの問題があるかもしれないと思います。 1:nrow(test)を反復しますが、ループ内ではi+1と計算されます。このため、distはNAになるので、プロットには何も表示されません。

有効な結果を得るためにループを修正して1:(nrow(test) - 1)まで繰り返しました。

私はまた、Shinyの方法を指摘したいと思います。 Shinyはサーバー機能の外でコードを実行Rのプロセスごとに1回、その後サーバー機能内でコードを実行接続ごとに1回。そして、依存関係がに変わるたびにを実行する反応があります。

は

だから彼らが一度だけ実行する必要があるため、server関数の外のデータと機能を定義した方がよいより多くの助けのためthis topicを参照してください。彼らがserverの機能の中にいる場合、毎回新しいユーザーが動作するアプリケーションに接続されていますが、効率的ではありません。

全コード：

library(shiny) 
library(magrittr) 
library(ggplot2) 

bathy <- structure(list(`Corrected Time` = structure(c(
    1512040500, 1512040500, 
    1512040501, 1512040502, 1512040502, 1512040503 
), class = c(
    "POSIXct", 
    "POSIXt" 
), tzone = "UTC"), Longitude = c(
    -87.169858, -87.169858, 
    -87.1698618, -87.1698652, -87.1698652, -87.16986785 
), Latitude = c(
    33.7578743, 
    33.7578743, 33.75788237, 33.75789018, 33.75789018, 33.75789717 
), `Depth (m)` = c(
    3.95096, 3.82296, 3.63096, 3.57096, 3.48096, 
    3.32096 
), easting = c(
    484269.60819222, 484269.60819222, 484269.257751374, 
    484268.944306767, 484268.944306767, 484268.700169299 
), northing = c(
    3735323.04565401, 
    3735323.04565401, 3735323.94098565, 3735324.80742908, 3735324.80742908, 
    3735325.58284154 
), diff = c(0, 0, 0, 0, 0, 0), group = c(
    1, 1, 
    1, 2, 2, 2 
)), .Names = c(
    "Corrected Time", "Longitude", "Latitude", 
    "Depth (m)", "easting", "northing", "diff", "group" 
), row.names = c(
    NA, 
    -6L 
), class = c("tbl_df", "tbl", "data.frame")) 

euc.dist <- function(x1, y1, x2, y2){ 
    distance <- sqrt((x2-x1)^2 + (y2-y1)^2) 
    return(distance) 
} 

ui <- fluidRow(
    numericInput(inputId = "n", "Group ", value = 1), 
    plotOutput(outputId = "plot") 
) 

server <- function(input, output){ 
    bathy_new <- reactive({ 
    bathy %>% dplyr::filter(group == input$n) 
    }) 

    output$plot <- renderPlot({ 
    test <- bathy_new() 

    dist <- NULL 
    for (i in 1:(nrow(test) - 1)){ 
     dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting, 
         y1 = test[i, "northing"] %>% .$northing, 
         x2 = test[i+1, 'easting'] %>% .$easting, 
         y2 = test[i+1, 'northing'] %>% .$northing) 
    } 

    test$dist <- dist 
    qplot(cumsum(test$dist), bathy_new()$`Depth (m)`) 
    }) 
} 

shinyApp(ui, server)