diff --git a/shiny/deliQuadLat/server.R b/shiny/deliQuadLat/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..3ad9bc26326246fdd307fc3737cb9991b01fa658
--- /dev/null
+++ b/shiny/deliQuadLat/server.R
@@ -0,0 +1,95 @@
+##-------------------------------------------
+## server.R
+
+## FUNCIONA LOCALMENTE MAS NÃO DÁ CERTO QUANDO MANDA PARA SERVIDORA. ALGO ESQUISITO.
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+require(lattice)
+require(RColorBrewer)
+
+## Função para aleatorizar experimento em quadrado latino.
+
+qldesign <- function(dim){
+ ## dim: escalar inteiro que é a dimensão do QL.
+ M <- matrix(1:dim, dim, dim)
+ N <- M+(t(M))
+ O <- (N%%dim)+1
+ lin <- sample(1:dim)
+ col <- sample(1:dim)
+ M <- O[lin,col]
+ D <- expand.grid(lin=gl(dim,1), col=gl(dim,1))
+ D$trat <- c(M)
+ return(list(M=M, D=D))
+}
+
+# da <- qldesign(5)
+#
+# # display.brewer.all()
+# colr <- brewer.pal(9, "Set1")
+# colr <- colorRampPalette(colr, space="rgb")
+#
+# levelplot(trat~lin+col, data=da$D, aspect=1,
+# colorkey=FALSE,
+# col.regions=colr,
+# panel=function(x, y, z, ...){
+# panel.levelplot(x=x, y=y, z=z, ...)
+# panel.text(x=x, y=y, labels=LETTERS[z])
+# })
+
+shinyServer(
+ function(input, output, clientData, session){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$ui <- renderUI({
+ if(input$set){
+ textInput(inputId="seed",
+ label="Semente:",
+ value=1234)
+ } else {
+ return()
+ }
+ })
+
+ do <- reactive({
+ if(input$set){
+ seed <- input$seed
+ set.seed(seed)
+ } else {
+ seed <- sample(100:999, size=1)
+ set.seed(seed)
+ }
+ da <- qldesign(input$size)
+ da$seed <- seed
+ return(da=da)
+ })
+
+ output$plotRes <- renderPlot({
+ da <- do()
+ colr <- brewer.pal(9, "Set1")
+ colr <- colorRampPalette(colr, space="rgb")
+
+ levelplot(trat~lin+col, data=da$D, aspect=1,
+ colorkey=FALSE,
+ xlab="Linha", ylab="Coluna",
+ col.regions=colr,
+ panel=function(x, y, z, ...){
+ panel.levelplot(x=x, y=y, z=z, ...)
+ panel.text(x=x, y=y, labels=LETTERS[z])
+ })
+ })
+
+ output$downloadData <- downloadHandler(
+ filename=function(){
+ paste("dql", input$size, "-", do()$seed,".txt", sep="")
+ },
+ content=function(file) {
+ write.table(x=do()$D, file=file,
+ quote=FALSE, row.names=FALSE,
+ sep="\t")
+ }
+ )
+ })
diff --git a/shiny/deliQuadLat/ui.R b/shiny/deliQuadLat/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..1166e25e0d3980bdbe9df60fdd4898d1297731f2
--- /dev/null
+++ b/shiny/deliQuadLat/ui.R
@@ -0,0 +1,27 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Delineamento Quadrado Latino"),
+ sidebarLayout(
+ sidebarPanel(
+ numericInput(inputId="size",
+ label="Tamanho do Quadrado Latino:",
+ min=4, max=20,
+ step=1, value=5),
+ checkboxInput(inputId="set", label="Fixar semente."),
+ uiOutput("ui"),
+ downloadButton("downloadData", "Download")
+ ),
+ mainPanel(
+ plotOutput("plotRes")
+ )
+ )
+ )
+)
diff --git a/shiny/distProb/server.R b/shiny/distProb/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..27e24c2d348d0e0b240be493bc2a97f3e5f65955
--- /dev/null
+++ b/shiny/distProb/server.R
@@ -0,0 +1,105 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$ui <- renderUI({
+ if(is.null(input$dist)){
+ return()}
+ switch(input$dist,
+ "poisson"={
+ output$plot <- renderPlot({
+ x <- 0:30
+ px <- dpois(x, lambda=input$poissonLambda)
+ plot(x, px, type="h", xlab="x", ylab="Pr(x)")
+ })
+ wellPanel(
+ sliderInput(inputId="poissonLambda",
+ label="Média da Poisson",
+ min=0.1, max=20, value=10)
+ )
+ },
+
+ "binomial"={
+ output$plot <- renderPlot({
+ x <- 0:input$binomialSize
+ px <- dbinom(x, size=input$binomialSize,
+ prob=input$binomialProb)
+ plot(x, px, type="h", xlab="x", ylab="Pr(x)")
+ })
+ wellPanel(
+ sliderInput(inputId="binomialSize",
+ "Número de ensaios",
+ min=0, max=30, value=10, step=1),
+ sliderInput(inputId="binomialProb",
+ label="Probabilidade de sucesso",
+ min=0.02, max=0.98,
+ value=0.5, step=0.02)
+
+ )
+ },
+
+ "beta"={
+ output$plot <- renderPlot({
+ curve(dbeta(x,
+ shape1=input$betaShape1,
+ shape2=input$betaShape2),
+ from=0, to=1,
+ xlab="x", ylab="f(x)")
+ })
+ wellPanel(
+ sliderInput(inputId="betaShape1",
+ label="Parâmetro de forma 1",
+ min=0.01, max=7, value=1, step=0.1),
+ sliderInput(inputId="betaShape2",
+ label="Parâmetro de forma 2",
+ min=0.01, max=7, value=1, step=0.1)
+ )
+ },
+
+ "gamma"={
+ output$plot <- renderPlot({
+ curve(dgamma(x,
+ shape=input$gammaShape,
+ rate=input$gammaRate),
+ from=0, to=20,
+ xlab="x", ylab="f(x)")
+ })
+ wellPanel(
+ sliderInput(inputId="gammaShape",
+ label="Parâmetro de forma",
+ min=0.01, max=7, value=1, step=0.1),
+ sliderInput(inputId="gammaRate",
+ label="Parâmetro de taxa",
+ min=0.01, max=7, value=1, step=0.1)
+ )
+ },
+
+ "normal"={
+ output$plot <- renderPlot({
+ curve(dnorm(x,
+ mean=input$normalMean,
+ sd=input$normalSd),
+ from=-3, to=3,
+ xlab="x", ylab="f(x)")
+ })
+ wellPanel(
+ sliderInput(inputId="normalMean",
+ label="Média da normal",
+ min=-3, max=3, value=0, step=0.05),
+ sliderInput(inputId="normalSd",
+ label="Desvio-padrão da normal",
+ min=0.1, max=3, value=1, step=0.05)
+ )
+ }
+ )
+ })
+ })
diff --git a/shiny/distProb/ui.R b/shiny/distProb/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..fcdabb6f3141404cb478be7975e1bd38bb88cc40
--- /dev/null
+++ b/shiny/distProb/ui.R
@@ -0,0 +1,28 @@
+##-------------------------------------------
+## ui.R
+
+require(shiny)
+
+choi <- c("Poisson"="poisson",
+ "Binomial"="binomial",
+ "Beta"="beta",
+ "Gamma"="gamma",
+ "Normal"="normal")
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Distribuições de probabilidade"),
+ sidebarPanel(
+ selectInput(inputId="dist",
+ label="Distribuição",
+ choices=choi),
+ uiOutput("ui")
+ ),
+ mainPanel(
+ plotOutput("plot")
+ )
+ )
+)
\ No newline at end of file
diff --git a/shiny/fastCalc/server.R b/shiny/fastCalc/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..7a4178c9f8f8994fb76d3d59ac85097b882348db
--- /dev/null
+++ b/shiny/fastCalc/server.R
@@ -0,0 +1,123 @@
+##-------------------------------------------
+## server.R
+
+## FUNCIONA LOCALMENTE MAS NÃO DÁ CERTO QUANDO MANDA PARA SERVIDORA. ALGO ESQUISITO.
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+## Número de alternativas.
+nalter <- 4
+
+## Hora do acesso.
+tm0 <- Sys.time()
+tm <- tm0
+
+## Remove arquivo de log para criar um novo.
+file.remove("log")
+cat("expr; timeDes; correctAnswer; userAnswer", sep="\n", file="log")
+
+shinyServer(
+ function(input, output, clientData, session){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+
+ ## Responde a estímulos no `input$goButton`.
+ do <- reactive({
+ input$goButton
+ smpl <- sample(0:9, size=2)
+ expr <- paste0(smpl[1], " + ", smpl[2], " = ")
+ erros <- sample(c(-1,1), size=nalter-1, replace=TRUE)*sample(1:5, size=nalter-1)
+ answers <- sum(smpl)+c(0, erros)
+ ran <- sample(1:nalter)
+ return(list(expr=expr, choi=answers[ran], correct=answers[1])
+ )
+ })
+
+ ## Apresenta a expressão.
+ output$expr <- renderText(do()$expr)
+
+ ## Gera o `radioInput()`. Estímulo do `input$goButton` pelo `do()$choi`.
+ output$uiRadio <- renderUI({
+ return(
+ radioButtons(inputId="radio",
+ label="",
+ choices=do()$choi,
+ selected=NA,
+ inline=FALSE)
+ )
+ })
+
+ ## Executado toda vez que clica no `input$radio`.
+ ## Não responde ao `input$goButton` porque se usou isolate(do()$...).
+ results <- reactive({
+ tm <<- c(Sys.time(), tm) ## Informação do instante.
+ ## Diferença de tempo só deve aparecer depois de escolher resposta.
+ d <- 0
+ if(!is.null(input$radio)){
+ d <- as.numeric(diff(tm[2:1])) ## Diferença entre ações.
+ }
+ iscerto <- isolate(do()$correct)==as.integer(isolate(input$radio))
+ td <- sprintf("Tempo de decisão: %0.3f", d)
+ rc <- paste("Resposta correta: ", ifelse(iscerto, "SIM", "NÃO"))
+ return(list(td=td,
+ rc=rc,
+ d=d,
+ expr=isolate(do()$expr),
+ corAns=isolate(do()$correct),
+ userAns=input$radio
+ )
+ )
+ })
+
+ ## Vínculado ao `input$radio`.
+ output$result <- renderPrint({
+ ## Print para usuário.
+ cat(results()$td, "\n", results()$rc, sep="")
+ ## cat(results()$rc)
+ })
+
+ ## Executado toda vez que clica no botão `input$goButton`.
+ ## Não depende do `input$radio` por causa do isolate(results()$...).
+ observe({
+ input$goButton
+ cat(paste(
+ isolate(results()$expr), ## Expressão.
+ isolate(results()$d), ## Tempo para decisão.
+ isolate(results()$corAns), ## Resposta correta.
+ isolate(results()$userAns), ## Resposta marcada.
+ sep="; "),
+ sep="\n",
+ file="log",
+ append=TRUE)
+ })
+
+ ## Sensível ao `input$goResults` apenas.
+ output$plotRes <- renderPlot({
+ input$goResults
+ da <- read.table(file="log", sep=";", header=TRUE)
+ if(nrow(da)>1){
+ da <- na.omit(da)
+ n <- nrow(da)
+ y <- as.integer(da$userAnswer==da$correctAnswer)
+ x <- da$time
+ plot(density(x),
+ xlab="Tempo para decisão (s)",
+ ylab="Densidade",
+ main=NA,
+ sub=NA)
+ yr <- 0.05*diff(range(par()$usr[3:4]))
+ points(x, y*yr, col=y+1)
+ m <- mean(x, na.rm=TRUE)
+ p <- sum(y)/nrow(da)
+ abline(v=m, lty=2)
+ mtext(side=3, line=2,
+ text=sprintf("Tempo médio de decisão: %0.3f segundos", m))
+ mtext(side=3, line=1,
+ text=sprintf("Proporção de acertos: %0.2f%s", 100*p, "%"))
+ }
+ })
+ })
diff --git a/shiny/fastCalc/ui.R b/shiny/fastCalc/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..a9a464757ec2d64d49b3d85fa1f809d63ac875a3
--- /dev/null
+++ b/shiny/fastCalc/ui.R
@@ -0,0 +1,27 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Seja rápido!"),
+ sidebarLayout(
+ sidebarPanel(
+ h5("Qual o resultado da soma?"),
+ textOutput("expr"),
+ uiOutput("uiRadio"),
+ actionButton(inputId="goButton", label="Novo!"),
+ hr(),
+ actionButton(inputId="goResults", label="Resultados!")
+ ),
+ mainPanel(
+ verbatimTextOutput("result"),
+ plotOutput("plotRes")
+ )
+ )
+ )
+)
diff --git a/shiny/hist1/server.R b/shiny/hist1/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..de862fc520025be724f41f6c1babe6a0e7150de1
--- /dev/null
+++ b/shiny/hist1/server.R
@@ -0,0 +1,21 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(function(input, output) {
+ output$hist.reactive <- renderPlot({
+ x <- precip
+ hist(x,
+ col=paste0("#", input$html),
+ breaks=input$sl,
+ main=NULL,
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ if(input$rg){
+ rug(x)
+ }
+ })
+})
diff --git a/shiny/hist1/ui.R b/shiny/hist1/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..f640a20c196ceef304d61877b81feeb0e49c073f
--- /dev/null
+++ b/shiny/hist1/ui.R
@@ -0,0 +1,30 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ sliderInput(inputId="sl",
+ label="Sugestão do número de classes:",
+ min=1,
+ max=20,
+ step=1,
+ value=10),
+ textInput(inputId="html",
+ label="Especifique cor em formato html:",
+ value="FF0000"),
+ checkboxInput(inputId="rg",
+ label="Colocar rug?",
+ value=FALSE)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+))
diff --git a/shiny/hist2/server.R b/shiny/hist2/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..089536a4f5d96bbda160a24502b6ea20073c462d
--- /dev/null
+++ b/shiny/hist2/server.R
@@ -0,0 +1,28 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(function(input, output) {
+ output$hist.reactive <- renderPlot({
+ x <- precip
+ ## Amplitude total aumentada.
+ at <- extendrange(range(x), f=0.025)
+ ## Classes.
+ bks <- seq(from=at[1], to=at[2], length.out=input$cls+1)
+ hist(x,
+ col=rgb(
+ red=input$sr,
+ green=input$sg,
+ blue=input$sb),
+ breaks=bks,
+ main=NULL,
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ if(input$rg){
+ rug(x)
+ }
+ })
+})
diff --git a/shiny/hist2/ui.R b/shiny/hist2/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..507322f1ae975c6a8688dc02cd934deded754dc6
--- /dev/null
+++ b/shiny/hist2/ui.R
@@ -0,0 +1,30 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ sliderInput(inputId="cls",
+ label="Número de classes:",
+ min=1, max=20, step=1, value=10),
+ sliderInput(inputId="sr", label="R:",
+ min=0, max=1, step=0.05, value=0.5),
+ sliderInput(inputId="sg", label="G:",
+ min=0, max=1, step=0.05, value=0.5),
+ sliderInput(inputId="sb", label="B:",
+ min=0, max=1, step=0.05, value=0.5),
+ checkboxInput(inputId="rg",
+ label="Colocar rug?",
+ value=FALSE)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+))
diff --git a/shiny/hist_button/server.R b/shiny/hist_button/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..c1b616b336a9eecc93fab13400e0bbace84e167d
--- /dev/null
+++ b/shiny/hist_button/server.R
@@ -0,0 +1,23 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+ht <- hist(precip, plot = FALSE)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ input$acao
+ col <- sample(colors(), size=1)
+ plot(ht, main=NULL,
+ ylab="Frequência absoluta", xlab="Precipitação",
+ col=col, sub=col)
+ })
+ })
diff --git a/shiny/hist_button/ui.R b/shiny/hist_button/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..175d3f0ced5c50938fac0f773fecdaaac69dbdf5
--- /dev/null
+++ b/shiny/hist_button/ui.R
@@ -0,0 +1,21 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ actionButton(inputId="acao", label="Nova cor!")
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_checkbox/server.R b/shiny/hist_checkbox/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..6b5b616cac47a4b6d88be5f407cf225533253031
--- /dev/null
+++ b/shiny/hist_checkbox/server.R
@@ -0,0 +1,30 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+
+ht <- hist(x, plot = FALSE)
+col <- rep("#3366CC", length(ht$counts))
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ if(input$modal){
+ col[which.max(ht$counts)] <- "#142952"
+ }
+ plot(ht, col=col, main=NULL,
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ if(input$rg){
+ rug(x)
+ }
+ })
+ })
diff --git a/shiny/hist_checkbox/ui.R b/shiny/hist_checkbox/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..49178c84fb2227d5ab7b52e7232821379609b279
--- /dev/null
+++ b/shiny/hist_checkbox/ui.R
@@ -0,0 +1,26 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ checkboxInput(inputId="rg",
+ label="Marcar sobre eixo com os valores?",
+ value=FALSE),
+ checkboxInput(inputId="modal",
+ label="Destacal a classe modal?",
+ value=FALSE)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_checkboxgroup/server.R b/shiny/hist_checkboxgroup/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..9e741d91a07881a3713192adb84a27cf9ffd163c
--- /dev/null
+++ b/shiny/hist_checkboxgroup/server.R
@@ -0,0 +1,25 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+ht <- hist(x, plot = FALSE)
+nc <- length(ht$counts)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ seqcol <- colorRampPalette(input$colors)
+ plot(ht, col=seqcol(nc),
+ main=NULL,
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ })
+ })
diff --git a/shiny/hist_checkboxgroup/ui.R b/shiny/hist_checkboxgroup/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..37e5ca02e42cc6749d03ce354b83b674bad28d70
--- /dev/null
+++ b/shiny/hist_checkboxgroup/ui.R
@@ -0,0 +1,26 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+cols <- c(Vermelho="#F81D54", Amarelo="#FF9F1E", Azul="#2791E1", Verde="#72F51D")
+cols2 <- c(cols, rev(cols))
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ checkboxGroupInput(inputId="colors",
+ label="Escolha as cores para interpolar:",
+ choices=cols2, selected="#72F51D")
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_numeric/server.R b/shiny/hist_numeric/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..ee3114cbb72129b7cf43d6609f635ee39f207723
--- /dev/null
+++ b/shiny/hist_numeric/server.R
@@ -0,0 +1,30 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+ht <- hist(x, plot = FALSE)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ m <- input$mar
+ par(mar=c(m, m, 1, 1))
+ plot(ht, col="#660066",
+ main=NULL, axes=FALSE, ann=FALSE,
+ xaxt="n", yaxt="n")
+ box(bty="L")
+ axis(side=1, cex.axis=input$cexaxis)
+ axis(side=2, cex.axis=input$cexaxis)
+ title(ylab="Frequência absoluta",
+ xlab="Precipitação",
+ line=input$line)
+ })
+ })
diff --git a/shiny/hist_numeric/ui.R b/shiny/hist_numeric/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..6bb6316769e9aca8c185bec48b6a340c4f9b0926
--- /dev/null
+++ b/shiny/hist_numeric/ui.R
@@ -0,0 +1,29 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ numericInput(inputId="cexaxis",
+ label="Tamanho do texto dos eixos:",
+ value=1, min=0.5, max=2, step=0.1),
+ numericInput(inputId="line",
+ label="Distância dos rótulos dos eixos:",
+ value=3, min=1, max=4, step=0.1),
+ numericInput(inputId="mar",
+ label="Tamanho do texto dos eixos:",
+ value=5, min=3, max=7, step=0.5)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_radio/server.R b/shiny/hist_radio/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..207acd42ddb82daf4d7b61ca9bb1a875beebd76c
--- /dev/null
+++ b/shiny/hist_radio/server.R
@@ -0,0 +1,24 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+ht <- hist(x, plot = FALSE)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ plot(ht,
+ col=input$col,
+ main=NULL,
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ })
+ })
diff --git a/shiny/hist_radio/ui.R b/shiny/hist_radio/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..649de6046ab725ae2ab9a868d3b1a1ce375c9119
--- /dev/null
+++ b/shiny/hist_radio/ui.R
@@ -0,0 +1,28 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ radioButtons(inputId="col",
+ label="Escolha a cor para as barras:",
+ choices=c(Turquesa="#00CC99",
+ Azul="#0066FF",
+ Rosa="#FF3399",
+ Laranja="#FF6600",
+ Roxo="#660066",
+ "Verde limão"="#99FF33"))
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_select/server.R b/shiny/hist_select/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..795cc0cb767fa351b2e5c71f04e55a97f9dc364b
--- /dev/null
+++ b/shiny/hist_select/server.R
@@ -0,0 +1,27 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ L <- switch(input$obj,
+ precip=list(x=precip, xlab="Precipitação anual média (polegadas)"),
+ rivers=list(x=rivers, xlab="Comprimento dos rios (milhas)"),
+ islands=list(x=islands, xlab="Área de ilhas (1000 milhas quadradas)"))
+ hist(L$x,
+ breaks=input$nclass,
+ col="#8F0047",
+ main=NULL,
+ ylab="Frequência absoluta",
+ xlab=L$xlab)
+ rug(L$x)
+ })
+ })
diff --git a/shiny/hist_select/ui.R b/shiny/hist_select/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..6bcf9dd4bcf51e58153bf68c007e2ba2e32b3ed8
--- /dev/null
+++ b/shiny/hist_select/ui.R
@@ -0,0 +1,29 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+nclass <- c("Sturges", "Scott", "Freedman-Diaconis")
+obj <- c("precip","rivers","islands")
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ selectInput(inputId="obj",
+ label="Escolha o conjunto de dados:",
+ choices=obj),
+ selectInput(inputId="nclass",
+ label="Escolha a regra para número de classes:",
+ choices=nclass)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_select2/server.R b/shiny/hist_select2/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..866aa15b65cc59e0ee464762aa7c49017858848e
--- /dev/null
+++ b/shiny/hist_select2/server.R
@@ -0,0 +1,27 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+ht <- hist(x)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ f <- as.integer(input$fnt)
+ plot(ht,
+ family=input$fml,
+ font=as.integer(input$fnt),
+ col="#FF9200",
+ main=NULL,
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ })
+ })
diff --git a/shiny/hist_select2/ui.R b/shiny/hist_select2/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..83275253c077556aa39295a86d3e4f628aa5c49c
--- /dev/null
+++ b/shiny/hist_select2/ui.R
@@ -0,0 +1,29 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+fml <- names(X11Fonts())
+fnt <- c("plain"=1, "bold"=2, "italic"=3, "bold-italic"=4)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ radioButtons(inputId="fml",
+ label="Escolha a fonte:",
+ choices=fml, selected="serif"),
+ radioButtons(inputId="fnt",
+ label="Escolha a fonte:",
+ choices=fnt, selected=1)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_slider/server.R b/shiny/hist_slider/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..cadfc710049c535a6c9b3f94fb311d95932fe78a
--- /dev/null
+++ b/shiny/hist_slider/server.R
@@ -0,0 +1,28 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+
+## Extremos com amplitude estendida em 5%
+a <- extendrange(x, f=0.05)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ bks <- seq(a[1], a[2], length.out=input$nclass+1)
+ hist(x,
+ breaks=bks,
+ main=NULL,
+ col="#008A8A",
+ ylab="Frequência absoluta",
+ xlab="Precipitação")
+ })
+ })
diff --git a/shiny/hist_slider/ui.R b/shiny/hist_slider/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..08808bc09c55c1f83d9551accb549ba657b8e9e1
--- /dev/null
+++ b/shiny/hist_slider/ui.R
@@ -0,0 +1,26 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ sliderInput(inputId="nclass",
+ label="Número de classes:",
+ min=1,
+ max=30,
+ step=1,
+ value=10)
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/hist_text/server.R b/shiny/hist_text/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..2ee044518772e7ee0aa5983725ef06120723bcd8
--- /dev/null
+++ b/shiny/hist_text/server.R
@@ -0,0 +1,24 @@
+##-------------------------------------------
+## server.R
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+x <- precip
+ht <- hist(x, plot = FALSE)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$hist.reactive <- renderPlot({
+ plot(ht, col="#006666",
+ ylab="Frequência absoluta",
+ xlab="Precipitação",
+ main=input$main,
+ sub=input$sub)
+ })
+ })
diff --git a/shiny/hist_text/ui.R b/shiny/hist_text/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..34cb6594822251479487c440e4b1b4fca28398ec
--- /dev/null
+++ b/shiny/hist_text/ui.R
@@ -0,0 +1,26 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Histograma"),
+ sidebarLayout(
+ sidebarPanel(
+ textInput(inputId="main",
+ label="Texto para o título:",
+ value=""),
+ textInput(inputId="sub",
+ label="Texto para o subtítulo:",
+ value="")
+ ),
+ mainPanel(
+ plotOutput("hist.reactive")
+ )
+ )
+ )
+)
diff --git a/shiny/insertTemplate b/shiny/insertTemplate
new file mode 100755
index 0000000000000000000000000000000000000000..6959392ca1145ac1a920b9a1e180a63694f483d8
--- /dev/null
+++ b/shiny/insertTemplate
@@ -0,0 +1,28 @@
+#!/bin/bash
+
+##======================================================================
+## Eduardo Junior
+## eduardo.jr@ufpr.br
+## 13-11-2015
+##======================================================================
+## Facilitando a inclusão do template em aplicacoes já elaboradas
+
+##-------------------------------------------
+## Para os arquivos ui.R
+
+for file in $(find -type f -name "ui.R"); do
+ sed -i "1i\##-------------------------------------------\n## ui.R\n" $file
+ sed -i "/fluidPage(/a\ ## Cabeçalho IGUIR2\n htmlOutput(\"header\"),\n" $file
+done
+
+##-------------------------------------------
+## Para os arquivos server.R
+
+for file in $(find -type f -name "server.R"); do
+ sed -i "1i\##-------------------------------------------\n## server.R\n" $file
+ sed -i "/library(shiny)/a\## Carrega template das aplicações elaboradas pelo projeto iguiR2\nsource(\"../template.R\")" $file
+ sed -i "/require(shiny)/a\## Carrega template das aplicações elaboradas pelo projeto iguiR2\nsource(\"../template.R\")" $file
+ sed -i "/output){/a\ ## Cabeçalho IGUIR2\n output\$header <- renderPrint({\n template(\"TEMA\")\n })" $file
+ sed -i "/session){/a\ ## Cabeçalho IGUIR2\n output\$header <- renderPrint({\n template(\"TEMA\")\n })" $file
+done
+
diff --git a/shiny/outputHTML/server.R b/shiny/outputHTML/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..7bab951654348380c2da4ab485e7330a97190567
--- /dev/null
+++ b/shiny/outputHTML/server.R
@@ -0,0 +1,20 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+require(xtable)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$summaryAov <- renderPrint({
+ m0 <- lm(Fertility~1+.,
+ data=swiss[,c("Fertility", input$variables)])
+ print(xtable(anova(m0)), type="html")
+ })
+ })
diff --git a/shiny/outputHTML/ui.R b/shiny/outputHTML/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..e6237bf6e9653e4afc08fac48e24898bad5a7ec8
--- /dev/null
+++ b/shiny/outputHTML/ui.R
@@ -0,0 +1,24 @@
+##-------------------------------------------
+## ui.R
+
+require(shiny)
+
+choi <- names(swiss)[-1]
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Regressão múltipla"),
+ sidebarPanel(
+ checkboxGroupInput(inputId="variables",
+ label="Selecione as variáveis independentes:",
+ choices=choi,
+ selected=choi[1:2])
+ ),
+ mainPanel(
+ htmlOutput("summaryAov")
+ )
+ )
+)
\ No newline at end of file
diff --git a/shiny/outputTable/server.R b/shiny/outputTable/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..5f3e43ab7e9a26e814f9fbcdc8d62c9e619e93b7
--- /dev/null
+++ b/shiny/outputTable/server.R
@@ -0,0 +1,19 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$mtcarsTable <- renderDataTable({
+ mtcars[,input$variables]
+ },
+ options=list(orderClasses=TRUE))
+ })
+
diff --git a/shiny/outputTable/ui.R b/shiny/outputTable/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..460fd2bc3c5cf117a8e34d61ad6ae7e49f3ebf98
--- /dev/null
+++ b/shiny/outputTable/ui.R
@@ -0,0 +1,24 @@
+##-------------------------------------------
+## ui.R
+
+require(shiny)
+
+choi <- names(mtcars)
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Tabela de dados mtcars"),
+ sidebarPanel(
+ checkboxGroupInput(inputId="variables",
+ label="Selecione as variáveis:",
+ choices=choi,
+ selected=choi[1:4])
+ ),
+ mainPanel(
+ dataTableOutput("mtcarsTable")
+ )
+ )
+)
\ No newline at end of file
diff --git a/shiny/outputVerbatim/server.R b/shiny/outputVerbatim/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..cefab22f503b4e309b113310b8ef6265ccd2e589
--- /dev/null
+++ b/shiny/outputVerbatim/server.R
@@ -0,0 +1,19 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$summaryLm <- renderPrint({
+ m0 <- lm(Fertility~1+.,
+ data=swiss[,c("Fertility", input$variables)])
+ summary(m0)
+ })
+ })
diff --git a/shiny/outputVerbatim/ui.R b/shiny/outputVerbatim/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..09bd8d720d5d708d0b35fe4b64ca5cb006d0f027
--- /dev/null
+++ b/shiny/outputVerbatim/ui.R
@@ -0,0 +1,24 @@
+##-------------------------------------------
+## ui.R
+
+require(shiny)
+
+choi <- names(swiss)[-1]
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Regressão múltipla"),
+ sidebarPanel(
+ checkboxGroupInput(inputId="variables",
+ label="Selecione as variáveis independentes:",
+ choices=choi,
+ selected=choi[1:2])
+ ),
+ mainPanel(
+ verbatimTextOutput("summaryLm")
+ )
+ )
+)
\ No newline at end of file
diff --git a/shiny/regex/server.R b/shiny/regex/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..aa46a0597aa78e6967635f0d1434f8e9d04c410b
--- /dev/null
+++ b/shiny/regex/server.R
@@ -0,0 +1,45 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$ui <- renderUI({
+ switch(input$regexjob,
+ "grepl"={
+ output$text <- renderText({
+ grepl(x=as.character(input$string),
+ pattern=as.character(input$pattern))
+ })
+ wellPanel(
+ textInput(inputId="string",
+ label="Termo:"),
+ textInput(inputId="pattern",
+ label="Padrão REGEX:")
+ )
+ },
+ "gsub"={
+ output$text <- renderText({
+ gsub(x=as.character(input$string),
+ pattern=as.character(input$pattern),
+ replacement=as.character(input$replacement))
+ })
+ wellPanel(
+ textInput(inputId="string",
+ label="Termo:"),
+ textInput(inputId="pattern",
+ label="Padrão REGEX de busca:"),
+ textInput(inputId="replacement",
+ label="Padrão REGEX de substituição:")
+ )
+ }
+ )
+ })
+ })
diff --git a/shiny/regex/ui.R b/shiny/regex/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..bd1e8d4f198033d033e7af04cfa8e63c466eec79
--- /dev/null
+++ b/shiny/regex/ui.R
@@ -0,0 +1,25 @@
+##-------------------------------------------
+## ui.R
+
+library(shiny)
+
+choi <- c("Construção e ajuste"="grepl",
+ "Procura e substituição"="gsub")
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Construidor de expressões regulares"),
+ sidebarPanel(
+ radioButtons(inputId="regexjob",
+ label="Uso de expressão regular",
+ choices=choi),
+ uiOutput("ui")
+ ),
+ mainPanel(
+ textOutput("text")
+ )
+ )
+)
\ No newline at end of file
diff --git a/shiny/teoLimCentral/server.R b/shiny/teoLimCentral/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..25fa43e720051344bfed7c733effcb263176d693
--- /dev/null
+++ b/shiny/teoLimCentral/server.R
@@ -0,0 +1,96 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+require(latticeExtra)
+
+rm(list=ls())
+
+N <- 500
+n <- c(1,2,3,5,10,20)
+da <- data.frame(tam=rep(n, each=N))
+
+panel.dens <- function(x, ...){
+ panel.densityplot(x, ...)
+ m <- mean(x)
+ s <- sd(x)
+ panel.mathdensity(dmath=dnorm, col="blue",
+ args=list(mean=m, sd=s))
+}
+
+panel.fa <- function(x, ...){
+ panel.ecdfplot(x, ...)
+ m <- mean(x)
+ s <- sd(x)
+ xx <- seq(min(x), max(x), length.out=20)
+ panel.lines(xx, pnorm(xx, m, s), col="blue")
+}
+
+# y <- runif(1000)
+# ecdfplot(~y,
+# data=da, as.table=TRUE,
+# xlab=expression(bar(X)),
+# ylab="Frequêcia acumulada",
+# panel=panel.fa)
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+ output$distBarX <- renderPlot({
+ ## Define a distribuiação de probabilidade de X.
+ barX <- switch(input$distX,
+ UD5=function(ni){
+ mean(sample(1:5, size=ni, replace=TRUE))
+ },
+ U01=function(ni){
+ mean(runif(ni, min=0, max=1))
+ },
+ N01=function(ni){
+ mean(rnorm(ni, mean=0, sd=1))
+ },
+ E1=function(ni){
+ mean(rexp(ni, rate=1))
+ },
+ Poi5=function(ni){
+ mean(rpois(ni, lambda=5))
+ },
+ BetaA=function(ni){
+ mean(rbeta(ni, shape1=0.5, shape2=0.5))
+ }
+ )
+ ## Obtém a distribuição de bar(X).
+ da$barx <-
+ do.call(c, lapply(as.list(n),
+ function(ni){
+ replicate(N, {
+ barX(ni)
+ })
+ }))
+ ## Define parâmetros gráficos.
+ trellis.par.set(list(
+ grid.pars=list(fontfamily="palatino"),
+ strip.background=list(col="gray70"),
+ plot.line=list(col=1),
+ plot.symbol=list(col=1))
+ )
+ ## Representa a distribuição de probabilidades.
+ p <- switch(input$plotType,
+ dens=densityplot(~barx|factor(tam),
+ data=da, as.table=TRUE,
+ xlab=expression(bar(X)),
+ ylab="Densidade",
+ panel=panel.dens),
+ ecdf=ecdfplot(~barx|factor(tam),
+ data=da, as.table=TRUE,
+ xlab=expression(bar(X)),
+ ylab="Frequêcia acumulada",
+ panel=panel.fa)
+ )
+ return(print(p))
+ })
+ })
diff --git a/shiny/teoLimCentral/ui.R b/shiny/teoLimCentral/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..c008fa185606bc35c73f283cadea8a7f80cbbf58
--- /dev/null
+++ b/shiny/teoLimCentral/ui.R
@@ -0,0 +1,34 @@
+##-------------------------------------------
+## ui.R
+
+require(shiny)
+
+distX <- c("Uniforme discreta (5)"="UD5",
+ "Uniforme Contínua (0,1)"="U01",
+ "Exponencial (1)"="E1",
+ "Poisson (5)"="Poi5",
+ "Normal (0,1)"="N01",
+ "Beta (0.5, 0.5)"="BetaA")
+plotType <- c("Densidade empírica"="dens",
+ "Frequência acumulada"="ecdf")
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ headerPanel("Distribuição amostral da média"),
+ h4("Explore a convergência da distribuição amostral da média com as opções abaixo."),
+ hr(),
+ sidebarPanel(
+ radioButtons(inputId="distX",
+ label="Distribuição de X:",
+ choices=distX),
+ radioButtons(inputId="plotType",
+ label="Representação da distribuição amostral:",
+ choices=plotType)
+ ),
+ mainPanel(
+ plotOutput("distBarX", width=500, height=400)
+ )
+ ))
diff --git a/shiny/testHipFlipCoin/server.R b/shiny/testHipFlipCoin/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..3198ab425c916ca72852e671eeab1f2c74e74224
--- /dev/null
+++ b/shiny/testHipFlipCoin/server.R
@@ -0,0 +1,118 @@
+##-------------------------------------------
+## server.R
+
+require(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+rm(list=ls())
+
+## Simula o número de trocas ao lançar n vezes uma moeda equilibrada.
+moeda <- function(n){
+ sum(abs(diff(rbinom(n, 1, 0.5))))
+}
+
+## Vetor vazio.
+N <- 1000
+
+shinyServer(
+ function(input, output){
+ ## Cabeçalho IGUIR2
+ output$header <- renderPrint({
+ template("TEMA")
+ })
+
+ ## Cria valores para reagirem à estímulos dos buttons
+ v <- reactiveValues(x = integer())
+
+ ## Responde a estímulos no `input$goCara`.
+ observeEvent(input$goCara, {
+ v$x <- c(v$x, 1L)
+ })
+
+ ## Responde a estímulos no `input$goCoro`.
+ observeEvent(input$goCoro, {
+ v$x <- c(v$x, 0L)
+ })
+
+ ## Responde a estímulos no `input$goCoro`.
+ observeEvent(input$clear, {
+ v$x <- integer()
+ })
+
+ ## x começa com dois elementos. Descontá-los.
+ output$nlanc <- renderText({
+ return(length(v$x))
+ })
+
+ process <- eventReactive(input$goProcess, {
+ with(reactiveValuesToList(v), {
+ x <- x
+ ## Número de lançamentos.
+ n <- length(x)
+ ## Número de caras.
+ k <- sum(x)
+ ## Número de trocas de face.
+ o <- sum(abs(diff(x)))
+ ## Faz várias execuções do experimento aleatório.
+ r <- replicate(N, moeda(n))
+ ## P-valor bilateral empírico.
+ p <- min(c(2*min(c(sum(r<=o), sum(r>=o)))/N, 1))
+ ## Lista com todos os elementos.
+ list(n=n, k=k, o=o, r=r, p=p, x=x)
+ })
+ })
+
+ output$seqx <- renderText({
+ s <- paste0(process()$x, collapse="")
+ return(s)
+ })
+
+ output$hist <- renderPlot({
+ with(process(),{
+ if(n<=15){
+ stop("Pro favor, lance no mínimo 15 vezes.")
+ }
+ par(mar=c(5,4,3,2), family="Palatino")
+ layout(matrix(c(1,2,1,3), 2, 2))
+ bks <- seq(min(c(r,o)), max(c(r,o))+1, by=1)-0.5
+ ht <- hist(r, breaks=bks, plot=FALSE)
+ plot(ht$mids, ht$density, type="h", lwd=2,
+ ylim=c(0, 1.05*max(ht$density)),
+ xlab=sprintf("Número de trocas em %i lançamentos", n),
+ ylab="Probabilidade",
+ sub=sprintf("%i simulações", N))
+ if(input$teorico){
+ px <- dbinom(x=ht$mids, size=n-1, prob=0.5)
+ points(ht$mids+0.1, px, type="h", col="blue")
+ pb <- 2*pbinom(q=min(c(o, n-o-1)), size=n-1, p=0.5)
+ mtext(side=3, line=0, col="blue",
+ text=sprintf("P-valor bilateral teórico: %0.4f", pb))
+ }
+ abline(v=o, col=2)
+ text(x=o, y=par()$usr[4],
+ label="Estatística observada",
+ srt=90, adj=c(1.25,-0.25))
+ mtext(side=3, line=1,
+ text=sprintf("P-valor bilateral empírico: %0.4f", p))
+ mtext(side=3, line=2,
+ text=sprintf(
+ "Trocas observadas: %i\t Número de caras: %i",
+ o, k))
+ plot(cumsum(x)/seq_along(x), type="l", ylim=c(0,1),
+ ylab="Frequência de face cara",
+ xlab="Número do lançamento")
+ abline(h=0.5, lty=2)
+ plot(ecdf(r), verticals=TRUE, cex=NA,
+ main=NULL, xlim=range(bks),
+ xlab=sprintf("Número de trocas em %i lançamentos", n),
+ ylab="Probabilidade acumulada",
+ sub=sprintf("%i simulações", N))
+ abline(h=seq(0.05, 0.95, by=0.05), lty=2, col="gray50")
+ abline(v=o, col=2)
+ text(x=o, y=par()$usr[4],
+ label="Estatística observada",
+ srt=90, adj=c(1.25,-0.25))
+ })
+ })
+ })
diff --git a/shiny/testHipFlipCoin/ui.R b/shiny/testHipFlipCoin/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..2bb75159aed75f1e27c209750b928bff4be961d4
--- /dev/null
+++ b/shiny/testHipFlipCoin/ui.R
@@ -0,0 +1,39 @@
+##-------------------------------------------
+## ui.R
+
+require(shiny)
+
+txt <-
+"Você consegue criar uma sequência de caras e coroas tão aleatória e com as
+mesmas características propabilísticas de uma moeda equilibrada? Que tal
+testarmos essa hipótese?"
+
+shinyUI(
+ fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ headerPanel("Introdução aos testes de hipótese"),
+ h4("Você consegue imitar uma moeda?"),
+ p(txt),
+ hr(),
+
+ sidebarPanel(
+ helpText("Clique nos botões para declarar cara ou coroa."),
+ actionButton("goCara", "Cara"),
+ actionButton("goCoro", "Coroa"),
+ h6("Número de lançamentos feitos:"),
+ verbatimTextOutput("nlanc"),
+ actionButton("goProcess", "Aplicar teste de hipótese!"),
+ actionButton("clear", "Recomeçar"),
+ h6("Sequência das faces observadas (1=cara, 0=coroa):"),
+ verbatimTextOutput("seqx"),
+ checkboxInput(
+ "teorico", "Valores teóricos: Binomial(n-1, p=0.5)")
+ ),
+
+
+ mainPanel(
+ plotOutput("hist", width=500, height=500)
+ )
+ ))
diff --git a/shiny/transform/server.R b/shiny/transform/server.R
new file mode 100644
index 0000000000000000000000000000000000000000..274f310efc5c0bb303c58df760f0572d75ceefa2
--- /dev/null
+++ b/shiny/transform/server.R
@@ -0,0 +1,49 @@
+##-------------------------------------------
+## server.R
+
+##=============================================================================
+## Interface para exibição do gráfico de dispersão das variáveis dist e
+## speed do conjunto data(cars), aplicando transformações nas variáveis
+## e ajustando uma regressão linear simples. São abordados os seguintes
+## widgets:
+## * Listbox
+## * Checkbox
+##=============================================================================
+
+library(shiny)
+## Carrega template das aplicações elaboradas pelo projeto iguiR2
+source("../template.R")
+
+shinyServer(function(input, output) {
+ output$transformation <- renderPlot({
+ ## Variáveis utilizados na aplicação
+ x <- cars$speed
+ y <- cars$dist
+ ## Transformando as variáveis
+ x <- switch(input$tx,
+ Identidade = x,
+ Quadrado = x^2,
+ RaizQuadrada = sqrt(x),
+ Log10 = log10(x)
+ )
+ y <- switch(input$ty,
+ Identidade = y,
+ Quadrado = y^2,
+ RaizQuadrada = sqrt(y),
+ Log10 = log10(y)
+ )
+ ## Exibindo graficamente
+ plot(y ~ x, pch=20, main = "Gráfico de Dispersão",
+ xlab = paste(input$tx, "de X", sep=" "),
+ ylab = paste(input$ty, "de Y", sep=" "))
+ m0 <- lm(y ~ x)
+ r <- summary(m0)$r.squared
+ c <- round(cor(x, y), 3)
+ msg <- sprintf("R²: %0.3f \nCor: %0.3f", r, c)
+ if(input$reg){
+ abline(coef(m0), col=4)
+ mtext(text = msg, side=3, cex=0.9, col=4,
+ adj=0.05, line=-2)
+ }
+ })
+})
diff --git a/shiny/transform/ui.R b/shiny/transform/ui.R
new file mode 100644
index 0000000000000000000000000000000000000000..563c66b23938e2d7de496830d5f9b8ca9c13bd57
--- /dev/null
+++ b/shiny/transform/ui.R
@@ -0,0 +1,39 @@
+##-------------------------------------------
+## ui.R
+
+##=============================================================================
+## Interface para exibição do gráfico de dispersão das variáveis dist e
+## speed do conjunto data(cars), aplicando transformações nas variáveis
+## e ajustando uma regressão linear simples. São abordados os seguintes
+## widgets:
+## * Listbox
+## * Checkbox
+##=============================================================================
+
+library(shiny)
+
+trans <- c("Identidade", "Quadrado", "RaizQuadrada", "Log10")
+
+## Criando a Interface
+shinyUI(fluidPage(
+ ## Cabeçalho IGUIR2
+ htmlOutput("header"),
+
+ titlePanel("Transformação de Variáveis"),
+ sidebarLayout(
+ sidebarPanel(width = 4,
+ selectInput("tx", "Transformação em X", trans,
+ multiple=TRUE, selectize=FALSE,
+ selected = "Identidade"),
+ selectInput("ty", "Transformação em Y", trans,
+ multiple=TRUE, selectize=FALSE,
+ selected = "Identidade"),
+ checkboxInput(inputId="reg",
+ label="Ajuste de Regressão Linear",
+ value=FALSE)
+ ),
+ mainPanel(width = 8,
+ plotOutput("transformation")
+ )
+ )
+))