빛나는 반응성 데이터 프레임 내부에서 eucledian 거리 계산

Question

반응식 dataframe에 변형을 시도하고 있는데 shiny입니다. 아래의 코드에서 euc.dist 함수를 반응식 데이터 프레임 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 방법을 지적하고 싶습니다. 반짝이는 코드가 서버 외부에서 번 프로세스 당 번 실행 된 다음 서버 기능 에서 코드가 실행됩니다.. 그리고 나서 종속성이으로 바뀔 때마다 을 실행하는 반응이 있습니다.

는

그래서 그들이 한 번만 실행해야하므로, 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)