library(stringr)
output$trans_try <- renderUI({
ncol <- as.integer(ncol(uploadata$t))
lapply(1:ncol, function(i) {
fluidRow(
column(3,
selectInput(paste("n_col_", i), label = '', width = '150px',
choices = names(uploadata$t)[i], selected = names(uploadata$t)[i])
),
column(3,
textInput(paste("new_name_", i),
label = '', width = '150px',
value = names(uploadata$t)[i])
),
column(3,
selectInput(paste0("data_type_", i),
label = '', width = '150px',
choices = c('numeric', 'factor', 'Date', 'character', 'integer'),
selected = class(uploadata$t[[i]]))
),
column(3,
conditionalPanel(condition = paste(paste0("input.data_type_", i), "== 'Date'"),
column(4, br(), tags$h5('Format')),
column(8,
selectInput(paste("date_type_", i),
label = '', width = '150px',
choices = c('%d %m %y', '%d %m %Y', '%y %m %d', '%Y %m %d', '%d %y %m', '%d %Y %m',
'%m %d %y', '%m %d %Y', '%y %d %m', '%Y %d %m', '%m %y %d', '%m %Y %d',
'%d/%m/%y', '%d/%m/%Y', '%y/m /%d', '%Y/%m/%d', '%d/%y/%m', '%d/%Y/%m',
'%m/%d/%y', '%m/%d/%Y', '%y/%d/%m', '%Y/%d/%m', '%m/%y/%d', '%m/%Y/%d',
'%d-%m-%y', '%d-%m-%Y', '%y-m -%d', '%Y-%m-%d', '%d-%y-%m', '%d-%Y-%m',
'%m-%d-%y', '%m-%d-%Y', '%y-%d-%m', '%Y-%d-%m', '%m-%y-%d', '%m-%Y-%d'
),
selected = '%Y %m %d')
)
)
)
)
})
})
original <- reactive({
uploadata$t
})
save_names <- reactive({
names(original())
})
n <- reactive({
length(original())
})
data_types <- reactive({
ncol <- as.integer(ncol(uploadata$t))
collect <- list(lapply(1:ncol, function(i) {
input[[paste0("data_type_", i)]]
}))
colors <- unlist(collect)
})
new_names <- reactive({
ncol <- as.integer(ncol(uploadata$t))
collect <- list(lapply(1:ncol, function(i) {
input[[paste("new_name_", i)]]
}))
colors <- unlist(collect)
colnames <- str_replace(colors, " ", "_")
})
# original <- reactive({
# data()
# })
# save_names <- reactive({
# names(original())
# })
# n <- reactive({
# length(original())
# })
# data_types <- reactive({
# ncol <- as.integer(ncol(data()))
# collect <- list(lapply(1:ncol, function(i) {
# input[[paste0("data_type_", i)]]
# }))
# colors <- unlist(collect)
# })
# new_names <- reactive({
# ncol <- as.integer(ncol(data()))
# collect <- list(lapply(1:ncol, function(i) {
# input[[paste("new_name_", i)]]
# }))
# colors <- unlist(collect)
# colnames <- str_replace(colors, " ", "_")
# })
copy <- eventReactive(input$apply_changes, {
out <- list()
for (i in seq_len(n())) {
if (data_types()[i] == 'Date') {
inp <- eval(parse(text = paste0('input$', paste0('date_type_', i))))
out[[i]] <- eval(parse(text = paste0("as.", data_types()[i], "(original()$", save_names()[i], ", ", inp, ")")))
} else {
out[[i]] <- eval(parse(text = paste0("as.", data_types()[i], "(original()$", save_names()[i], ")")))
}
}
names(out) <- new_names()
return(out)
})
final <- eventReactive(input$apply_changes, {
data.frame(copy(), stringsAsFactors = F)
})
observeEvent(input$apply_changes, {
updateNavbarPage(session, 'mainpage', selected = 'tab_trans')
updateNavlistPanel(session, 'navlist_trans', 'tab_selvar')
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.