Commit ddcbaa22 authored by Eduardo E. R. Junior's avatar Eduardo E. R. Junior
Browse files

Adiciona aplicativo sem etiqueta no deslizador

parent 8f453fd9
.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%;
}
##-------------------------------------------
## 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!")
}
})
}
##-------------------------------------------
## 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")
)
)
)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment