Commit 8c9cfe6d authored by Walmes Marques Zeviani's avatar Walmes Marques Zeviani
Browse files

Merge branch 'issue#7' into 'master'

Issue#7

Esse ramo traz:
  - um app com slider que muda uma sequência de gráficos feitos pelo animation;
  - um app em Rmd com exibição dos dados de alfabetismo e renda do IPEA;

See merge request !7
parents b67e1cfc 430f5a2d
This diff is collapsed.
---
runtime: shiny
output:
html_document:
css: ../palatino.css
---
```{r, include=FALSE}
##-------------------------------------------
## Definções do knitr. Não rodar.
library(knitr)
opts_chunk$set(
cache=FALSE,
tidy=FALSE,
fig.width=6,
fig.height=4.5,
fig.align="center",
dpi=100,
dev="png",
dev.args=list(png=list(family="Palatino", type="cairo")))
options(width=90)
```
****
<center>
<h1>Alfabetismo e Renda</h1>
Eduardo E. Ribeiro Jr e Walmes M. Zeviani
</center>
****
Este é um documento gerado com R MarkDown que inclui widgets/handlers do
shiny. No exemplo abaixo você pode selecionar para que Estado você
deseja ver o diagrama de dispersão de alfabetismo em função de renda.
Ao selecionar o nome de um município você pode destacá-lo no gráfico.
Dados são para o ano de 1991 e extraídos do http://ipeadata.gov.br/.
```{r, echo=FALSE, results="hide", message=FALSE, error=FALSE, warning=FALSE}
da <- read.table("./alfab15_renda_1991.csv",
header=TRUE, sep=";", dec=",", quote="",
colClasses=c("factor", "numeric", "character", "NULL")[
c(1,4,3,2,2,4)])
names(da) <- c("sig", "mun", "renda", "alf")
da <- na.omit(da)
require(lattice)
require(plyr)
xlab <- "Renda familiar per capita média (1991)"
ylab <- "Alfabetizados (%, pessoas com >=15 anos)"
```
```{r, echo=FALSE}
##-------------------------------------------
## ui.R
library(shiny)
ui1 <- shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel=sidebarPanel(
selectInput(inputId="ESTADO",
label="Estado:",
choices=levels(da$sig),
selected="PR"),
selectInput(inputId="MUN",
label="Município em destaque:",
choices=da$mun,
selected="Curitiba"),
checkboxInput(inputId="TREND",
label="Inserir linha de tendência",
value=FALSE)),
mainPanel=mainPanel(
plotOutput("PLOT")
)
)
)
)
##-------------------------------------------
## server.R
sv1 <- shinyServer(
function(input, output, session){
BASE <- reactive({
# input <- list(ESTADO="PR", MUN="Curitiba")
db <- subset(da, sig==input$ESTADO)
db$col <- 1
db$cex <- 0.8
db$pch <- 1
if (sum(input$MUN%in%db$mun)==1){
i <- db$mun==input$MUN
db$col[i] <- 2
db$cex[i] <- 1.5
db$pch[i] <- 19
}
db <- arrange(db, col, renda)
updateSelectInput(session,
inputId="MUN",
choices=sort(db$mun),
selected=tail(db$mun, 1))
return(db)
})
output$PLOT <- renderPlot({
db <- BASE()
p1 <- xyplot(alf~renda, data=db,
main=input$ESTADO,
xlab=xlab, ylab=ylab,
cex=db$cex, col=db$col, pch=db$pch)
if (input$TREND){
update(p1, type=c("p","smooth"))
} else {
p1
}
},
family="Palatino",
bg="transparent",
width=400,
height=300)
}
)
shinyApp(ui=ui1, server=sv1)
```
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 4
Encoding: UTF-8
RnwWeave: knitr
LaTeX: pdfLaTeX
iidsampler <- function(nsim, x1, plot=FALSE,
go=c("click", "console", "sleep", "none")){
out <- vector(mode="numeric", length=nsim)
## Valor para iniciar a cadeia.
out[1] <- x1
for(i in 2:nsim){
## Realização da distribuição alvo.
if(plot & go[1]=="click"){
y <- locator(n=1)$x
} else {
y <- runif(1)
}
## Cálculo da razão de aceitação.
dg1 <- dbeta(y, 2, 3)
dn1 <- dunif(y)
dg0 <- dbeta(out[i-1], 2, 3)
dn0 <- dunif(out[i-1])
ratio <- (dg1/dg0)/(dn1/dn0)
u <- runif(1)
if(u<ratio){
## Se sim, cadeia ganha novo valor.
out[i] <- y
} else {
## Se não, cadeia recebe o último.
out[i] <- out[i-1]
}
## Parte de representação gráfica do método.
if(plot & nsim<=20){
par(mfrow=c(1,2))
## Curvas.
curve(dbeta(x, 2, 3), 0, 1, xlim=c(0, 1),
ylab="Densidade");
curve(dunif(x), add=TRUE, lty=2);
title(sub=substitute(i==k, env=list(k=i)))
## Lengendas.
legend("topright",
legend=c(expression(f[X]*" ~ Beta"),
expression(f[Y]*" ~ Unif")),
lty=c(1,2), bty="n")
legend("right",
legend=c(expression("Candidato em"*~i),
expression("Valor em"*~i-1)),
lty=1, col=c(2,4), bty="n")
## Segmentos da base até os valores nas funções.
segments(y, dg1, y, 0, col=2, lty=1);
segments(y, dn1, y, 0, col=2, lty=1);
segments(out[i-1], dg0, out[i-1], 0, col=4, lty=1);
segments(out[i-1], dn0, out[i-1], 0, col=4, lty=1);
## Pontos sobre as funções.
cex <- 2.5; col="yellow"
points(y, dg1, pch=19, cex=cex, col="green");
points(y, dn1, pch=19, cex=cex, col=col);
points(out[i-1], dg0, pch=19, cex=cex, col="green");
points(out[i-1], dn0, pch=19, cex=cex, col=col);
## Rótulos dos pontos.
text(y, dg1, labels=expression(f[X]));
text(y, dn1, labels=expression(f[Y]));
text(out[i-1], dg0, expression(f[X]));
text(out[i-1], dn0, expression(f[Y]));
text(c(y, out[i-1]), 0,
labels=c(expression(y[i]), expression(x[i-1])),
pos=4)
## Anotações matemáticas.
L <- list(dg1=dg1, dg0=dg0, dn1=dn1,
dn0=dn0, num=dg1/dg0, den=dn1/dn0,
ratio=ratio)
L <- lapply(L, round, digits=3)
ex <- substitute(frac(f[X](y[i]), f[X](x[i-1]))/
frac(f[Y](y[i]), f[Y](x[i-1]))*" = "*
frac(dg1, dg0)/frac(dn1, dn0)*" = "*
num/den==ratio, L)
r <- substitute("u = "~u<ratio,
lapply(list(ratio=ratio, u=u),
round, digits=3))
mtext(ex, side=3, line=1, adj=0)
mtext(r, side=3, line=2, adj=1)
mtext(ifelse(u<ratio,
expression(Aceita~y[i]~como~x[i]),
expression(Repete~x[i-1]~como~x[i])),
side=3, line=1, adj=1)
plot(out[1:i], xlim=c(0, nsim+1), ylim=c(0,1), type="o")
switch(go[1],
## Avança por cliques do mouse.
click=locator(n=1),
## Avança por enter no console.
console=readline(
prompt="Press [enter] to continue: "),
## Avança com intervalo de tempo entre etapas.
sleep=Sys.sleep(0.5),
none=NULL)
}
}
return(out)
}
library(animation)
# iidsampler(n=20, x1=runif(1), plot=TRUE, go="none")
# iidsampler(n=20, x1=runif(1), plot=TRUE, go="sleep")
saveHTML(iidsampler(n=20, x1=runif(1), plot=TRUE, go="none"),
img.name="iidsampler",
imgdir="iidsampler",
interval=0.5,
htmlfile="iidsampler.html",
ani.width=800, ani.height=400,
verbose=FALSE,
autoplay=TRUE,
autobrowse=FALSE)
# saveGIF(iidsampler(n=20, x1=runif(1), plot=TRUE, go="none"),
# img.name="iidsampler",
# # imgdir="www",
# interval=0.5,
# movie.name="iidsampler.gif",
# ani.width=500, ani.height=300,
# verbose=FALSE, autobrowse=FALSE)
# file.copy(from="iidsampler.gif" , to="www/", overwrite=TRUE)
# file.remove("iidsampler.gif")
if (!dir.exists("www")){ dir.create(path="www") }
file.copy(from=sprintf("iidsampler/%s", list.files("iidsampler")),
to="www/", overwrite=TRUE)
##----------------------------------------------------------------------
library(shiny)
shinyServer(
function(input, output) {
output$GIF <- renderUI({
HTML(sprintf("<img src='iidsampler%d.png'>",
input$NUMBER))
})
})
library(shiny)
n <- length(list.files("www", pattern="\\.png$"))
shinyUI(
fluidPage(
titlePanel("Amostrador independente"),
sidebarLayout(
sidebarPanel(
sliderInput(inputId="NUMBER",
label="Deslize:",
min=1, max=n, step=1, value=1,
animate=list(interval=1000))
),
mainPanel(
uiOutput("GIF")
)
)
))
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