问题
I am trying to add a custom validation to the following interactive table. What I am trying to do is as follows. The table contains three variables namely mpg,cyl and disp. Suppose I edit the mpg value of the first row. Then once I press the enter button, disp value of the 1st row should be automatically changed calculated as disp=mpg/cyl. Here mpg value being the new value I edited. Likewise if I edit cyl in a particular row again disp of that particular row should be changed automatically evaluated as disp=mpg/cyl. Moreover if I change disp value of a particular row, cyl of that particular row should be changed automatically calculated as mpg/cyl. I am trying to figure it out a way of doing this.
library(shiny)
library(datasets)
ui=fluidPage(
rHandsontableOutput("table1")
)
server=function(input, output, session) {
mt=reactive({
datacopy= mtcars[, names(mtcars) %in% c("mpg" , "cyl" , "disp")]
datacopy=data.table(datacopy)
})
output$table1=renderRHandsontable({
rhandsontable(mt())
})
}
shinyApp(ui,server)
回答1:
I guess this would achieve what you want:
library(shiny)
library(datasets)
library(rhandsontable)
library(data.table)
ui=fluidPage(
rHandsontableOutput("table1")
)
server=function(input, output, session) {
mt=reactive({
datacopy <- NULL
#For initial data upload
if(is.null(input$table1)){
datacopy= mtcars[, names(mtcars) %in% c("mpg" , "cyl" , "disp")]
datacopy=data.table(datacopy)
}else{
datacopy = hot_to_r(input$table1)
#If there is change in data
if(!is.null(input$table1$changes$changes)){
row.no <- unlist(input$table1$changes$changes)[1]
col.no <- unlist(input$table1$changes$changes)[2]
new.val <- unlist(input$table1$changes$changes)[4]
#If the changed value is mpg or cyl
if(col.no == 0 || col.no == 1){
datacopy[(row.no+1), 3] = datacopy[(row.no+1), 1]/datacopy[(row.no+1), 2]
}else{
datacopy[(row.no+1), 2] = datacopy[(row.no+1), 1]/datacopy[(row.no+1), 3]
}
}
}
datacopy
})
output$table1=renderRHandsontable({
rhandsontable(mt())
})
}
shinyApp(ui,server)
Hope it helps!
[EDIT]: As per your edited answer I have modified the code below. Hopefully this helps.
library(shiny)
library(datasets)
library(rhandsontable)
library(data.table)
c1= c(rep("0112",3), rep("0113",3),rep("0114",3))
c2= c( rep(c("A", "B","C"),3))
c3= c(rep(c("5312", "5421", "5510"),3))
c4=c(rep(c("Area", "Yield", "Prod"),3))
c5 = c( rep(2010,9))
c6= c( 4,68,16169,1062,1.5,43225,800,1.25,100)
data_=cbind(c1,c2,c3,c4,c5,c6)
data_=as.data.frame(data_)
names(data_) = c("CPCCode", "Item","ElementCode","El","Year","Value")
data_$Value=as.numeric(levels( data_$Value))[ data_$Value]
data_$Year= as.integer(levels( data_$Year))[data_$Year]
data_$ElementCode = as.character(data_$ElementCode)
rownames(data_) = NULL
ui=fluidPage(
rHandsontableOutput("table1")
)
server=function(input, output, session) {
mt=reactive({
datacopy <- NULL
#For initial data upload
if(is.null(input$table1)){
datacopy <- data_
}else{
datacopy = hot_to_r(input$table1)
#If there is change in data
if(!is.null(input$table1$changes$changes)){
row.no <- unlist(input$table1$changes$changes)[1]
element = datacopy[(row.no + 1), "ElementCode"]
year= datacopy[(row.no + 1), "Year"]
cpccode= datacopy[(row.no + 1), "CPCCode"]
col.no <- unlist(input$table1$changes$changes)[2]
if(element == "5421"){#Yield
datacopy$Value[datacopy$CPCCode == cpccode & datacopy$Year == year &
datacopy$ElementCode == "5510"] =
datacopy$Value[datacopy$CPCCode == cpccode & datacopy$Year == year &
datacopy$ElementCode == "5312"] *
datacopy$Value[datacopy$CPCCode == cpccode & datacopy$Year == year &
datacopy$ElementCode == "5421"]
}else if(element == "5510"){#Area
datacopy$Value[datacopy$CPCCode == cpccode & datacopy$Year == year &
datacopy$ElementCode == "5312"] =
datacopy$Value[datacopy$CPCCode == cpccode & datacopy$Year == year &
datacopy$ElementCode == "5510"] /
datacopy$Value[datacopy$CPCCode == cpccode & datacopy$Year == year &
datacopy$ElementCode == "5421"]
}
}
}
datacopy
})
output$table1=renderRHandsontable({
rhandsontable(mt())
})
}
shinyApp(ui,server)
来源：https://stackoverflow.com/questions/44074184/reactive-calculate-columns-in-rhandsontable-in-shiny-rstudio