단일 코드에서 반짝이는 출력을 사용하여 데이터 테이블을 업데이트하십시오.

Question

사용자가 값을 입력 할 수있는 반짝이는 앱을 만들려고합니다. 데이터에 누락 된 값은 사용자 제공 값 또는 기본값으로 대체됩니다. 사용자가 값을 입력하면 새 파일은 이름 data_new를 생성합니다. 이 파일을 사용하여 누락 된 값을 대체하기 위해 원시 데이터 세트를 추가로 업데이트하려고합니다. 반짝 이는 응용 프로그램 파일 및 업데이트 데이터 테이블에서 입력을받는 방법을 잘 모르겠습니다.

코드 제 1 부 :

library(shiny) 
    library(readr) 
    library(datasets) 

data_set <- structure(list(A = c(1L, 4L, 0L, 1L), B = c("3", "*", "*", "2" 
), C = c("4", "5", "2", "*"), D = c("*", "9", "*", "4")), .Names = c("A", "B", "C", "D"), class = "data.frame", row.names = c(NA, -4L)) 

    data_set1 <- data_set 

    my.summary <- function(x, na.rm=TRUE){ 
     result <- c(Mean=mean(x, na.rm=na.rm), 
        SD=sd(x, na.rm=na.rm), 
        Median=median(x, na.rm=na.rm), 
        Min=min(x, na.rm=na.rm), 
        Max=max(x, na.rm=na.rm), 
        N=length(x), 
        Nmiss = sum(is.na(x))) 
    } 

    # identifying numeric columns 
    ind <- sapply(data_set1, is.numeric) 

    # applying the function to numeric columns only 
    stats_d <- data.frame(t(data.frame(sapply(data_set1[, ind], my.summary)))) 

    stats_d <- cbind(Row.Names = rownames(stats_d), stats_d) 
    colnames(stats_d)[1] <- "variable" 

    data_new <- stats_d 
    #rownames(data) <- c() 

    data_new["User_input"] <- data_new$Max 
    data_new["OutlierCutoff"] <- 1 

    data_new["Drop_Variable"] <- "No" 

    shinyApp(
     ui <- 
     fluidPage(
      titlePanel("Univariate Analysis"), 

      # Create a new row for the table. 
      sidebarLayout(
      sidebarPanel(
      selectInput("select", label = h3("Select Variable"), 
         choices = unique(data_new$variable), 
         selected = unique(data_new$variable)[1]), 
      numericInput("num", label = h3("Replace missing value with"), value = unique(data_new$variable)[1]), 

      selectInput("select1", label = h3("Select Variable"), 
         choices = unique(data_new$variable), 
         selected = unique(data_new$variable)[1]), 
      numericInput("num1", label = h3("Outlier Cutoff"), value = unique(data_new$variable)[1],min = 0, max = 1), 
      selectInput("select2", label = h3("Select any other Variable to drop"), 
         choices = unique(data_new$variable), 
         selected = unique(data_new$variable)[1]), 
      selectInput("select3", label = h3("Yes/No"), 
         choices = list("Yes", "No")), 
      submitButton(text = "Apply Changes", icon = NULL)), 
      mainPanel(

      dataTableOutput(outputId="table") 
     )) ) 
      , 

     Server <- function(input, output) { 

     # Filter data based on selections 
     output$table <- renderDataTable({ 
      data_new$User_input[data_new$variable==input$select] <<- input$num 
      data_new$OutlierCutoff[data_new$variable==input$select1] <<- input$num1 
      data_new$Drop_Variable[data_new$variable==input$select2] <<- input$select3 
      data_new 
     }) 
     }) 

코드 2 부 :

data_set[as.character(data_new$variable)] <- Map(function(x, y) 
    replace(x, is.na(x), y), data_set[as.character(data_new$variable)], data_new$User_input) 
data_setN <- data_set 

Answer 1

이 다소 복잡한 사업이고, 거기에 멋진 코드가있는 곳에, 당신이 정말로 그것을 구조화되지 않은 당신이 Shiny에서 많은 발전을 이룰 수있는 방법으로. 아마도 첫 번째 또는 두 번째 빛나는 사업에 너무 복잡 할 것입니다.

나는 시간이 있다면 당신을 위해 그것을 다시 작성 하겠지만, 지금 당장은 아니므로 당신이 실제로 그것을 할 수 있고 많은 것을 배울 수 있다고 생각합니다. 이것은 내가해야한다고 생각하는 것입니다 : submitButton을 actionButton으로 바꿉니다. submitButton을 사용하는 Shiny는 거의 항상 잘못된 경로에 빠져 있습니다. 이제 막 발견 된 것과 같습니다. 당신은이 같은 필요

actionButton("applyChanges","Apply Changes"), 

둘째, 당신은 reactiveEvent 기능에 data_new를 확인해야합니다. 초기화에서 지금 수행하는 계산을 반응 코드 블록으로 옮기거나 복사해야합니다. 이런 식으로 뭔가 :

data_new <- eventReactive(applyChanges,{ 

    # code to change NAs in data_set1 to something specified in the input goes here 
    ############################################################################### 

    ind <- sapply(data_set1, is.numeric) 
    stats_d <- data.frame(t(data.frame(sapply(data_set1[, ind], my.summary)))) 
    stats_d <- cbind(Row.Names = rownames(stats_d), stats_d) 
    colnames(stats_d)[1] <- "variable" 
    d_new <- stats_d 
    d_new["User_input"] <- d_new$Max 
    d_new["OutlierCutoff"] <- 1 

    d_new["Drop_Variable"] <- "No" 
    return(d_new) 
}) 

셋째 내가 renderUI 위젯으로 모든 입력 위젯을 변환하고뿐만 아니라 방금 만든 data_new 반응 것을 사용하여 서버에서 계산 된 것이다. ui 기능이 같은 :

uiOutput("select") 

그리고 server 기능이 같은

:

output$select <- renderUI({ 
     selectInput("select", label = h3("Select Variable"), 
        choices = unique(data_new()$variable), 
        selected = unique(data_new()$variable)[1]), 
    ) 
    }) 

공지 사항 data_new에서 함수 괄호()(). 이것은 지금 반응이 있기 때문입니다. 입력 컨트롤 select, num, select1, num1, select2, select3에 대해 이렇게하십시오.

넷째 , 당신은 빛나는 사용하여 조 쳉에서 찾을 수있는 모든 동영상을보고 (실제로이 먼저 수행하는 것이 좋을 것입니다) - 당신이 그것을 이해하는 데 필요한만큼 여러 번 그들을 볼. 리 액티브 프로그래밍은 다른 프로그래밍 프로그래밍과 다릅니다. 그것을 얻기 위해 잠시 걸립니다.

희망 혼란스러운 구문 실수를하지 않았습니다. 구조 조정과 행운을 빌어 요. 실제로 샤이니가 앞으로 나아갈 다른 방법은 없다고 생각하지만 잘못 될 수 있습니다.