R блестящий: динамическое создание табличного ввода разных типов

Question

Я искал довольно долгое время для этого, но я не нашел решение моей проблемы. Я создаю приложение для управления проектами, и я хотел использовать блестящий, потому что я думал, что он сможет сделать приложение более интерактивным.

Таким образом, входы для приложения должны быть выполнены в приложении. Входы будут содержать число, текст и выбор. Для обзора входы, которые принадлежат друг другу, должны быть расположены в одной строке. Например:

resource_1, имя = 'конфокальный микроскоп', тип = 'машина', цена = 1000, price_type = 'EUR/использования'

Я хочу, чтобы организовать каждую запись в виде таблицы. Конечно, количество записей является переменным. Иногда вы можете определить 5 ресурсов для проекта, иногда 50.

Чтобы решить эту проблему, я создаю табличный элемент, блестящий с элементами html в качестве записей в таблице. Однако мне нужно динамически обращаться к этим записям. Я думал, что могу сделать это, вызвав строки символов входных идентификаторов каждой записи таблицы с помощью функции get(). Но это не работает.

Сейчас:

• Я могу создать табличный с различными типами входных и переменным числом строк.

• я могу назвать каждый из этих входов на самом деле вызовом ввода идентификатора (например, «входной $ element1_1»

• , но я не могу сделать петлю, чтобы автоматически получить доступ к этим ввода идентификаторов, как с ГЭТ() : получить (paste0 ('вход $ элемент', I, '_', J))

минимальный пример:

library(shiny) 

ui = 
    pageWithSidebar(

headerPanel("TEST"), 

sidebarPanel(
    helpText("number of resources"), 
    numericInput("nres","",3,min=0), 
    actionButton('create_res',"create",icon=icon("plus"),width='100%'), 
    br(), 
    br(), 
    br(), 
    bsButton('finish_res',"finish",width='100%',style="info"), # check matrix 
    width=2 
), 

mainPanel( 
    uiOutput('matrix_res'), 
    p("make an entry in row1 col1 and press finish"), 
    br(), 
    p("I can extract elements by calling input$element1_1:"), 
    textOutput('check1'), 
    br(), 
    p("but not by searching for the character string with get('element1_1') "), 
    textOutput('check2') 
) 
) 

server = 
    function(input,output){ 

output$matrix_res <- renderTable({ 

    input$create_res #create button dependency 


    Row_entries <- paste("ressource",1:isolate(input$nres)) #kill nres dependency 
    Col_entries <- c("text input","number input","selection") 

    matrix <- data.frame() 

    for (i in 1:length(Row_entries)) { 
    matrix[i,1] <- paste0("<input id='element", i, "_", 1, "' class='shiny-bound-input span6' type='text' value=''>") 
    matrix[i,2] <- paste0("<input id='element", i, "_", 2, "' class='shiny-bound-input span6' type='number' value=''>") 
    matrix[i,3] <- paste0("<div class='form-group shiny-input-container'> 
          <div> 
          <select id='element", i, "_", 3, "' class='form-control'><option value='a' selected>a</option> 
          <option value='b'>b</option></select> 
          <script type='application/json' data-for='element", i, "_", 3, "'>{}</script> 
          </div></div>") 
    } 

    colnames(matrix) <- Col_entries 

    matrix 

    },sanitize.text.function = identity) 


output$check1<-renderText({ 
    input$finish_res 
    isolate(input$element1_1) 
}) 

output$check2<-renderText({ 
    input$finish_res 
    isolate(input$get('element1_1')) 
}) 
} 

runApp(list(ui = ui, server = server)) 

Выполнить это: вы можете изменить количество строк, используя ввода номера и создать кнопку. Вы можете вызвать значение row1 column1, нажав кнопку «Готово».

Если у вас есть идеи, как получить эти входы, ответьте. Я застрял с этим дерьмом уже неделю ...

Answer 1

поэтому я нашел неудовлетворительный ответ. Я пытался вокруг с ГЭТ(), Eval(), do.call() и фактически работает следующим:

Eval (синтаксического анализа (текст = character_string))

так что вы можете сделать character_string < - paste0 ('input $ element', i, '_', j) или что-то

Итак, вы можете сделать цикл, чтобы пройти через все входы и создать список для всех входов. Фактически, я надеялся, что можно напрямую сохранить все входы в список.

Так вот пример:

library(shiny) 

ui = 
pageWithSidebar(

headerPanel("TEST"), 

sidebarPanel(
    helpText("number of rows"), 
    numericInput("nres","",3,min=0), 
    actionButton('create_res',"create",icon=icon("plus"),width='100%'), 
    br(), 
    br(), 
    br(), 
    helpText("show me value in row 1 column 1"), 
    actionButton('finish_res',"show",icon=icon("check"),width='100%'), 
    width=2 
), 

mainPanel( 
    uiOutput('matrix_res'), 
    p("just by actually writing 'input$element1_1'"), 
    textOutput('check1'), 
    br(), 
    p("with get(character_string)"), 
    textOutput('check2'), 
    br(), 
    p('with eval(parse(text=character_string)):'), 
    textOutput('check3'), 
    br(), 
    p('with do.call("print", list(as.name(character_string)))'), 
    textOutput('check4') 
) 
) 

server = 
function(input,output){ 

output$matrix_res <- renderTable({ 

    input$create_res #create button dependency 


    Row_entries <- paste("ressource",1:isolate(input$nres)) #kill nres dependency 
    Col_entries <- c("text input","number input","selection") 

    matrix <- data.frame() 

    for (i in 1:length(Row_entries)) { 
    matrix[i,1] <- paste0("<input id='element", i, "_", 1, "' class='shiny-bound-input span6' type='text' value=''>") 
    matrix[i,2] <- paste0("<input id='element", i, "_", 2, "' class='shiny-bound-input span6' type='number' value=''>") 
    matrix[i,3] <- paste0("<div class='form-group shiny-input-container'> 
          <div> 
          <select id='element", i, "_", 3, "' class='form-control'><option value='a' selected>a</option> 
          <option value='b'>b</option></select> 
          <script type='application/json' data-for='element", i, "_", 3, "'>{}</script> 
          </div></div>") 
    } 

    colnames(matrix) <- Col_entries 

    matrix 

    },sanitize.text.function = identity) 


output$check1<-renderText({ 
    input$finish_res 
    isolate(input$element1_1) 
}) 

output$check2<-renderText({ 
    input$finish_res 
    isolate(get(paste0('input$element',1,'_',1))) 
}) 

output$check3<-renderText({ 
    input$finish_res 
    isolate(eval(parse(text=paste0('input$element',1,'_',1)))) 
}) 

output$check4<-renderText({ 
    input$finish_res 
    isolate(do.call("print", list(as.name(paste0('input$element',1,'_',1))))) 
}) 

} 

runApp(list(ui = ui, server = server)) 

Answer 2

Ok вот способ получить то, что я хотел.

Я уверен, что есть лучший способ сделать это, потому что это слишком сложно для простой задачи.

Обратите внимание, что входы сохраняются, если вы решили добавить больше строк.

library(shiny) 

ui <- 
pageWithSidebar(

headerPanel("Dynamic table for Input of different types"), 

sidebarPanel(
    helpText("number of rows"), 
    numericInput("nres","",3,min=0), 
    actionButton('create_res',"create",icon=icon("plus"),width='100%'), 
    br(), 
    br(), 
    br(), 
    helpText("read input you entered"), 
    actionButton('finish_res',"finish",icon=icon("check"),width='100%'), 
    width=2 
), 

mainPanel( 
    h3("input table"), 
    uiOutput('matrix_res'), 
    h3("output table"), 
    tableOutput('check_table'), 
    br() 

) 
) 

server <- 
function(input,output){ 


# input table 
# table with different types of input 
# row number can be changed with number input 
# changes are applied after pressing create button 
output$matrix_res <- renderTable({ 

    input$create_res # dependency 


    Col_entries <- c("text input","number input","selection") 

    matrix <- data.frame() 

    for (i in 1:isolate(input$nres)) { 
    matrix[i,1] <- paste0("<input id='element", i, "_", 1, "' class='shiny-bound-input span6' type='text' value='",input[[paste0("element", i, "_", 1)]],"'>") 
    matrix[i,2] <- paste0("<input id='element", i, "_", 2, "' class='shiny-bound-input span6' type='number' value='",input[[paste0("element", i, "_", 2)]],"'>") 
    matrix[i,3] <- paste0("<div class='form-group shiny-input-container'><div> 
          <select id='element", i, "_", 3, "' class='form-control'> 
          <option value='a'>a</option> 
          <option value='b'>b</option> 
          </div></div>") 
    } 

    colnames(matrix) <- Col_entries 

    matrix 


    },sanitize.text.function = identity) 




# change row number for output table 
# only if new input table is created with create button 
row_number<-reactive({ 
    input$create_res # dependency 
    isolate(input$nres) 
}) 




# output table 
# object created when clicking on finish button 
# only dependent on finish button 
output_table<-reactive({ 

    input$finish_res # dependency 

    Col_entries <- c("text input","number input","selection") 

    matrix <- data.frame() 

    isolate(
    for (i in 1:isolate(row_number())) { 
     matrix[i,1] <- input[[paste0('element',i,'_',1)]] 
     matrix[i,2] <- input[[paste0('element',i,'_',2)]] 
     matrix[i,3] <- input[[paste0('element',i,'_',3)]] 
    } 
) 
    colnames(matrix) <- Col_entries 

    matrix 

}) 


# show output table 
output$check_table<-renderTable({ 
    if(input$finish_res == 0) return() #hide it on start 
    output_table() 
}) 

} 


runApp(list(ui = ui, server = server))