diff --git a/shiny/sliderCego/invisible_slider.css b/shiny/sliderCego/invisible_slider.css new file mode 100644 index 0000000000000000000000000000000000000000..dc7fbeb34cf9e3e6d3e3ad37271d8a45399b18a8 --- /dev/null +++ b/shiny/sliderCego/invisible_slider.css @@ -0,0 +1,44 @@ +.irs-min, .irs-max { + color: rgba(0, 0, 0, 0); + background: rgba(0, 0, 0, 0) none repeat scroll 0% 0%; + font-size: 10px; + line-height: 1.333; + text-shadow: none; + top: 0px; + padding: 1px 3px; + border-radius: 3px; +} + +.irs-from, .irs-to, .irs-single { + color: rgba(255, 255, 255, 0); + background: transparent none repeat scroll 0% 0%; + font-size: 11px; + line-height: 1.333; + text-shadow: none; + padding: 1px 3px; + border-radius: 3px; +} + +.irs-bar-edge { + height: 3px; + top: 25px; + width: 14px; + border-width: 1px 0px 1px 1px; + border-style: solid none solid solid; + border-color: rgba(66, 139, 202, 0) -moz-use-text-color rgba(66, 139, 202, 0) rgba(66, 139, 202, 0); + -moz-border-top-colors: none; + -moz-border-right-colors: none; + -moz-border-bottom-colors: none; + -moz-border-left-colors: none; + border-image: none; + background: rgba(66, 139, 202, 0) none repeat scroll 0% 0%; + border-radius: 16px 0px 0px 16px; +} + +.irs-bar { + height: 8px; + top: 25px; + border-top: 1px solid rgba(66, 139, 202, 0); + border-bottom: 1px solid rgba(66, 139, 202, 0); + background: rgba(66, 139, 202, 0) none repeat scroll 0% 0%; +} diff --git a/shiny/sliderCego/server.R b/shiny/sliderCego/server.R new file mode 100644 index 0000000000000000000000000000000000000000..3648cb4ecdd980ffd8fb1523e10cbf89c43c1df5 --- /dev/null +++ b/shiny/sliderCego/server.R @@ -0,0 +1,93 @@ +##------------------------------------------- +## server.R + +library(shiny) +## Carrega template das aplicações elaboradas pelo projeto iguiR2 +source("../template.R") + +gradColor <- colorRampPalette(c("red", "yellow", "green")) + +server <- function(input, output) { + ## Cabeçalho IGUIR2 + output$header <- renderPrint({ + template("TEMA") + }) + + ##------------------------------------------- + ## Paleta de cores para a escala (opcional) + output$escala <- renderPlot({ + x <- seq(from = 1, to = 9, by = 0.01) + fx <- rep(1, length(x)) + par(mar = c(0, 0, 0, 0)) + plot(fx ~ x, type = "n", + ylim = c(-0.15, 1), + bty = "n", + axes = FALSE, + xlab = "", + ylab = "") + segments(x, rep(0, length(x)), + x, fx, + col = gradColor(length(x)), + lwd = 3) + points(input$nota, -0.15, pch = 17, cex = 2) + abline(v = input$nota) + }, bg = "transparent") + + ##------------------------------------------- + ## Valores reativos para salvar as respostas + v <- reactiveValues(pos = 1, + da = list( + nome = vector("character", len = 30), + prod = vector("character", len = 30), + nota = vector("numeric", len = 30))) + + ##------------------------------------------- + ## Salva as respostas + observeEvent(input$confirm, { + if(v$pos == 1) { + v$da$nome[1] <- input$avaliador + v$da$prod[1] <- input$produto + v$da$nota[1] <- input$nota + } else { + v$da$nome[v$pos] <- input$avaliador + v$da$prod[v$pos] <- input$produto + v$da$nota[v$pos] <- input$nota + } + v$pos <- v$pos + 1 + }) + + ##------------------------------------------- + ## Atribui NA a nota confirmada se `input$undo` + observeEvent(input$undo, { + if(v$pos != 1) { + v$pos <- v$pos - 1 + v$da$nota[v$pos] <- NA + } + }) + + ##------------------------------------------- + ## Exibe as respostas + output$resp <- renderPrint({ + as.data.frame(v$da) + }) + + ##------------------------------------------- + ## Cria os botões apenas para valores válidos + output$buttons <- renderUI({ + if (v$pos > 0 & v$pos < 31) { + tagList( + column(width = 6, offset = 1, + actionButton("confirm", "Confirmar Nota", + icon = icon("fa fa-check")) + ), + column(width = 5, + actionButton("undo", "Desfazer", + icon = icon("fa fa-undo")) + ) + ) + } else { + HTML("Obrigado pelas avaliações!") + } + }) +} + diff --git a/shiny/sliderCego/ui.R b/shiny/sliderCego/ui.R new file mode 100644 index 0000000000000000000000000000000000000000..876daa16524598bf6ff8c638e0962576ba8e878a --- /dev/null +++ b/shiny/sliderCego/ui.R @@ -0,0 +1,42 @@ +##------------------------------------------- +## ui.R + +library(shiny) + +ui <- fluidPage( + ## Cabeçalho IGUIR2 + htmlOutput("header"), + + includeCSS("invisible_slider.css"), + + sidebarLayout( + sidebarPanel( + h4("Escala de avaliação"), + + hr(), + + textInput("avaliador", "Seu Nome", ""), + + selectInput("produto", "Produto Avaliado", + choices = paste0("arvore", 0:10)), + + hr(), + + plotOutput("escala", height = "50px"), + + sliderInput("nota", "", + min = 1, max = 9, value = 5, step = 0.01, + ticks = FALSE), + + hr(), + + uiOutput("buttons"), + + hr() + ), + + mainPanel( + verbatimTextOutput("resp") + ) + ) +)