error in tableOutput in colnames
323 views
Skip to first unread message
Jerônimo Guasselli
Oct 30, 2014, 7:06:50 PM10/30/14
to shiny-...@googlegroups.com
Hi I have a problem in my tableOutput,
Error in `colnames<-`(`*tmp*`, value = c("efficiency", "Número_de_Funcionários", :
length of 'dimnames' [2] not equal to array extent
it works for one of my calculus, but the other one in IF does not. Can some one help me?
library(XLConnect)
library(Benchmarking)
require(lpSolve)
server.R
shinyServer(function(input, output) {
Jer <- reactiveValues()
observe({
if (!is.null(input$iFile)) {
inFile <- input$iFile
wb <- loadWorkbook(inFile$datapath)
sheets <- getSheets(wb)
Jer$wb <- wb
Jer$sheets <- sheets
}
})
observe({
if (!is.null(Jer$wb)) {
if (!is.null(input$sheet)){
Jer <- readWorksheet(Jer$wb, input$sheet)
print(names(Jer))
output$columns <- renderUI({
checkboxGroupInput("columns", span(strong("Escolher imputs"), style = "color:blue"),
choices = names(Jer))
})
}
}
})
Jer <- reactiveValues()
observe({
if (!is.null(input$iFile)) {
inFile <- input$iFile
wb <- loadWorkbook(inFile$datapath)
sheets <- getSheets(wb)
Jer$wb <- wb
Jer$sheets <- sheets
}
})
observe({
if (!is.null(Jer$wb)) {
if (!is.null(input$sheet)){
Jer <- readWorksheet(Jer$wb, input$sheet)
print(names(Jer))
output$colum <- renderUI({
checkboxGroupInput("colum", span(strong("Escolher outputs"), style = "color:green"),
choices = names(Jer))
})
}
}
})
chooseFile <- reactive({
inFile <- input$iFile
if (!is.null(inFile)) {
# Determine document format;
ptn <- "\\.[[:alnum:]]{1,5}$"
suf <- tolower(regmatches(inFile$name, regexpr(ptn, inFile$name)))
# Options for Excel documents;
if (suf %in% c('.xls', '.xlsx')) {
wb <- loadWorkbook(inFile$datapath)
sheets <- getSheets(wb)
output$ui <- renderUI({
list(
selectInput(inputId = "sheet", label = "Select a sheet:", choices = sheets)
)
})
return(list(path = inFile$datapath, suf = suf))
}
# Options for txt documents;
if (suf %in% c('.txt', '.csv')) {
output$ui <- renderUI({
list(
checkboxInput(inputId = 'header', label = 'First line as header', value = TRUE),
textInput(inputId = 'sep', label = 'Separator', value = " "),
textInput(inputId = 'quote', label = 'Quote', value = '\"'),
textInput(inputId = 'arg', label = 'Additional Arguments:', value = ' '),
)
})
return(list(path = inFile$datapath, suf = suf))
}
} else {return(NULL)}
})
output$contents <- renderDataTable({
objFile <- chooseFile()
if (!is.null(objFile)) {
suf <- objFile$suf
# For Excel documents;
if (suf %in% c('.xls', '.xlsx')) {
Sheet <- input$sheet
wb <- loadWorkbook(objFile$path)
dat <- readWorksheet(wb, Sheet)
return(dat)
}
# For .txt and .csv documents;
if (suf %in% c('.txt', '.csv')) {
if (is.null(input$header)) {
dat <- read.table(objFile$path)
return(dat)
} else {
if (input$arg %in% c(' ', '')) {
dat <- read.table(objFile$path, header=input$header, sep=input$sep, quote=input$quote)
return(dat)
} else {
expr.1 <- paste('"', gsub('\\', '/', objFile$path, fixed = TRUE), '"', sep = '')
expr.2 <- paste(expr.1,
paste('header =', input$header),
paste('sep =', paste("'", input$sep, "'", sep = '')),
paste('quote =', paste("'", input$quote, "'", sep = '')), input$arg, sep = ', ')
print(expr.2)
expr <- paste('read.table(', expr.2, ')', sep = '')
print(expr)
dat <- eval(parse(text = expr))
return(dat)
}
}
}
} else {return(NULL)}
})
output$summary <- renderTable({
objFile <- chooseFile()
if (!is.null(objFile)) {
suf <- objFile$suf
# For Excel documents;
if (suf %in% c('.xls', '.xlsx')) {
Sheet <- input$sheet
wb <- loadWorkbook(objFile$path)
dat <- readWorksheet(wb, Sheet)
if (input$model=="crs") {
inputs <- data.frame(dat[c(input$columns)]) # input variable at second column of the data matrix
outputs <- data.frame(dat[c(input$colum)]) # output variables
N <- dim(dat)[1] # the number of DMUs is equal to number of rows of data matrix
s <- dim(inputs)[2] # number of input variables, in this case s = 3
m <- dim(outputs)[2] # number of output variables, in this case m = 1
f.rhs <- c(rep(0,1,N),1)
f.dir <- c(rep("<=",1,N),"=")
aux <- cbind(-1*inputs,outputs)
for (i in 1:N) {
f.obj <- c(0*rep(1,s),as.numeric(outputs[i,]))
f.con <- rbind(aux ,c(as.numeric(inputs[i,]), rep(0,1,m)))
results <- lp ("max",as.numeric(f.obj), f.con, f.dir, f.rhs,scale=0, compute.sens=TRUE)
if (i==1) {
weights <- results$solution
effcrs <- results$objval
lambdas <- results$duals[seq(1,N)]
} else {
weights <- rbind(weights, results$solution)
effcrs <- rbind(effcrs , results$objval)
lambdas <- rbind(lambdas, results$duals[seq(1,N)] )
}
}
spreadsheet <- cbind(effcrs,weights)
rownames(spreadsheet) <- dat[,1]
colnames(spreadsheet) <- c('efficiency',names(inputs),names(outputs))
return(spreadsheet)
}
if (input$model=="vrs") {
inputs <- data.frame(dat[c(input$columns)]) # input variable at second column of the data matrix
outputs<-data.frame(dat[c(input$colum)]) # output variables
N <- dim(dat)[1] # the number of DMUs is equal to number of rows of data matrix
s <- dim(inputs)[2] # number of input variables, in this case s = 3
m <- dim(outputs)[2] # number of output variables, in this case m = 1
f.rhs <- c(rep(0,1,N),1)
f.dir<-c(rep("<=",1,N), "=")
aux <- cbind(-1*inputs,outputs,1,-1)
for (i in 1:N) {
f.obj<-c(rep(0,1,s),as.numeric(outputs[i,]),1,-1) # 1 and -1 represents u+ - u-
f.con <- rbind(aux,c(as.numeric(inputs[i,]),rep(0,1,m),0,0))
results <- lp ("max",as.numeric(f.obj), f.con, f.dir, f.rhs,scale=1, compute.sens=TRUE)
multipliers <- results$solution
u0 <- multipliers[s+m+1]-multipliers[s+m+2]
if (i==1) {
weights <- c(multipliers[seq(1,s+m)],u0)
effvrs <- results$objval
lambdas <- results$duals[seq(1,N)]
} else {
weights<-rbind(weights,c(multipliers[seq(1,s+m)],u0))
effvrs <- rbind(effvrs , results$objval)
lambdas <- rbind(lambdas,results$duals[seq(1,N)])
}
}
planilha <- cbind(effvrs,weights)
colnames(planilha) <- c('efficiency',names(inputs),names(outputs))
rownames(planilha) <- dat[,1]
return(planilha)
}
}
}else {return(NULL)}
})
})
shinyUI(fluidPage(
titlePanel("DEA - Análise Envoltória de Dados"),
br(),
sidebarLayout(
sidebarPanel(
radioButtons("model", "Escolha do Modelo:",
list("CRS" = "crs",
"VRS" = "vrs")),
br(),
br(),
fileInput(inputId = "iFile", label = "Escolha um Arquivo:", accept="application/vnd.ms-excel"),
uiOutput(outputId = "ui"),
uiOutput(outputId = "columns"),
uiOutput(outputId = "colum"),
br(),
submitButton("Atualizar!"),
br(),
br(),
img(src = "www.png", height = 250, width = 400, align = "center")
),
mainPanel(tabsetPanel(
tabPanel("Tabela",dataTableOutput(outputId = "contents")),
tabPanel("Resultados", tableOutput(outputId ="summary")))
)
)))
autor: Jeronimo Guasselli
Harlan Harris
Nov 10, 2014, 2:03:53 PM11/10/14
to shiny-...@googlegroups.com
Just a note that I had a similar problem, but found a workaround. A table displays with renderDataTable just fine, and paging and the previous/next buttons also work fine. But I get this error when I attempt to sort on a column:
Error in matrix(unlist(value, recursive = FALSE, use.names = FALSE), nrow = nr, :
length of 'dimnames' [2] not equal to array extent
The table that's being displayed is the result of a dplyr expression. If I wrap the result in as.data.frame(), then everything works as expected! I suspect there's a bug somewhere with rendering data.table and/or tbl_df, but I'm not sure exactly what it is....
Yihui Xie
Jan 2, 2015, 10:49:52 PM1/2/15
to Harlan Harris, shiny-discuss
Just for the record, this issue has been fixed in the development
version of shiny: https://github.com/rstudio/shiny/issues/636
Regards,
Yihui
version of shiny: https://github.com/rstudio/shiny/issues/636
Regards,
Yihui
Reply all
Reply to author
Forward
0 new messages