Commit c87a7850 authored by Eduardo E. R. Junior's avatar Eduardo E. R. Junior

Adiciona arquivos shiny do jogo 'regressão linear'

parent 5e76b7b8
This diff is collapsed.
##-------------------------------------------
## server.R
library(shiny)
shinyServer(
function(input, output){
## Objetos para armazenar as coordenadas
val <- reactiveValues(x = NULL, y = NULL, z = FALSE)
## Salva a posição dos dois pontos
observe({
if (is.null(input$plot_click)){
return()
}
isolate({
val$x <- c(val$x, input$plot_click$x)
val$y <- c(val$y, input$plot_click$y)
})
})
## Limpa os objetos reativos estimulado pelo `input$clear`
observe({
if (input$clear > 0){
val$x <- NULL
val$y <- NULL
val$z <- FALSE
}
})
## Habilita exibição estimulado pelo `input$result`
observe({
if (input$result > 0){
val$z <- TRUE
}
})
## Limpa o gráfico quando se troca de area em `input$area`
observeEvent(input$area, {
val$x <- NULL
val$y <- NULL
val$z <- FALSE
})
## Escolha do intervalo de confiança exibido
output$interval <- renderUI({
if(val$z) {
radioButtons("inter", "Intervalo de confiança",
c("Para a média" = "confidence",
"Para os dados" = "prediction"))
}
})
## Gráfico de dispersão
output$plot <- renderPlot({
## Conjunto de dados pré-definido
da <- switch(
input$area,
"Mercado Imobiliário" = da1,
"Meteorologia" = da2,
"Segurança Veicular" = da3,
"Relação Salarial" = da4,
"Mercado Automobilístico" = da5
)
## Labels definidos para cada conjunto
opt <- switch(
input$area,
"Mercado Imobiliário" =
list(ylab = "Preço de Venda Imovéis em log(R$)",
xlab = "Área dos Imóveis em log(m²)",
main = "Preço de Imovéis em Curitiba-PR"),
"Meteorologia" =
list(ylab = "Temperatura Máxima em °C",
xlab = "Velocidade Média do Vento em km/h",
main = "Temperatura Máxima em Nova York"),
"Segurança Veicular" = list(
ylab = "Distância Percorrida em metros",
xlab = "Velocidade do Veículo em km/h",
main = "Distância Para a Frenagem de um Veículo"),
"Relação Salarial" = list(
ylab = "Renda Familiar Per Capita Média em R$",
xlab = "Média de Anos Estudados de Pessoas a Partir de 25 anos",
main = "Renda Familiar per capita de Curitiba em 2000"),
"Mercado Automobilístico" = list(
ylab = "Preço dos Veículos em 1.000 R$",
xlab = "Quilometragem do Veículo em 1.000 Km",
main = "Preço de Carros Renault Duster")
)
## Gráfico de dispesão com linhas em azul nas extremidades
## dos dados
par(mar = c(4, 4, 1, 2), family = "Palatino")
plot(y ~ x, data = da, type = "n", main = opt$main,
xlab = opt$xlab, ylab = opt$ylab,
ylim = extendrange(da$y, f = 0.1)); grid()
points(y ~ x, data = da, pch = 19,
col = rgb(0.5, 0.5, 0.5, 0.5))
abline(v = extendrange(da$x, f = 0.015),
col = rgb(0, 0, 1, 0.15),
lwd = 10)
if(length(val$x) > 0){
points(x = val$x[1:2],
y = val$y[1:2],
pch = 19,
col = "red",
cex = 1.2)
segments(val$x[1], val$y[1],
val$x[2], val$y[2],
lwd = 2, col = "red")
}
if(val$z){
rg <- extendrange(da$x, f = 0.2)
pred <- expand.grid(
x = seq(rg[1], rg[2], length.out = 50))
model <- lm(y ~ x, data = da)
aux1 <- predict(model, newdata = pred,
interval = input$inter)
pred1 <- cbind(pred, aux1)
lines(fit ~ x, data = pred1, col = "blue", lwd = 2)
lines(lwr ~ x, data = pred1, lty=3, col = "blue")
lines(upr ~ x, data = pred1, lty = 3, col = "blue")
with(pred1,
polygon(c(x, rev(x)), c(lwr, rev(upr)),
col=rgb(0.1, 0.1, 0.1, 0.2), border = NA)
)
}
}, height = 500)
}
)
##-------------------------------------------
## ui.R
library(shiny)
library(shinythemes)
text <- "<div style=\"text-align:justify;
padding-left: 20px; padding-right: 20px\">
<p> Este aplicativo exemplifica uma das técnicas mais utilizadas em
Estatística, a regressão linear simples.
</p>
<p>
O jogo consiste no objetivo traçar um reta, clicando em dois pontos
(um em cada extremidade em azul), que passe o mais perto possível de
todos os pontos. São apresentados exemplos de 5 áreas diferentes onde
esta técnica pode ser aplicada.
</p></div>
"
shinyUI(
fluidPage(
theme = shinytheme("cerulean"),
title = "Regressão Simples",
sidebarLayout(
sidebarPanel(
## Texto de apoio
HTML(text),
hr(),
## Grandes áreas paara escolha
selectInput(
"area", "Áreas",
c("Mercado Imobiliário",
"Meteorologia",
"Segurança Veicular",
"Relação Salarial",
"Mercado Automobilístico"),
multiple = FALSE,
selectize = FALSE,
selected = "Financeiro"),
hr(),
## Botões para visualizar o modelo e recomeçar o jogo
actionButton(inputId = "result",
label = "Ver Resultado",
class = "btn btn-info"),
actionButton(inputId = "clear",
label = "Recomeçar",
class = "btn btn-warning"),
hr(),
## Escolha do tipo de intervalo de confiança
uiOutput("interval")
),
mainPanel(
plotOutput("plot", click = "plot_click")
)
)
)
)
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