I have this code in which i do some calculations, but when i change the input$alternatives to 2 it shows me the following error message
Warning: Error in [<-.data.frame: replacement has 2 rows, data has 1
library(shiny)
library(shinydashboard)
library(htmlwidgets)
library(data.table)
ui <- dashboardPage(
skin="blue",
dashboardHeader(
title="sth",
titleWidth = 300),
dashboardSidebar(
width = 300,
sidebarMenu(
menuItem(
"Gathering Information",
tabName = "gatheringinformation",
icon=icon("github")
),
menuItem(
"Calculation",
tabName = "linguisticaggregation",
icon=icon("github")
))),
dashboardBody(
tabItems(
tabItem(tabName = "gatheringinformation",
h2("Gathering Information"),
# 1st row of boxes
fluidRow(
box(
width = 4,
title = "Inputs",
status= "primary",
solidHeader = TRUE,
h5("Please specify the number of alternatives, criteria and experts"),
numericInput("alternatives", h3("Alternatives"),
value = "1"),
numericInput("criteria", h3("Criteria"),
value = "1"),
numericInput("experts", h3("Experts"),
value = "1")
))),
tabItem(tabName = "linguisticaggregation",
h2("2-TUPLE Linguistic Aggregation"),
fluidRow(
box(title = "View Data",
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style = 'overflow-x: scroll'),
splitLayout(tableOutput("informationtableflv"))
),
box(title = "Alternative Rankings",
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style = 'overflow-x: scroll'),
splitLayout(tableOutput("alternativerankings"))
))))))
####################################
############ SERVER ############
####################################
server <- function(input, output, session) {
datalistflv<<- list()
output$informationtableflv <- renderUI({lapply(1:input$experts,function(j){
renderTable({
num.inputs.col1 <- paste0(1)
df <- data.frame(num.inputs.col1)
for (m in 1:input$criteria){
for (n in 1:input$alternatives){
df[n,m] <-paste0(5)
}
}
colnames(df) <- paste0("Criteria ",as.numeric(1:input$criteria))
df
datalistflv[[j]] <<- df
},caption = paste("Expert " ,j), caption.placement = getOption("xtable.caption.placement", "top"), sanitize.text.function = function(x) x)})})
output$alternativerankings <- renderUI({lapply(1:input$experts,function(j){
renderTable({
a <- na.omit(a)
a = as.data.frame(lapply(datalistflv[[j]],as.numeric))
num.inputs.col1 <- paste0(1)
df <- data.frame(num.inputs.col1)
for (m in 1:input$alternatives){
df[m,1] <-as.numeric(rowSums(a))
df[m,2] <-round(as.numeric(df[m,1]))
df[m,3] <-as.numeric(df[m,1]) - as.numeric(df[m,2])
df[m,4] <-paste0("M")
df[m,5] <-as.numeric(df[m,1]) - as.numeric(df[m,2])}
colnames(df) <- paste0("Criteria ",as.numeric(1:input$criteria))
df
},caption = paste("Expert " ,j), caption.placement = getOption("xtable.caption.placement", "top"), sanitize.text.function = function(x) x)})})
}
# Run the application
shinyApp(ui = ui, server = server)
If i make this modification : df[m,1] <-as.numeric(rowSums(a)) ---->df[m,1] <-1 it is ok
library(shiny)
library(shinydashboard)
library(htmlwidgets)
library(data.table)
ui <- dashboardPage(
skin="blue",
dashboardHeader(
title="sth",
titleWidth = 300),
dashboardSidebar(
width = 300,
sidebarMenu(
menuItem(
"Gathering Information",
tabName = "gatheringinformation",
icon=icon("github")
),
menuItem(
"Calculation",
tabName = "linguisticaggregation",
icon=icon("github")
))),
dashboardBody(
tabItems(
tabItem(tabName = "gatheringinformation",
h2("Gathering Information"),
# 1st row of boxes
fluidRow(
box(
width = 4,
title = "Inputs",
status= "primary",
solidHeader = TRUE,
h5("Please specify the number of alternatives, criteria and experts"),
numericInput("alternatives", h3("Alternatives"),
value = "1"),
numericInput("criteria", h3("Criteria"),
value = "1"),
numericInput("experts", h3("Experts"),
value = "1")
))),
tabItem(tabName = "linguisticaggregation",
h2("2-TUPLE Linguistic Aggregation"),
fluidRow(
box(title = "View Data",
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style = 'overflow-x: scroll'),
splitLayout(tableOutput("informationtableflv"))
),
box(title = "Alternative Rankings",
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
div(style = 'overflow-x: scroll'),
splitLayout(tableOutput("alternativerankings"))
))))))
####################################
############ SERVER ############
####################################
server <- function(input, output, session) {
datalistflv<<- list()
output$informationtableflv <- renderUI({lapply(1:input$experts,function(j){
renderTable({
num.inputs.col1 <- paste0(1)
df <- data.frame(num.inputs.col1)
for (m in 1:input$criteria){
for (n in 1:input$alternatives){
df[n,m] <-paste0(5)
}
}
colnames(df) <- paste0("Criteria ",as.numeric(1:input$criteria))
df
datalistflv[[j]] <<- df
},caption = paste("Expert " ,j), caption.placement = getOption("xtable.caption.placement", "top"), sanitize.text.function = function(x) x)})})
output$alternativerankings <- renderUI({lapply(1:input$experts,function(j){
renderTable({
a <- na.omit(a)
a = as.data.frame(lapply(datalistflv[[j]],as.numeric))
num.inputs.col1 <- paste0(1)
df <- data.frame(num.inputs.col1)
for (m in 1:input$alternatives){
df[m,1] <-1
df[m,2] <-round(as.numeric(df[m,1]))
df[m,3] <-as.numeric(df[m,1]) - as.numeric(df[m,2])
df[m,4] <-paste0("M")
df[m,5] <-as.numeric(df[m,1]) - as.numeric(df[m,2])}
colnames(df) <- paste0("Criteria ",as.numeric(1:input$criteria))
df
},caption = paste("Expert " ,j), caption.placement = getOption("xtable.caption.placement", "top"), sanitize.text.function = function(x) x)})})
}
# Run the application
shinyApp(ui = ui, server = server)
Can you please help me to understand the problem?