diff --git a/shiny/distProb/server.R b/shiny/distProb/server.R
index 27e24c2d348d0e0b240be493bc2a97f3e5f65955..5e7dfbba0b1614c8a42bd40134b4985b07032a84 100644
--- a/shiny/distProb/server.R
+++ b/shiny/distProb/server.R
@@ -1,7 +1,27 @@
-##-------------------------------------------
-## server.R
-
require(shiny)
+
+densityView <- function(m, s, sample){
+ curve(dnorm(x, mean=m, sd=s),
+ from=m-4*s, to=m+4*s)
+ abline(v=m, lty=1, col=2)
+ lines(density(sample), col=2)
+}
+
+ecdfView <- function(m, s, sample){
+ curve(pnorm(x, mean=m, sd=s),
+ from=m-4*s, to=m+4*s)
+ abline(v=m, lty=1, col=2)
+ lines(ecdf(sample), col=2)
+}
+
+qqView <- function(sample){
+ qqnorm(sample)
+ qqline(sample)
+}
+
+## Quantidade de amostras de y.
+N <- 500
+
## Carrega template das aplicações elaboradas pelo projeto iguiR2
source("../template.R")
@@ -12,20 +32,48 @@ shinyServer(
template("TEMA")
})
output$ui <- renderUI({
- if(is.null(input$dist)){
- return()}
+ if (is.null(input$dist)){
+ return(NULL)
+ }
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)")
})
+ SAMPLER <- reactive({
+ popMean <- input$poissonLambda
+ popSd <- sqrt(input$poissonLambda)
+ meanSd <- popSd/sqrt(input$n)
+ sampleMean <-
+ replicate(
+ N,
+ mean(rpois(
+ input$n,
+ lambda=input$poissonLambda)))
+ return(list(
+ m=popMean,
+ s=meanSd,
+ sample=sampleMean))
+ })
+ output$density <- renderPlot({
+ with(SAMPLER(),
+ densityView(m=m, s=s, sample=sample))
+ })
+ output$ecdf <- renderPlot({
+ with(SAMPLER(),
+ ecdfView(m=m, s=s, sample=sample))
+ })
+ output$qqnorm <- renderPlot({
+ qqView(sample=SAMPLER()$sample)
+ })
wellPanel(
sliderInput(inputId="poissonLambda",
label="Média da Poisson",
min=0.1, max=20, value=10)
- )
+ )
},
"binomial"={
@@ -33,7 +81,37 @@ shinyServer(
x <- 0:input$binomialSize
px <- dbinom(x, size=input$binomialSize,
prob=input$binomialProb)
- plot(x, px, type="h", xlab="x", ylab="Pr(x)")
+ plot(x, px, type="h",
+ xlab="x", ylab="Pr(x)")
+ })
+ SAMPLER <- reactive({
+ popMean <-
+ input$binomialSize*input$binomialProb
+ popSd <-
+ sqrt(popMean*(1-input$binomialProb))
+ meanSd <- popSd/sqrt(input$n)
+ sampleMean <-
+ replicate(
+ N,
+ mean(rbinom(
+ input$n,
+ size=input$binomialSize,
+ prob=input$binomialProb)))
+ return(list(
+ m=popMean,
+ s=meanSd,
+ sample=sampleMean))
+ })
+ output$density <- renderPlot({
+ with(SAMPLER(),
+ densityView(m=m, s=s, sample=sample))
+ })
+ output$ecdf <- renderPlot({
+ with(SAMPLER(),
+ ecdfView(m=m, s=s, sample=sample))
+ })
+ output$qqnorm <- renderPlot({
+ qqView(sample=SAMPLER()$sample)
})
wellPanel(
sliderInput(inputId="binomialSize",
@@ -43,10 +121,9 @@ shinyServer(
label="Probabilidade de sucesso",
min=0.02, max=0.98,
value=0.5, step=0.02)
-
)
},
-
+
"beta"={
output$plot <- renderPlot({
curve(dbeta(x,
@@ -55,31 +132,99 @@ shinyServer(
from=0, to=1,
xlab="x", ylab="f(x)")
})
+ SAMPLER <- reactive({
+ popMean <-
+ input$betaShape1/
+ (input$betaShape1+input$betaShape2)
+ popSd <- sqrt(
+ input$betaShape1*input$betaShape2/(
+ (input$betaShape1+
+ input$betaShape2+1)*
+ (input$betaShape1+
+ input$betaShape2)**2
+ )
+ )
+ meanSd <- popSd/sqrt(input$n)
+ sampleMean <-
+ replicate(
+ N,
+ mean(rbeta(
+ input$n,
+ shape1=input$betaShape1,
+ shape2=input$betaShape2)))
+ return(list(
+ m=popMean,
+ s=meanSd,
+ sample=sampleMean))
+ })
+ output$density <- renderPlot({
+ with(SAMPLER(),
+ densityView(m=m, s=s, sample=sample))
+ })
+ output$ecdf <- renderPlot({
+ with(SAMPLER(),
+ ecdfView(m=m, s=s, sample=sample))
+ })
+ output$qqnorm <- renderPlot({
+ qqView(sample=SAMPLER()$sample)
+ })
wellPanel(
sliderInput(inputId="betaShape1",
label="Parâmetro de forma 1",
- min=0.01, max=7, value=1, step=0.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)
+ min=0.01, max=7, value=1,
+ step=0.1)
)
},
"gamma"={
output$plot <- renderPlot({
curve(dgamma(x,
- shape=input$gammaShape,
- rate=input$gammaRate),
+ shape=input$gammaShape,
+ rate=input$gammaRate),
from=0, to=20,
xlab="x", ylab="f(x)")
})
+ SAMPLER <- reactive({
+ popMean <- input$gammaShape/input$gammaRate
+ popSd <- sqrt(
+ input$gammaShape/(input$gammaRate**2))
+ meanSd <- popSd/sqrt(input$n)
+ sampleMean <-
+ replicate(
+ N,
+ mean(rgamma(
+ input$n,
+ shape=input$gammaShape,
+ rate=input$gammaRate)))
+ return(list(
+ m=popMean,
+ s=meanSd,
+ sample=sampleMean))
+ })
+ output$density <- renderPlot({
+ with(SAMPLER(),
+ densityView(m=m, s=s, sample=sample))
+ })
+ output$ecdf <- renderPlot({
+ with(SAMPLER(),
+ ecdfView(m=m, s=s, sample=sample))
+ })
+ output$qqnorm <- renderPlot({
+ qqView(sample=SAMPLER()$sample)
+ })
wellPanel(
sliderInput(inputId="gammaShape",
label="Parâmetro de forma",
- min=0.01, max=7, value=1, step=0.1),
+ 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)
+ min=0.01, max=7, value=1,
+ step=0.1)
)
},
@@ -91,15 +236,45 @@ shinyServer(
from=-3, to=3,
xlab="x", ylab="f(x)")
})
+ SAMPLER <- reactive({
+ popMean <- input$normalMean
+ popSd <- input$normalSd
+ meanSd <- popSd/sqrt(input$n)
+ sampleMean <-
+ replicate(
+ N,
+ mean(rnorm(
+ input$n,
+ mean=input$normalMean,
+ sd=input$normalSd)))
+ return(list(
+ m=popMean,
+ s=meanSd,
+ sample=sampleMean))
+ })
+ output$density <- renderPlot({
+ with(SAMPLER(),
+ densityView(m=m, s=s, sample=sample))
+ })
+ output$ecdf <- renderPlot({
+ with(SAMPLER(),
+ ecdfView(m=m, s=s, sample=sample))
+ })
+ output$qqnorm <- renderPlot({
+ qqView(sample=SAMPLER()$sample)
+ })
wellPanel(
sliderInput(inputId="normalMean",
label="Média da normal",
- min=-3, max=3, value=0, step=0.05),
+ 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)
- )
+ min=0.1, max=3, value=1,
+ step=0.05)
+ )
}
- )
- })
- })
+
+ ) ## switch()
+ }) ## renderUI
+ }) ## shinyServer()
diff --git a/shiny/distProb/ui.R b/shiny/distProb/ui.R
index fcdabb6f3141404cb478be7975e1bd38bb88cc40..c20a026691ecdde8ba38df442bcf3554da862544 100644
--- a/shiny/distProb/ui.R
+++ b/shiny/distProb/ui.R
@@ -1,6 +1,3 @@
-##-------------------------------------------
-## ui.R
-
require(shiny)
choi <- c("Poisson"="poisson",
@@ -16,13 +13,19 @@ shinyUI(
titlePanel("Distribuições de probabilidade"),
sidebarPanel(
+ numericInput(inputId="n",
+ label="Tamanho da amostra:",
+ value=10),
selectInput(inputId="dist",
label="Distribuição",
choices=choi),
uiOutput("ui")
),
mainPanel(
- plotOutput("plot")
+ plotOutput("plot"),
+ plotOutput("density"),
+ plotOutput("ecdf"),
+ plotOutput("qqnorm")
)
)
)
\ No newline at end of file