---
title: "Prototype of Results"
output:
flexdashboard::flex_dashboard:
theme: paper
source_code: embed
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE)
```
Estimates from MRP modeling {data-icon="ion-stats-bars"}
=====================================
```{r, include=FALSE}
# packages needed
library(tidyverse)
library(plotly)
library(crosstalk)
library(DT)
library(knitr)
library(flexdashboard)
# columns to create dataset
model <- c( rep("gen_eth",6), rep("gen_eth_state",18), rep("gen_eth_year", 60),
rep("gen_eth_state_year",180))
outcome <- rep(c("favor_pizza", "favor_burgers", "favor_brisket", "favor_beer",
"favor_donuts", "favor_soda", "favor_chicken", "favor_icecream"),
each=264)
gender <- rep(c("Male", "Female", rep(NA, 4)), 44)
ethnicity <- rep(c(NA, NA,"White", "Black", "Hispanic", "Other"), 44)
state <- c(rep(NA,6), rep(c("CA", "IL", "MD"), each=6), rep(NA, 60),
rep(c("CA", "IL", "MD"), each=60))
year <- c(rep(NA, 24), rep(seq(2011, 2020, 1),each=6),
rep(rep(seq(2011, 2020, 1),each=6), times= 3))
# put vectors into a dataframe
data <- data.frame(model = rep(model, length(unique(outcome))),
outcome = outcome,
gender = rep(gender, length(unique(outcome))),
ethnicity = rep(ethnicity, length(unique(outcome))),
state = rep(state, length(unique(outcome))),
year = rep(year, length(unique(outcome))),
low=NA,
median=NA,
high=NA)
# fill in the NA columns with fake data
for (i in seq_along(data$median)){
if (is.na(data$year[i])){
random_prob = rnorm(length(data$median), .50, sd=.10)
data$median[i] = median(random_prob)
data$low[i] = quantile(random_prob, probs=.05)
data$high[i] = quantile(random_prob, probs = .95)
}
else if (is.na(data$year[i])==FALSE){
some_value = as.numeric(str_sub(data$year[i], 2)) / 50
random_prob = rnorm(length(data$median), some_value, sd=.10)
data$median[i] = median(random_prob)
data$low[i] = quantile(random_prob, probs=.05)
data$high[i] = quantile(random_prob, probs = .95)
}
else{}
}
outcome_new_order <- c("favor_icecream", "favor_beer", "favor_chicken",
"favor_pizza", "favor_burgers", "favor_brisket",
"favor_donuts", "favor_soda")
# create shared data to use with crosstalk
table_create_data <- SharedData$new(
data %>%
filter(model=="gen_eth_year", !is.na(ethnicity)) %>%
mutate(Estimate = sprintf("%.3f", round(median, 3)),
Low = sprintf("%.3f", round(low, 3)),
High =sprintf("%.3f", round(high, 3)),
outcome = factor(outcome, levels=outcome_new_order)) %>%
select(ethnicity, year, outcome, Estimate, Low, High) %>%
arrange(ethnicity, match(outcome, outcome_new_order))
)
```
Column {data-width=200}
-------------------------------------
### **Filters**
##### _Select One Group To View Model Estimates_
```{r filter section}
# options for group level
filter_select(
id = "ethnicity",
label = "Ethnicity",
sharedData = table_create_data,
group = ~ethnicity,
allLevels = FALSE,
multiple = FALSE)
```
##### _Select Response(S) by Group to View Model Estimates_
```{r}
# options for outcome variables
bscols(
list(filter_checkbox(
id = "outcome",
label = "Outcome",
sharedData = table_create_data,
group = ~outcome)
))
```
##### _Select Time Frame For Response(s) by Group to View Model Estimates_
```{r}
bscols(
filter_slider("year",
"Year",
table_create_data,
"year",
dragRange=TRUE,
sep="")
)
```
Column {data-width=800}
-------------------------------------------
### Table 1: Estimates of Response For Group Selected by Time Frame with 90% Credible Intervals.
```{r fiterable_table}
datatable(table_create_data,
extensions = 'Buttons',
colnames = c('Group','Year', 'Response', 'Estimate',
'Low 90% CI',
'High 90% CI'),
options = list(
dom = 'Bfrtip',
rownames=FALSE,
buttons = list(
I("colvis"),"csv", "excel", "copy" )))
```
### Plots
```{r}
# plot data for one outcome
table_create_data %>%
plot_ly(
y=~Estimate, x=~year, color=~ethnicity,
colors = c("green","red","lightblue", "gray"),
type="scatter", mode='lines+markers') %>%
add_trace(y=~Low, type="scatter", mode="lines", name="Low Yearly Average",
fill = 'tonexty', fillcolor='rgba(0,100,80,0.01)',
line = list(color = 'transparent'),
showlegend = FALSE, name = 'Low') %>%
add_trace(y=~High, type="scatter", mode="lines", name="High Yearly Average",
fill = 'tonexty', fillcolor='rgba(0,100,80,0.2)',
line = list(color = 'transparent'),
showlegend = FALSE, name = 'High') %>%
layout(yaxis = list(yaxis = list(autorange = FALSE, range=c(0, 1))))
```