From 658b1a30cf6d3f1bc786d5bf2d7d94a89cc71a41 Mon Sep 17 00:00:00 2001
From: Shravani Samala <54723328+shravanisamala@users.noreply.github.com>
Date: Wed, 14 Jul 2021 21:09:46 -0400
Subject: [PATCH 01/21] Trying to compile into one file
---
server.R => Xserver.R | 0
ui.R => Xui.R | 0
app.R | 2195 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 2195 insertions(+)
rename server.R => Xserver.R (100%)
mode change 100755 => 100644
rename ui.R => Xui.R (100%)
mode change 100755 => 100644
create mode 100644 app.R
diff --git a/server.R b/Xserver.R
old mode 100755
new mode 100644
similarity index 100%
rename from server.R
rename to Xserver.R
diff --git a/ui.R b/Xui.R
old mode 100755
new mode 100644
similarity index 100%
rename from ui.R
rename to Xui.R
diff --git a/app.R b/app.R
new file mode 100644
index 0000000..80b90f3
--- /dev/null
+++ b/app.R
@@ -0,0 +1,2195 @@
+library(shiny)
+library(shinydashboard)
+library(shinyBS)
+library(shinyjs)
+library(shinyWidgets)
+library(plotly)
+library(ggplot2)
+library(shinyAce)
+library(shinycssloaders)
+library(rlocker)
+library(ggmap)
+library(boastUtils)
+library(DT)
+library(dplyr)
+library(mosaic)
+library(plot3D)
+library(plotly)
+library(datasets)
+library(learnr)
+library(knitr)
+library(rmarkdown)
+library(shinyAce)
+library(rlocker)
+library(ggmap)
+
+source("helpers.R")
+
+bank <- read.csv("questionbank.csv")
+bank = data.frame(lapply(bank, as.character), stringsAsFactors = FALSE)
+
+ui <- list(
+ dashboardPage(skin = "green",
+ header = dashboardHeader(title = 'Data Visualization',
+ tags$li(class = "dropdown", actionLink("info", icon("info"), class = "myClass")),
+ tags$li(class = "dropdown",tags$a(href = "https://shinyapps.science.psu.edu/",
+ icon("home")))
+ ),
+
+ sidebar = dashboardSidebar(
+ width = 250,
+ sidebarMenu(id = 'tabs',
+ menuItem('Overview', tabName = 'overview', icon = icon("dashboard")),
+ menuItem('Simple Data Visualization', tabName = 'VisualOne',
+ icon = icon('wpexplorer')),
+ menuItem('Advanced Data Visualization', tabName = 'exp4', icon = icon('wpexplorer')),
+ menuItem('References', tabName = "References", icon = icon("leanpub"))
+ ),
+ #PSU logo
+ tags$div(class = "sidebar-logo",
+ boastUtils::psu_eberly_logo("reversed"))
+ ),
+
+ body = dashboardBody(
+ tags$head(
+ tags$link(rel = "stylesheet", type = "text/css", href = "https://educationshinyappteam.github.io/Style_Guide/theme/boast.css")
+ ),
+ tags$style(type = "text/css", ".content-wrapper,.right-side {background-color: white;}"),
+
+ useShinyjs(),
+ tabItems(
+ tabItem(tabName = 'overview',
+ h1('Data Visualization App'),
+ br(),
+ h2(strong('About:')),
+ p('This app illustrates R code for data visualization.'),
+ br(),
+
+ h2(strong('Instructions:')),
+ p(tags$li("Simple data visualization section introduces
+ how to create some commonly used plots with ggplot and Rplot with exercises at the end.")),
+ p(tags$li("Advanced Data Visualization section
+ introduces 3D plots, line plots, contour plots, and heat maps.")),
+ br(),
+ div(style = 'text-align: center',
+ bsButton(inputId = 'go2', label = 'Explore',
+ icon = icon('bolt'), size = 'large', class='circle grow')),
+ br(),
+ h2(strong('Acknowledgements:')),
+ p('This application was coded and developed by Anna (Yinqi) Zhang in 2018 and Yiyun Gong in 2019.
+ Special Thanks to Grace (Yubaihe) Zhou for being incredibly helpful with programming issues.
+ It was updated for formatting by Ethan Wright 2020'),
+ div(class = "updated", "Last Update: 9/4/2020 by EJW.")
+ ),
+
+ ############ Data Visualization Introduction #######
+ ######Characterizing one single Variable######
+
+ tabItem(tabName = 'VisualOne',
+ # div(style="display: inline-block;vertical-align:top;",
+ # tags$a(href='https://shinyapps.science.psu.edu/',tags$img(src='homebut.PNG', width = 19))
+ # ),
+ # div(style="display: inline-block;vertical-align:top;",
+ # circleButton("info0",icon = icon("info"), status = "myClass",size = "xs")
+ # ),
+
+ tabsetPanel(type = 'tabs',
+ ###### One Variable ######
+ tabPanel('Single Variable',
+ h1(strong('One Variable Visualization')),
+ # br(),
+ p('This section illustrates R code for data
+ visulization includes plot() and ggplot() with one Variable'),
+
+ br(),
+ sidebarLayout(
+ sidebarPanel(
+ id="sidebar",
+ tags$head(tags$style(
+ HTML('#sidebar{
+ background-color: #FFFFFF;
+ }')
+ )),
+
+ checkboxInput("previewData", "Preview of Datasets"),
+
+ ####select between plot and ggplot
+ selectInput(inputId="plotType", label="Select Plot Package",
+ choices = c('plot', 'ggplot'),
+ selected = 'plot'),
+
+ ####select datasets
+ selectInput(inputId="dataset", label="Select Dataset:",
+ choices= c('cars', 'trees'),
+ selected = 'cars'),
+
+ ####variable options for 'car' dataset
+ conditionalPanel(
+ condition = "input.dataset == 'cars'",
+ selectInput(inputId="carsVariable", label="Select Variables",
+ choices = c("speed", "dist"),
+ selected = 'speed')
+ ),
+
+ ####variable option for 'trees' dataset
+ conditionalPanel(
+ condition = "input.dataset == 'trees'",
+ selectInput(inputId="treesVariable", label="Select Variables",
+ choices = c("Girth", "Height", "Volume"),
+ selected = 'Girth')
+ )
+ #tags$img(src="DataView.pdf")
+ #includeHTML("ViewData.nb.html")
+ #tags$a(tags$img(src="pdficon.png"), href="DataView.pdf", download="Viewdata.pdf")
+ # br(),
+ #downloadLink("downloadData", "Preview of Data"),
+
+ ),
+
+ mainPanel(
+ conditionalPanel(
+ condition="input.previewData==1",
+
+ fluidRow(
+ column(2, p(strong("Dataset"))),
+ column(4, DT::dataTableOutput("dataTable")),
+
+ )
+ ),
+ fluidRow(
+ column(6,plotOutput(outputId="oneDensity", width="100%",height="300px")%>% withSpinner(color="#FFFFFF")),
+ column(6,plotOutput(outputId="onehist", width="100%",height="300px")%>% withSpinner(color="#FFFFFF"))
+ ),
+ fluidRow(
+ column(width = 6, textOutput(outputId="DensityoneCode")),
+ column(width = 6, textOutput(outputId="HistogramoneCode"))
+ ),
+ br(),
+ br(),
+ br(),
+ br(),
+ tags$head(tags$style("#qqCode, #BarCode, #DensityoneCode, #HistogramoneCode,
+ #twoscattercode, #logTransformationCode, #twobarcode, #twoboxcode
+ {color: #FFFFFF}"
+ )),
+
+
+ fluidRow(
+ column(6,plotOutput(outputId="onebar", width="100%",height="300px")%>% withSpinner(color="#1E7B14")),
+ column(6,plotOutput(outputId="oneqq", width="100%",height="300px")%>% withSpinner(color="#1E7B14"))
+ ),
+ fluidRow(
+ column(width = 6, textOutput(outputId="BarCode")),
+ column(width = 6, textOutput(outputId="qqCode"))
+ ),
+ br(),
+ br()
+ # div(style = 'text-align: center',
+ # bsButton(inputId = 'next2', label = 'Next Section',
+ # icon = icon('angle-double-right'), size = 'small',
+ # class='circle grow'))
+ )
+ )
+ ),
+
+ ###### Two Variable ######
+ tabPanel(title='Two Variables', value='panel2',
+ h3(strong('Two Variables Visualization')),
+ # br(),
+ h4('This section illustrates R code for data
+ visulization uses ggplot() with Two Variables'),
+
+ br(),
+ sidebarLayout(
+ sidebarPanel(
+ id="sidebar",
+ tags$head(tags$style(
+ HTML('#sidebar{
+ background-color: #FFFFFF;
+ }')
+ )),
+ ####select continuous variable 1
+ checkboxInput("previewDataTwo", "Preview of Datasets"),
+ selectInput(inputId="continuous1",
+ label="Select First Continuous Variable as X:",
+ choices= c('Sepal.Length',
+ 'Sepal.Width'),
+ selected = 'Sepal.Length'),
+
+ selectInput(inputId="continuous2",
+ label="Select Second Continuous Variable as Y:",
+ choices= c('Petal.Length',
+ 'Petal.Width'),
+ selected = 'Petal.Length'),
+
+ selectInput(inputId="CategoryVar",
+ label="Select Categorical Variable:",
+ choices= 'Species',
+ selected = 'Species'),
+
+ ),
+
+ mainPanel(
+ conditionalPanel(
+ condition="input.previewDataTwo==1",
+ fluidRow(
+ column(2, p(strong("Dataset iris"))),
+ column(5, dataTableOutput("Previewiris"))
+ )
+ #tableOutput("Previewiris")
+ #p("First four rows of dataset iris")
+ ),
+ fluidRow(
+ column(6,plotOutput(outputId="twoscatter")%>% withSpinner(color="#FFFFFF")),
+ column(6,plotOutput(outputId="logTransformation")%>% withSpinner(color="#FFFFFF"))
+ ),
+ br(),
+ fluidRow(
+ column(6,textOutput(outputId="twoscattercode")),
+ column(6,textOutput(outputId="logTransformationCode"))
+ ),
+ br(),
+ fluidRow(
+ column(6,plotOutput(outputId="twobar")%>% withSpinner(color="#FFFFFF")),
+ column(6,plotOutput(outputId="twobox")%>% withSpinner(color="#FFFFFF"))
+ ),
+ br(),
+ fluidRow(
+ column(6,textOutput(outputId="twobarcode")),
+ column(6,textOutput(outputId="twoboxcode"))
+ )
+ )
+ )
+ ),
+
+ tabPanel(title='Exercises', value='panel2',
+ #uiOutput("urltest"))
+ #includeMarkdown("test.Rmd")
+ #system.file("knitr", package="shinyAce")
+
+ fluidRow(
+ column(6,
+ verticalLayout(
+ h2("Instructions"),
+ wellPanel(
+ style = "background-color: #FFFFFF",
+ tags$div(tags$ul(
+ tags$li("You can try the following questions"),
+ tags$li("Test your code with the following R script
+ box with the RMarkDown output under the 'Knitted Output' header"),
+ tags$li("In each turn, 10 questions will be randomly draw from the question bank."),
+ tags$li("Uncomment the sample code to start to explore.")
+ ),
+ style = "background-color: #FFFFFF")),
+ h2("Exercises"),
+ uiOutput('progress'),
+ wellPanel(style = "background-color: #FFFFFF",
+ uiOutput("question")%>% withSpinner(color="#FFFFFF"),
+ uiOutput("options"),
+ br(),
+ selectInput("answer", "Select your answer from below", c("","A", "B", "C")),
+ uiOutput("mark"),
+ tags$style(type='text/css', '#question{font-size: 15px;
+ background-color: #FFFFFF;color: black;}',
+ '.well { padding: 10px; margin-bottom: 15px; max-width: 1000px; }')
+
+ ),
+ fluidPage(
+ tags$head(
+ #tags$style(HTML('#submit{background-color:#FFFFFF; color:white}')),
+ #tags$style(HTML('#eval{background-color:#FFFFFF; color:white}')),
+ #tags$style(HTML('#nextq{background-color:#FFFFFF; color:white}'))
+ ),
+ fluidRow(
+ column(12, align="center",
+ div(style="display: inline-block", actionButton(inputId = 'submit', label = 'Submit', disabled = TRUE, style="success")),
+ div(style="display: inline-block;vertical-align:top; width: 30px;",HTML("
")),
+ div(style="display: inline-block", bsButton(inputId = "nextq",label = "Next", disabled = TRUE)),
+ div(style="display: inline-block;vertical-align:top; width: 30px;",HTML("
")),
+ div(style="display: inline-block", bsButton(inputId = "reset",label = "Restart", style="danger", disabled = TRUE)))
+ )),
+
+
+ # column(3,
+ # actionButton(inputId = 'submit', label = 'Submit', style="success")
+ # ),
+ # column(3,
+ # bsButton(inputId = "nextq",label = "Next", style='warning', disabled = TRUE)
+ # ),
+ # column(3,
+ # bsButton(inputId = "reset",label = "Restart", style="danger", )
+ # )),
+ br(),
+
+ ##########try rlocker statement#########
+ # tags$samp(
+ # htmlOutput("statements")
+ # ),
+ ##########end#############
+
+ h2("Try Your Code"),
+ aceEditor("rmd", mode="markdown", value='This is some markdown text. It may also have embedded R code
+which will be executed. Please also read the output
+message for more hints.
+
+you can add a new code chuck with following two lines
+```{r}
+```
+```{r}
+#structure on datasets we used in previous cases
+str(cars)
+str(trees)
+str(iris)
+```
+It can even include graphical elements.
+```{r}
+#ggplot with one variable
+#ggplot(aes(x=dist), data=cars)+geom_histogram()
+```
+```{r}
+#ggplot with two variable
+#ggplot(aes(x=Sepal.Length, y=Petal.Length), data=iris)+
+#geom_line()
+```
+```{r}
+#Rplot with one variable
+plot(cars$speed)
+```
+'),
+column(6,
+ withBusyIndicatorUI(
+ actionButton("eval", "Run")))
+ )),
+br(),
+column(6,
+ h2("Knitted Output"),
+ htmlOutput("knitDoc")
+)
+ )
+ )
+ )
+ ),
+######Advanced
+tabItem(tabName = 'exp4',
+ tabsetPanel(type = 'tabs',
+
+ ###### Maps ######
+ tabPanel('Maps',
+ br(),
+ box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+
+ selectInput(inputId = 'mapsOp', label = 'Make a US/World Map with ggplot2',
+ choices = c('US Map - ggplot2', 'US Map - plotly'), selected = 'US Map'),
+ bsPopover(id = 'mapsOp', title = " ", content = 'mUSMap takes in one dataframe that includes information about different
+ US states and returns this data or a ggplot object constructed with the data. mWorldMap does the same but it
+ takes in one dataframe that includes information about different countries.', trigger = 'click'),
+
+ # conditionalPanel('input.mapsOp == "World Map"',
+ # sliderInput(inputId = 'worldMap1', label = 'The Number of Color Scales', min = 1, max = 10,
+ # value = 5, step = 1, ticks = TRUE)
+ # ),
+
+ conditionalPanel('input.mapsOp == "US Map - ggplot2"',
+ selectInput(inputId = 'usMap1', label = 'Plot Option', choices = c('borders', 'frame')),
+ selectInput(inputId = 'usMap2', label = 'Style Option', choices = c('compact', 'real'))
+ )
+
+ ),
+
+ # box(title = NULL, style = 'background-color: #f0f4c3', width=NULL, height = NULL,
+
+ conditionalPanel('input.mapsOp == "US Map - ggplot2"',
+ div(style = "background-color: #FFFFFF",
+ tags$strong('R code: '),
+ uiOutput('usMapOut2'),
+ br(),
+ fluidRow(
+ column(12, align="center",
+ plotOutput('usMapOut1', width="80%")
+ )
+ ),
+ br()
+
+ )),
+
+ conditionalPanel('input.mapsOp == "US Map - plotly"',
+ div(style = "background-color: #FFFFFF",
+ tags$strong('R code: '),
+ uiOutput('plotlyUScode'),
+ br(),
+ fluidRow(
+ column(12, align="center",
+ plotlyOutput('plotlyUSMap', width='80%'))
+ ),
+ br()
+
+ ))
+ # )
+ ),
+
+ ###### 3D Plots ######
+ tabPanel('3D Plots',
+ br(),
+ fluidRow(
+ column(width = 12,
+ box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+ selectInput(inputId = 'Exsel', label = '3D Plot Type',
+ choices = c('Normal Simulation via Plotly', '3D Basic Scatter Plot', '3D Texts Plot'),
+ # choices = c('Normal Simulation via Plotly', 'Basic Scatter Plot', 'Basic Scatter Plot Colored by Groups',
+ # '3D Plots with Confidence Intervals', '3D Texts Plot'),
+ selected = 'Normal Simulation via Plotly', multiple = FALSE),
+
+ # bsPopover(id = 'Exsel', title = 'Understand the Graph Type',
+ # content = 'Mesh plot generates a wireframe plot while the scatter plot generates a dotted plot.',
+ # placement = 'bottom', trigger = 'hover'),
+
+ #a. Normal Simulation via Plotly
+ conditionalPanel('input.Exsel == "Normal Simulation via Plotly"',
+ sliderInput(inputId = 'Exsel1', label = 'Please Select Your Sample Size', min = 0, max = 100,
+ value = 30, step = 1, ticks = TRUE)
+ ),
+
+ #b. Basic Scatter Plot
+ conditionalPanel('input.Exsel == "3D Basic Scatter Plot"',
+ selectInput(inputId = 'basicX', label = 'Variable for X-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
+ selected = 'Sepal.Length', multiple = FALSE),
+ selectInput(inputId = 'basicY', label = 'Variable for Y-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
+ selected = 'Sepal.Width', multiple = FALSE),
+ selectInput(inputId = 'basicZ', label = 'Variable for Z-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
+ selected = 'Petal.Length', multiple = FALSE)
+ ),
+ #c.
+ #d. 3D Plots with Confidence Intervals
+ conditionalPanel('input.Exsel == "3D Plots with Confidence Intervals"',
+ selectInput(inputId = 'CIX', label = 'Variable for X-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
+ selected = 'Sepal.Length', multiple = FALSE),
+ selectInput(inputId = 'CIY', label = 'Variable for Y-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
+ selected = 'Sepal.Width', multiple = FALSE),
+ selectInput(inputId = 'CIZ', label = 'Variable for Z-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
+ selected = 'Petal.Length', multiple = FALSE)
+ )
+ )
+ )
+ ),
+ fluidRow(
+ column(width = 12,
+ box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+
+ #a. Normal Simulation via Plotly
+ conditionalPanel('input.Exsel == "Normal Simulation via Plotly"',
+ tags$strong('R code: '),
+ uiOutput('ExCode'),
+ br(),
+ plotlyOutput('plotly1'),
+ br(),
+ verbatimTextOutput("hover"),
+ verbatimTextOutput("click")
+ ),
+
+ #b. Basic Scatter Plot
+ conditionalPanel('input.Exsel == "3D Basic Scatter Plot"',
+ tags$strong('R code: '),
+ uiOutput('basicRcode'),
+ br(),
+ tableOutput('bspTable'),
+ plotOutput('bspOut1')
+ ),
+
+ # #c. Basic Scatter Plot Colored by Groups
+ # conditionalPanel('input.Exsel == "Basic Scatter Plot Colored by Groups"',
+ # tableOutput('bspTableCopy'),
+ # plotOutput('bspOut2')
+ # ),
+
+ # #d. 3D Plots with Confidence Intervals
+ # conditionalPanel('input.Exsel == "3D Plots with Confidence Intervals"',
+ # plotOutput('CIOut')
+ # ),
+
+ #e. 3D Texts Plot
+ conditionalPanel('input.Exsel == "3D Texts Plot"',
+ tags$strong('R code: '),
+ uiOutput('textRcode'),
+ br(),
+ tableOutput('textTable'),
+ plotOutput('textOut')
+ )
+
+ )
+ )
+ )
+ ),
+
+ ###### 2D Line Plots ######
+ tabPanel('2D Line Plots',
+ br(),
+ fluidRow(
+ column(width = 12,
+ box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+
+ sliderInput(inputId = 'LPsel1', label = 'Please Set the Maximum of X-Axis', min = 0, max = 200,
+ value = 80, step = 1, ticks = TRUE),
+
+ numericInput(inputId = 'LPnum1', label = 'Theoretical Mean of trace 0',
+ value = 10, step = 1),
+ selectInput(inputId = 'LPSEL1', label = 'Please Select Your First Graph Mode',
+ choices = c('Lines', 'Markers')),
+ numericInput(inputId = 'LPnum2', label = 'Theoretical Mean of trace 1',
+ value = -10, step = 1),
+ selectInput(inputId = 'LPSEL2', label = 'Please Select Your Second Graph Mode',
+ choices = c('Lines', 'Markers'))
+ )
+ )
+ ),
+ fluidRow(
+ column(width = 12,
+ box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+ tags$strong('R code: '),
+ uiOutput('LPCode'),
+ br(),
+ plotlyOutput('plotly2')
+ )
+ )
+ )
+ ),
+
+ ###### Contour Plots & Heat Maps ######
+ tabPanel('Contour Plots & Heatmaps',
+ br(),
+ sidebarLayout(
+ sidebarPanel(
+ tags$head(tags$style(
+ HTML('#sidebarmap{
+ background-color: #FFFFFF;
+ }')
+ )),
+ #box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+ id="sidebarmap",
+ div('Heat maps and contour plots are visualization techniques to show
+ data density on a map. They are particularly helpful when you have
+ a lot of data points on the map and are mainly interested in their
+ overall distribution.'),
+ br(),
+ selectInput(inputId = 'chSel', label = 'Please Select Your Display Option', choices = c('', 'Contour Plots', 'Heatmaps'), selected = 'Contour Plots'),
+
+ #contour plots
+ conditionalPanel('input.chSel == "Contour Plots"',
+ selectInput(inputId = 'chSel2', label = 'View An Example', choices = c('Volcano', 'Protein-Protein Interaction')),
+ conditionalPanel('input.chSel2 == "Volcano"',
+ checkboxInput(inputId = 'contourLabel', label = 'Add Contour Labels', value = FALSE)
+ )
+ ),
+
+ #heat maps
+ conditionalPanel('input.chSel == "Heatmaps"',
+ selectInput(inputId = 'heat1', label = 'View An Example', choices = c('Volcano', 'Cars')),
+ conditionalPanel('input.heat1 == "Volcano"',
+ sliderTextInput(inputId = 'heatmapCol', label = 'Please Select Your Colorscale',
+ choices = c('purple+green', 'yellow+red', 'pink+purple', 'white+black'), grid = TRUE)
+ )
+ )
+ #)
+ ),
+
+ mainPanel(
+ box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
+ conditionalPanel('input.chSel == "Contour Plots"',
+ conditionalPanel('input.chSel2 == "Volcano"',
+ tags$b('In this section, we will use an embedded dataset named Volcano. It is a matrix containing 87 rows and 61 columns.'),
+ br(),
+ br(),
+ tags$strong('R Code: '),
+ uiOutput('CPCode1'), #volcano code
+ br(),
+ plotlyOutput('plotly3') #volcano plot
+ ),
+ conditionalPanel('input.chSel2 == "Protein-Protein Interaction"',
+ plotOutput('proteinInt')
+ )
+
+ ),
+
+ conditionalPanel('input.chSel == "Heatmaps"',
+ conditionalPanel('input.heat1 == "Volcano"',
+ tags$strong('R Code: '),
+ uiOutput('CPCode2'),
+ br(),
+ plotlyOutput('plotly4')
+ ),
+ conditionalPanel('input.heat1 == "Cars"',
+ plotlyOutput('cars1')
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+),
+#######Referencees Tab ###############
+tabItem(
+ tabName = "References",
+ withMathJax(),
+ h2("References"),
+
+ p('The Protein-Protein Interaction Dataset is from the Warwick University - Molecular Organisation and Assembly in Cells.'),
+
+ p(class = "hangingindent",
+ "Attali, D. (2020).
+ shinyjs: Easily Improve the User Experience of Your Shiny Apps in Seconds, R package.
+ Available from https://CRAN.R-project.org/package=shinyjs"),
+ p(class = "hangingindent",
+ "Chang, W. and Borges Ribeiro, B. (2018),
+ shinydashboard: Create Dashboards with 'Shiny', R package.
+ Available from https://CRAN.R-project.org/package=shinydashboard"),
+ p(class = "hangingindent",
+ "Chang, W., Cheng, J., Allaire, J., Xie, Y., and MchPherson, J. (2020),
+ shiny: Web Application Framework for R, R package.
+ Available from https://CRAN.R-project.org/package=shiny"),
+ p(class = "hangingindent",
+ "Bailey, E. (2015).
+ shinyBS: Twitter Bootstrap Components for Shiny, R package.
+ Available from https://CRAN.R-project.org/package=shinyBS"),
+ p(class = "hangingindent",
+ "Perrier, V., Meyer, F., and Granjon, D. (2020).
+ shinyWidgets: Custom Inputs Widgets for Shiny, R package.
+ Available from https://CRAN.R-project.org/package=shinyWidgets"),
+ p(class = "hangingindent",
+ "Sievert, C. (2020).
+ plotly: Interactive Web-Based Data Visualization with R, plotly, and
+ shiny. Chapman and Hall/CRC Florida, 2020."
+ ),
+ p(class = "hangingindent",
+ "Wickham, H., ggplot2: Elegant Graphics for Data Analysis, R package.
+ Springer-Verlag New York, 2016."
+ ),
+ p(class = "hangingindent",
+ "Nijs, V., Fang, F., Trestle Technology, LLC and Allen, J. (2019).
+ shinyAce: Ace Editor Bindings for Shiny, R package.
+ Available from https://CRAN.R-project.org/package=shinyAce"
+ ),
+ p(class = "hangingindent",
+ "Sali, A. and Attali D. (2020). shinycssloaders: Add CSS Loading
+ Animations to 'shiny' Outputs, R package.
+ https://CRAN.R-project.org/package=shinycssloaders"
+ ),
+ p(class = "hangingindent",
+ "Carey R. (2019).
+ rlocker: Learning Locker for Shiny, R package.
+ Available from https://github.com/rpc5102/rlocker"),
+ p(class = "hangingindent",
+ "Carey, R. and Hatfield, N. (2020). boastUtils: BOAST Utilities. R
+ package version 0.1.4.
+ https://github.com/EducationShinyAppTeam/boastUtils"
+ )
+
+
+)
+
+ )
+)))
+
+server <- function(input, output, session) {
+ # Initialize Learning Locker connection
+ connection <- rlocker::connect(
+ session,
+ list(
+ base_url = "https://learning-locker.stat.vmhost.psu.edu/",
+ auth = "Basic ZDQ2OTNhZWZhN2Q0ODRhYTU4OTFmOTlhNWE1YzBkMjQxMjFmMGZiZjo4N2IwYzc3Mjc1MzU3MWZkMzc1ZDliY2YzOTNjMGZiNzcxOThiYWU2",
+ agent = rlocker::createAgent()
+ )
+ )
+
+ # Setup demo app and user.
+ currentUser <-
+ connection$agent
+
+ if (connection$status != 200) {
+ warning(paste(connection$status, "\nTry checking your auth token."))
+ }
+
+ ##############end#########
+ output$Previewcar <-
+ renderTable({
+ head(cars, 4)
+ }, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
+
+ output$Previewtree <-
+ renderTable({
+ head(trees, 4)
+ }, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
+
+ output$Previewiris <-
+ renderTable({
+ head(iris, 4)
+ }, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
+
+ ###KNITR
+ observeEvent(input$eval, {
+ withBusyIndicatorServer("eval", {
+ output$knitDoc <- renderUI({
+ return(isolate(HTML(
+ knit2html(
+ text = input$rmd,
+ fragment.only = TRUE,
+ quiet = FALSE
+ )
+ )))
+ })
+
+ output$output <- renderPrint({
+ return(isolate(eval(parse(text = input$code))))
+ })
+ })
+ })
+
+ output$knitDoc <- renderUI({
+ input$eval
+ return(isolate(HTML(
+ knit2html(
+ text = input$rmd,
+ fragment.only = TRUE,
+ quiet = FALSE
+ )
+ )))
+ })
+
+ output$output <- renderPrint({
+ input$eval
+ return(isolate(eval(parse(text = input$code))))
+ })
+
+ observeEvent(input$info0, {
+ sendSweetAlert(
+ session = session,
+ title = "Instructions:",
+ text = "Move the sliders or select from the dropdown menus and view the R code that produces the results.",
+ type = NULL
+ )
+ })
+ observeEvent(input$info, {
+ sendSweetAlert(
+ session = session,
+ title = "Instructions:",
+ text = "Select the variables or the dataset to be used. Select answers for the exercise.",
+ type = NULL
+ )
+ })
+ observeEvent(input$go2, {
+ updateTabItems(session, 'tabs', 'VisualOne')
+ })
+
+ observeEvent(input$next2, {
+ updateTabsetPanel(session, 'VisualOne', selected = 'panel2')
+ })
+
+ ############ Data Visualization ############
+ ###########One Single Variable Plot##############
+ output$oneDensity <-
+ renderCachedPlot({
+ if (input$dataset == 'cars') {
+ if (input$carsVariable == 'speed') {
+ if (input$plotType == 'plot') {
+ plot(density(cars$speed),
+ main = "Density Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(speed), data = cars) +
+ geom_density(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle('Density Plot')
+ }
+ }
+ else if (input$carsVariable == 'dist') {
+ if (input$plotType == 'plot') {
+ plot(density(cars$dist),
+ main = "Density Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(dist), data = cars) +
+ geom_density(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle('Density Plot')
+ }
+ }
+ }
+ else if (input$dataset == 'trees') {
+ if (input$treesVariable == 'Girth') {
+ if (input$plotType == 'plot') {
+ plot(density(trees$Girth),
+ main = "Density Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Girth), data = trees) +
+ geom_density(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle('Density Plot')
+ }
+ }
+ else if (input$treesVariable == 'Height') {
+ if (input$plotType == 'plot') {
+ plot(density(trees$Height),
+ main = "Density Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Height), data = trees) +
+ geom_density(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle('Density Plot')
+ }
+
+ }
+ else if (input$treesVariable == 'Volume') {
+ if (input$plotType == 'plot') {
+ plot(density(trees$Volume),
+ main = "Density Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Volume), data = trees) +
+ geom_density(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle('Density Plot')
+ }
+
+ }
+ }
+ },
+ cacheKeyExpr = {
+ list(input$dataset,
+ input$carsVariable,
+ input$plotType,
+ input$treesVariable)
+ })
+
+ output$onehist <- renderCachedPlot({
+ if (input$dataset == 'cars') {
+ if (input$carsVariable == 'speed') {
+ if (input$plotType == 'plot') {
+ hist(cars$speed,
+ main = "Histogram",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(speed), data = cars) +
+ geom_histogram(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle("Histogram")
+ }
+ }
+ else if (input$carsVariable == 'dist') {
+ if (input$plotType == 'plot') {
+ hist(cars$dist,
+ main = "Histogram",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(dist), data = cars) +
+ geom_histogram(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle("Histogram")
+ }
+
+ }
+ }
+ else if (input$dataset == 'trees') {
+ if (input$treesVariable == 'Girth') {
+ if (input$plotType == 'plot') {
+ hist(trees$Girth,
+ main = "Histogram",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Girth), data = trees) +
+ geom_histogram(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle("Histogram")
+ }
+ }
+ else if (input$treesVariable == 'Height') {
+ if (input$plotType == 'plot') {
+ hist(trees$Height,
+ main = "Histogram",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Height), data = trees) +
+ geom_histogram(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle("Histogram")
+ }
+ }
+ else if (input$treesVariable == 'Volume') {
+ if (input$plotType == 'plot') {
+ hist(trees$Volume,
+ main = "Histogram",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Volume), data = trees) +
+ geom_histogram(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ ggtitle("Histogram")
+ }
+
+ }
+ }
+ },
+ cacheKeyExpr = {
+ list(input$dataset,
+ input$plotType,
+ input$carsVariable,
+ input$treesVariable)
+ })
+
+ output$onebar <-
+ renderCachedPlot({
+ if (input$dataset == 'cars') {
+ if (input$carsVariable == 'speed') {
+ if (input$plotType == 'plot') {
+ barplot(cars$speed,
+ main = "Bar Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(speed), data = cars) +
+ geom_freqpoly(bins = 30) +
+ geom_area(
+ stat = "bin",
+ bins = 30,
+ color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4
+ ) +
+ ggtitle('Frequency polygon')
+ }
+ }
+ else if (input$carsVariable == 'dist') {
+ if (input$plotType == 'plot') {
+ barplot(cars$dist,
+ main = "Bar Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(dist), data = cars) +
+ geom_freqpoly(bins = 30) +
+ geom_area(
+ stat = "bin",
+ bins = 30,
+ color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4
+ ) +
+ ggtitle('Frequency polygon')
+ }
+
+ }
+ }
+ else if (input$dataset == 'trees') {
+ if (input$treesVariable == 'Girth') {
+ if (input$plotType == 'plot') {
+ barplot(trees$Girth,
+ main = "Bar Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Girth), data = trees) +
+ geom_freqpoly(bins = 30) +
+ geom_area(
+ stat = "bin",
+ bins = 30,
+ color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4
+ ) +
+ ggtitle('Frequency polygon')
+ }
+ }
+ else if (input$treesVariable == 'Height') {
+ if (input$plotType == 'plot') {
+ barplot(trees$Height,
+ main = "Bar Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Height), data = trees) +
+ geom_freqpoly(bins = 30) +
+ geom_area(
+ stat = "bin",
+ bins = 30,
+ color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4
+ ) +
+ ggtitle('Frequency polygon')
+ }
+
+ }
+ else if (input$treesVariable == 'Volume') {
+ if (input$plotType == 'plot') {
+ barplot(trees$Volume,
+ main = "Bar Plot",
+ xlab = input$carsVariable)
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(Volume), data = trees) +
+ geom_freqpoly(bins = 30) +
+ geom_area(
+ stat = "bin",
+ bins = 30,
+ color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4
+ ) +
+ ggtitle('Frequency polygon')
+ }
+ }
+ }
+ }, cacheKeyExpr = {
+ list(input$dataset,
+ input$plotType,
+ input$carsVariable,
+ input$treesVariable)
+ })
+
+ output$oneqq <-
+ renderCachedPlot({
+ if (input$dataset == 'cars') {
+ if (input$carsVariable == 'speed') {
+ if (input$plotType == 'plot') {
+ qqnorm(cars$speed)
+ qqline(cars$speed, col = 'red')
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(sample = speed), data = cars) +
+ stat_qq(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ stat_qq_line(color = 'red')
+ }
+ }
+ else if (input$carsVariable == 'dist') {
+ if (input$plotType == 'plot') {
+ qqnorm(cars$dist)
+ qqline(cars$dist, col = 'red')
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(sample = dist), data = cars) +
+ stat_qq(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ stat_qq_line(color = 'red')
+ }
+ }
+ }
+ else if (input$dataset == 'trees') {
+ if (input$treesVariable == 'Girth') {
+ if (input$plotType == 'plot') {
+ qqnorm(trees$Girth)
+ qqline(trees$Girth, col = 'red')
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(sample = Girth), data = trees) +
+ stat_qq(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ stat_qq_line(color = 'red')
+ }
+ }
+ else if (input$treesVariable == 'Height') {
+ if (input$plotType == 'plot') {
+ qqnorm(trees$Height)
+ qqline(trees$Height, col = 'red')
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(sample = Height), data = trees) +
+ stat_qq(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ stat_qq_line(color = 'red')
+ }
+ }
+ else if (input$treesVariable == 'Volume') {
+ if (input$plotType == 'plot') {
+ qqnorm(trees$Volume)
+ qqline(trees$Volume, col = 'red')
+ }
+ else if (input$plotType == 'ggplot') {
+ ggplot(aes(sample = Volume), data = trees) +
+ stat_qq(color = "darkblue",
+ fill = "lightblue",
+ alpha = 0.4) +
+ stat_qq_line(color = 'red')
+ }
+ }
+ }
+ }, cacheKeyExpr = {
+ list(input$dataset,
+ input$plotType,
+ input$carsVariable,
+ input$treesVariable)
+ })
+
+ output$DensityoneCode <- renderText({
+ if (input$dataset == 'cars') {
+ if (input$plotType == 'plot') {
+ paste(
+ 'R Code:',
+ 'plot(density(',
+ input$dataset,
+ '$',
+ input$carsVariable,
+ '))',
+ seq = ''
+ )
+ }
+ else if (input$plotType == 'ggplot') {
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$carsVariable,
+ "), data=cars)+
+ geom_density(color='darkblue', fill='lightblue', alpha=0.4)+
+ ggtitle('Density Plot')",
+ seq = ''
+ )
+ }
+ }
+ else{
+ if (input$plotType == 'plot') {
+ paste(
+ 'R Code:',
+ 'plot(density(',
+ input$dataset,
+ '$',
+ input$treesVariable,
+ ')',
+ seq = ''
+ )
+ }
+ else if (input$plotType == 'ggplot') {
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$treesVariable,
+ "), data=trees)+
+ geom_density(color='darkblue', fill='lightblue', alpha=0.4)+
+ ggtitle('Density Plot')",
+ seq = ''
+ )
+ }
+ }
+ })
+
+ output$HistogramoneCode <- renderText({
+ if (input$dataset == 'cars') {
+ if (input$plotType == 'plot') {
+ paste('R Code:',
+ 'hist(',
+ input$dataset,
+ '$',
+ input$carsVariable,
+ ')',
+ seq = '')
+ }
+ else{
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$carsVariable,
+ "), data=cars)+
+ geom_histogram(color='darkblue', fill='lightblue', alpha=0.4)+
+ ggtitle('Histogram')",
+ seq = ''
+ )
+ }
+ }
+ else{
+ if (input$plotType == 'plot') {
+ paste('R Code:',
+ 'hist(',
+ input$dataset,
+ '$',
+ input$treesVariable,
+ ')',
+ seq = '')
+ }
+ else{
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$treesVariable,
+ "), data=trees)+
+ geom_histogram(color='darkblue', fill='lightblue', alpha=0.4)+
+ ggtitle('Histogram')",
+ seq = ''
+ )
+ }
+ }
+ })
+
+ output$BarCode <- renderText({
+ if (input$dataset == 'cars') {
+ if (input$plotType == 'plot') {
+ paste('R Code:',
+ 'barplot(',
+ input$dataset,
+ '$',
+ input$carsVariable,
+ ')',
+ seq = '')
+ }
+ else{
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$carsVariable,
+ "), data=cars)+
+ geom_freqpoly(bins = 30)+
+ geom_area(stat = 'bin', bins = 30,
+ color='darkblue', fill='lightblue', alpha=0.4)+
+ ggtitle('Frequency polygon')"
+ )
+ }
+ }
+ else{
+ if (input$plotType == 'plot') {
+ paste('R Code:',
+ 'barplot(',
+ input$dataset,
+ '$',
+ input$treesVariable,
+ ')',
+ seq = '')
+ }
+ else{
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$treesVariable,
+ "), data=trees)+
+ geom_freqpoly(bins = 30)+
+ geom_area(stat = 'bin', bins = 30,
+ color='darkblue', fill='lightblue', alpha=0.4)+
+ ggtitle('Frequency polygon')"
+ )
+ }
+ }
+ })
+
+ output$qqCode <- renderText({
+ if (input$dataset == 'cars') {
+ if (input$plotType == 'plot') {
+ paste0(
+ 'R Code: ',
+ 'qqnorm(',
+ input$dataset,
+ '$',
+ input$carsVariable,
+ ')',
+ '\n qqline(',
+ input$dataset,
+ '$',
+ input$carsVariable,
+ ')',
+ seq = ''
+ )
+ }
+ else{
+ paste(
+ 'R Code:',
+ "ggplot(aes(sample=",
+ input$carsVariable,
+ "), data=cars)+
+ stat_qq(color='darkblue', fill='lightblue', alpha=0.4)+
+ stat_qq_line(color='red')",
+ seq = ''
+ )
+ }
+ }
+ else{
+ if (input$plotType == 'plot') {
+ paste0(
+ 'R Code:',
+ 'qqnorm(',
+ input$dataset,
+ '$',
+ input$treesVariable,
+ ')',
+ 'qqline(',
+ input$dataset,
+ '$',
+ input$treesVariable,
+ ')',
+ seq = ''
+ )
+ }
+ else{
+ paste(
+ 'R Code:',
+ "ggplot(aes(sample=",
+ input$treesVariable,
+ "), data=trees)+
+ stat_qq(color='darkblue', fill='lightblue', alpha=0.4)+
+ stat_qq_line(color='red')",
+ seq = ''
+ )
+ }
+
+ }
+ })
+ ###########Two Variables########
+ output$twoscatter <- renderCachedPlot({
+ if (input$continuous1 == 'Sepal.Length') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(aes(Sepal.Length, Petal.Length), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ geom_smooth(aes(colour = factor(Species)),
+ linetype = 'twodash',
+ size = 0.8) +
+ ggtitle("Scatter Plot")
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(aes(Sepal.Length, Petal.Width), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ geom_smooth(aes(colour = factor(Species)),
+ linetype = 'twodash',
+ size = 0.8) +
+ ggtitle("Scatter Plot")
+ }
+ }
+ else if (input$continuous1 == 'Sepal.Width') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(aes(Sepal.Width, Petal.Length), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ geom_smooth(aes(colour = factor(Species)),
+ linetype = 'twodash',
+ size = 0.8) +
+ ggtitle("Scatter Plot")
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(aes(Sepal.Width, Petal.Width), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ geom_smooth(aes(colour = factor(Species)),
+ linetype = 'twodash',
+ size = 0.8) +
+ ggtitle("Scatter Plot")
+ }
+ }
+ }, cacheKeyExpr = {
+ list(input$continuous1, input$continuous2)
+ })
+
+
+ output$logTransformation <- renderCachedPlot({
+ if (input$continuous1 == 'Sepal.Length') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(aes(Sepal.Length, Petal.Length), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ coord_trans(x = "log2", y = "log2") +
+ ggtitle("Log Transformation")
+ #sunflowerplot(Sepal.Length~Petal.Length, data=iris, main="SunflowerPlot")
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(aes(Sepal.Length, Petal.Width), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ coord_trans(x = "log2", y = "log2") +
+ ggtitle("Log Transformation")
+ #sunflowerplot(Sepal.Length~Petal.Width, data=iris, main="SunflowerPlot")
+ }
+ }
+ else if (input$continuous1 == 'Sepal.Width') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(aes(Sepal.Width, Petal.Length), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ coord_trans(x = "log2", y = "log2") +
+ ggtitle("Log Transformation")
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(aes(Sepal.Width, Petal.Width), data = iris) +
+ geom_point(aes(colour = factor(Species))) +
+ coord_trans(x = "log2", y = "log2") +
+ ggtitle("Log Transformation")
+ #sunflowerplot(Sepal.Width~Petal.Width, data=iris, main="SunflowerPlot")
+ }
+ }
+ }, cacheKeyExpr = {
+ list(input$continuous1, input$continuous2)
+ })
+
+ output$twobar <- renderCachedPlot({
+ if (input$continuous1 == 'Sepal.Length') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Length,
+ y = Petal.Length,
+ fill = factor(Species)
+ )) +
+ geom_bar(stat = "identity") +
+ ggtitle('Bar Plot')
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Length,
+ y = Petal.Width,
+ fill = factor(Species)
+ )) +
+ geom_bar(stat = "identity") +
+ ggtitle('Bar Plot')
+ }
+ }
+ else if (input$continuous1 == 'Sepal.Width') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Width,
+ y = Petal.Length,
+ fill = factor(Species)
+ )) +
+ geom_bar(stat = "identity") +
+ ggtitle('Bar Plot')
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Width,
+ y = Petal.Width,
+ fill = factor(Species)
+ )) +
+ geom_bar(stat = "identity") +
+ ggtitle('Bar Plot')
+ }
+ }
+ }, cacheKeyExpr = {
+ list(input$continuous1, input$continuous2)
+ })
+
+
+ output$twobox <- renderCachedPlot({
+ if (input$continuous1 == 'Sepal.Length') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Length,
+ y = Petal.Length,
+ color = Species
+ )) +
+ geom_boxplot() +
+ ggtitle('Boxplot')
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Length,
+ y = Petal.Width,
+ color = Species
+ )) +
+ geom_boxplot() +
+ ggtitle('Boxplot')
+ }
+ }
+ else if (input$continuous1 == 'Sepal.Width') {
+ if (input$continuous2 == 'Petal.Length') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Width,
+ y = Petal.Length,
+ color = Species
+ )) +
+ geom_boxplot() +
+ ggtitle('Boxplot')
+ }
+ else if (input$continuous2 == 'Petal.Width') {
+ ggplot(data = iris,
+ aes(
+ x = Sepal.Width,
+ y = Petal.Width,
+ color = Species
+ )) +
+ geom_boxplot() +
+ ggtitle('Boxplot')
+ }
+ }
+ }, cacheKeyExpr = {
+ list(input$continuous1, input$continuous2)
+ })
+
+ output$twoscattercode <- renderText({
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$continuous1,
+ ',',
+ input$continuous2,
+ "), data=iris)+
+ geom_point(aes(colour = factor(Species)))+
+ geom_smooth(aes(colour = factor(Species)), linetype='twodash', size=0.8)+
+ ggtitle('Scatter Plot')",
+ seq = ''
+ )
+ })
+
+ output$logTransformationCode <- renderText({
+ paste(
+ 'R Code:',
+ "ggplot(aes(",
+ input$continuous1,
+ ',',
+ input$continuous2,
+ "), data=iris)+
+ geom_point(aes(colour = factor(Species)))+
+ coord_trans(x='log2', y='log2')+
+ ggtitle('Log Transformation')",
+ seq = ''
+ )
+ })
+
+ output$twobarcode <- renderText({
+ paste(
+ 'R Code:',
+ "ggplot(data=iris, aes(",
+ input$continuous1,
+ ',',
+ input$continuous2,
+ "fill=factor(Species)))+
+ geom_bar(stat='identity')+
+ ggtitle('Bar Plot')",
+ seq = ''
+ )
+ })
+
+ output$twoboxcode <- renderText({
+ paste(
+ 'R Code:',
+ "ggplot(data=iris, aes(",
+ input$continuous1,
+ ',',
+ input$continuous2,
+ "color=Species)) +
+ geom_boxplot()+
+ ggtitle('Boxplot')",
+ seq = ''
+ )
+ })
+
+
+ ###########Exercises Part###################
+ # observeEvent(input$submit, {
+ # updateButton(session, "nextq", disabled = FALSE)
+ # })
+ #
+ # observeEvent(input$submit, {
+ # updateButton(session, "submit", disabled = TRUE)
+ # })
+
+ observeEvent(input$nextq, {
+ # updateButton(session, "submit", disabled = FALSE)
+ # updateButton(session, "nextq", disabled = TRUE)
+ updateSelectInput(session,
+ "answer",
+ "pick an answer from below",
+ c("", "A", "B", "C"))
+ output$mark <- renderUI({
+ img(src = NULL, width = 30)
+ })
+ })
+
+
+ #### question bank ####
+ value <- reactiveValues(index = 1,
+ mistake = 0,
+ correct = 0)
+ ans <- as.matrix(bank[1:14, 6])
+ #ans <- data.frame(ans)
+ index_list <- reactiveValues(list = sample(2:14, 10, replace = FALSE))
+
+ observeEvent(input$nextq, {
+ value$answerbox <- value$index
+ index_list$list = index_list$list[-1]
+ value$index <- index_list$list[1]
+ value$answerbox <- value$index
+
+ updateButton(session, "nextq", disabled = TRUE)
+ updateButton(session, "submit", disabled = FALSE)
+ })
+
+ output$question <- renderUI({
+ h4(bank[value$index, 2])
+ # radioButtons(inputId = bank[value$index,1], label= bank[value$index, 2],
+ # choiceNames=c(bank[value$index, 3], bank[value$index, 4], bank[value$index, 5]),
+ # choiceValues = c("A", "B", "C"))
+ })
+
+ output$options <- renderUI({
+ str1 <- paste("A.", bank[value$index, 3])
+ str2 <- paste("B.", bank[value$index, 4])
+ str3 <- paste("C.", bank[value$index, 5])
+ HTML(paste(str1, str2, str3, sep = '
'))
+ })
+
+
+ observeEvent(input$answer, {
+ req(input$answer, input$answer != '')
+ answer <- isolate(input$answer)
+ interacted_statement <- rlocker::createStatement(list(
+ verb = list(display = "interacted"),
+ object = list(
+ id = paste0(getCurrentAddress(session), "#", value$index),
+ name = paste('Question', value$index),
+ description = bank[value$index, 2]
+
+ ),
+ result = list(
+ success = NA,
+ response = paste(getResponseText(value$index, answer))
+ )
+ ))
+
+ # Store statement in locker and return status
+ status <- rlocker::store(session, interacted_statement)
+
+ print(interacted_statement) # remove me
+ print(status) # remove me
+ })
+
+
+ getResponseText <- function(index, answer) {
+ if (answer == 'A') {
+ key = 3
+ } else if (answer == 'B') {
+ key = 4
+ } else {
+ key = 5
+ }
+ return(bank[index, key])
+ }
+
+ observeEvent(input$submit, {
+ if (length(index_list$list) == 1) {
+ updateButton(session, "nextq", disabled = TRUE)
+ updateButton(session, "submit", disabled = TRUE)
+ updateButton(session, "reset", disabled = FALSE)
+ }
+ else{
+ updateButton(session, "nextq", disabled = FALSE)
+ updateButton(session, "submit", disabled = TRUE)
+ updateButton(session, "reset", disabled = FALSE)
+ }
+
+ # output$progress<-renderUI({
+ # paste("You are currently on problem", 11-length(index_list$list), "/10")
+ # })
+
+ answer <- isolate(input$answer)
+
+ statement <- rlocker::createStatement(list(
+ verb = list(display = "answered"),
+ object = list(
+ id = paste0(getCurrentAddress(session), "#", value$index),
+ name = paste('Question', value$index),
+ description = bank[value$index, 2]
+ ),
+ result = list(
+ success = any(answer == ans[value$index, 1]),
+ response = paste(getResponseText(value$index, answer))
+ )
+ ))
+
+ # Store statement in locker and return status
+ status <- rlocker::store(session, statement)
+
+ print(statement) # remove me
+ print(status) # remove me
+
+ output$mark <- renderUI({
+ if (any(answer == ans[value$index, 1])) {
+ img(src = "correct.png", width = 30)
+ }
+ else{
+ ig <- img(src = "incorrect.png", width = 30)
+ w <-
+ paste("You picked", answer, ", The correct answer is", ans[value$index, 1])
+ HTML(paste(ig, w), sep = ' ')
+ }
+ })
+ })
+
+ observeEvent(input$reset, {
+ updateButton(session, "submit", disabled = FALSE)
+ updateButton(session, "reset", disable = TRUE)
+ updateSelectInput(session,
+ "answer",
+ "pick an answer from below",
+ c("", "A", "B", "C"))
+ index_list$list <-
+ c(index_list$list, sample(2:14, 10, replace = FALSE))
+ value$index <- 1
+ value$answerbox = value$index
+ ans <- as.matrix(bank[1:14, 6])
+ output$mark <- renderUI({
+ img(src = NULL, width = 30)
+ })
+ })
+
+ ###### Maps ######
+ #a. usMap
+ output$usMapOut1 <- renderCachedPlot({
+ USArrests2 <- USArrests %>% mutate(state = row.names(.))
+ if (input$usMap1 == 'borders' & input$usMap2 == 'compact') {
+ mUSMap(
+ USArrests2,
+ key = "state",
+ fill = "UrbanPop",
+ plot = 'borders',
+ style = 'compact'
+ )
+ }
+ else if (input$usMap1 == 'borders' & input$usMap2 == 'real') {
+ mUSMap(
+ USArrests2,
+ key = "state",
+ fill = "UrbanPop",
+ plot = 'borders',
+ style = 'real'
+ )
+ }
+ else if (input$usMap1 == 'frame' & input$usMap2 == 'compact') {
+ mUSMap(
+ USArrests2,
+ key = "state",
+ fill = "UrbanPop",
+ plot = 'frame',
+ style = 'compact'
+ )
+ }
+ else {
+ mUSMap(
+ USArrests2,
+ key = "state",
+ fill = "UrbanPop",
+ plot = 'frame',
+ style = 'real'
+ )
+ }
+ }, cacheKeyExpr = {
+ list(input$usMap1, input$usMap2)
+ })
+
+ output$usMapOut2 <- renderUI ({
+ tags$code(
+ 'mUSMap(USArrests2, key = "state", fill = "UrbanPop", plot = "',
+ input$usMap1,
+ '", style = "',
+ input$usMap2,
+ '")'
+ )
+ })
+
+ #plotly US Map - code
+ output$plotlyUScode <- renderUI ({
+ tags$code('p <- plot_geo(df, locationmode = "USA-states", sizes = c(1, 250))')
+ })
+
+ #plotly US Map
+ output$plotlyUSMap <- renderPlotly({
+ df <-
+ read.csv(
+ 'https://raw.githubusercontent.com/plotly/datasets/master/2014_us_cities.csv'
+ )
+ df$q <- with(df, cut(pop, quantile(pop)))
+ levels(df$q) <-
+ paste(c("1st", "2nd", "3rd", "4th", "5th"), "Quantile")
+ df$q <- as.ordered(df$q)
+
+ g <- list(
+ scope = 'usa',
+ projection = list(type = 'albers usa'),
+ showland = TRUE,
+ landcolor = toRGB("gray85"),
+ subunitwidth = 1,
+ countrywidth = 1,
+ subunitcolor = toRGB("white"),
+ countrycolor = toRGB("white")
+ )
+
+ p <-
+ plot_geo(df, locationmode = 'USA-states', sizes = c(1, 250)) %>%
+ add_markers(
+ x = ~ lon,
+ y = ~ lat,
+ size = ~ pop,
+ color = ~ q,
+ hoverinfo = "text",
+ text = ~ paste(df$name, "
", df$pop / 1e6, " million")
+ ) %>%
+ layout(title = '2014 US city populations
(Click legend to toggle)', geo = g)
+ g
+ p
+ })
+
+
+ ###### 3D Plots ######
+ #a. Normal Simulation via Plotly
+ output$plotly1 <- renderPlotly ({
+ plot_ly(
+ x = rnorm(input$Exsel1),
+ y = rnorm(input$Exsel1),
+ z = rnorm(input$Exsel1),
+ type = 'scatter3d',
+ mode = 'markers'
+ )
+ })
+
+ output$ExCode <- renderUI ({
+ tags$code(
+ 'plot_ly(x = rnorm(',
+ input$Exsel1,
+ '), y = rnorm(',
+ input$Exsel1,
+ '), z = rnorm(',
+ input$Exsel1,
+ '), type = "scatter3d", mode = "markers")'
+ )
+ })
+
+
+ output$hover <- renderPrint({
+ dataHover <- event_data("plotly_hover")
+ if (is.null(dataHover)) {
+ "Hover events appear here (unhover to clear)"
+ }
+ else {
+ dataHover
+ }
+ })
+
+ output$click <- renderPrint({
+ dataClick <- event_data("plotly_click")
+ if (is.null(dataClick)) {
+ "Click events appear here (double-click to clear)"
+ }
+ else {
+ dataClick
+ }
+ })
+
+ # output$ExCode <- renderUI ({
+ # if (input$Exsel == 'Scatter Plot') {
+ # tags$code('plot_ly(x = rnorm(', input$Exsel1, '), y = rnorm(', input$Exsel1, '), z = rnorm(', input$Exsel1, '), type = "scatter3d", mode = "markers")')
+ # }
+ # else if (input$Exsel == 'Line Plot') {
+ # tags$code('plot_ly(x = rnorm(', input$Exsel1, '), y = rnorm(', input$Exsel1, '), z = rnorm(', input$Exsel1, '), type = "scatter3d", mode = "lines")')
+ # }
+ # else {
+ # tags$code('plot_ly(x = rnorm(', input$Exsel1, '), y = rnorm(', input$Exsel1, '), z = rnorm(', input$Exsel1, '), type = "mesh3d", mode = "markers")')
+ # }
+ # })
+
+ #b. Basic Scatter Plot
+ output$basicRcode <- renderUI ({
+ tags$code(
+ 'scatter3D(x, y, z, clab = c("Sepal", "Width (cm)"), xlab = input$basicX, ylab = input$basicY, zlab = input$basicZ)'
+ )
+ })
+
+ output$bspTable <- renderTable ({
+ head(iris)
+ })
+
+ output$bspOut1 <- renderPlot({
+ x <- iris[, input$basicX]
+ y <- iris[, input$basicY]
+ z <- iris[, input$basicZ]
+ scatter3D(
+ x,
+ y,
+ z,
+ clab = c("Sepal", "Width (cm)"),
+ xlab = input$basicX,
+ ylab = input$basicY,
+ zlab = input$basicZ
+ )
+ })
+
+ # #c.
+ # output$bspTableCopy <- renderTable ({
+ # head(iris)
+ # })
+ #
+ # output$bspOut2 <- renderPlot ({
+ # scatter3D(x, y, z, bty = "g", pch = 18,
+ # col.var = as.integer(iris$Species),
+ # col = c("#1B9E77", "#D95F02", "#7570B3"),
+ # pch = 18, ticktype = "detailed",
+ # colkey = list(at = c(2, 3, 4), side = 1,
+ # addlines = TRUE, length = 0.5, width = 0.5,
+ # labels = c("setosa", "versicolor", "virginica")) )
+ # })
+
+ # #d. 3D Plots with Confidence Intervals
+ # output$CIOut <- renderPlot ({
+ # x <- iris[, input$CIX]
+ # y <- iris[, input$CIY]
+ # z <- iris[, input$CIZ]
+ # CI <- list(z = matrix(nrow = length(x),
+ # data = rep(0.1, 2*length(x))))
+ # scatter3D(x, y, z, phi = 0, bty = "g", col = gg.col(100),
+ # pch = 18, CI = CI)
+ # })
+
+ #e. 3D Texts Plot
+ output$textRcode <- renderUI ({
+ tags$code(
+ 'with(USArrests, text3D(Murder, Assault, Rape,
+ labels = rownames(USArrests), colvar = UrbanPop,
+ col = gg.col(100), theta = 60, phi = 20,
+ xlab = "Murder", ylab = "Assault", zlab = "Rape",
+ main = "USA arrests", cex = 0.6,
+ bty = "g", ticktype = "detailed", d = 2,
+ clab = c("Urban","Pop"), adj = 0.5, font = 2))'
+ )
+ })
+
+ output$textTable <- renderTable ({
+ head(USArrests)
+ })
+
+ output$textOut <- renderPlot ({
+ data(USArrests)
+ with(
+ USArrests,
+ text3D(
+ Murder,
+ Assault,
+ Rape,
+ labels = rownames(USArrests),
+ colvar = UrbanPop,
+ col = gg.col(100),
+ theta = 60,
+ phi = 20,
+ xlab = "Murder",
+ ylab = "Assault",
+ zlab = "Rape",
+ main = "USA arrests",
+ cex = 0.6,
+ bty = "g",
+ ticktype = "detailed",
+ d = 2,
+ clab = c("Urban", "Pop"),
+ adj = 0.5,
+ font = 2
+ )
+ )
+ })
+
+ ###### 2D Line Plots ######
+ output$plotly2 <- renderPlotly ({
+ trace_0 <-
+ rnorm(as.numeric(input$LPsel1), mean = as.numeric(input$LPnum1))
+ trace_1 <-
+ rnorm(as.numeric(input$LPsel1), mean = as.numeric(input$LPnum2))
+ x = c(1:as.numeric(input$LPsel1))
+ data <- data.frame(x, trace_0, trace_1)
+ if (input$LPSEL1 == 'Lines' & input$LPSEL2 == 'Lines') {
+ plot_ly(
+ data,
+ x = ~ x,
+ y = ~ trace_0,
+ name = 'trace 0',
+ type = 'scatter',
+ mode = 'lines'
+ ) %>%
+ add_trace(y = ~ trace_1,
+ name = 'trace 1',
+ mode = 'lines')
+ }
+ else if (input$LPSEL1 == 'Markers' &
+ input$LPSEL2 == 'Markers') {
+ plot_ly(
+ data,
+ x = ~ x,
+ y = ~ trace_0,
+ name = 'trace 0',
+ type = 'scatter',
+ mode = 'markers'
+ ) %>%
+ add_trace(y = ~ trace_1,
+ name = 'trace 1',
+ mode = 'markers')
+ }
+ else if (input$LPSEL1 == 'Lines' & input$LPSEL2 == 'Markers') {
+ plot_ly(
+ data,
+ x = ~ x,
+ y = ~ trace_0,
+ name = 'trace 0',
+ type = 'scatter',
+ mode = 'lines'
+ ) %>%
+ add_trace(y = ~ trace_1,
+ name = 'trace 1',
+ mode = 'markers')
+ }
+ else {
+ plot_ly(
+ data,
+ x = ~ x,
+ y = ~ trace_0,
+ name = 'trace 0',
+ type = 'scatter',
+ mode = 'markers'
+ ) %>%
+ add_trace(y = ~ trace_1,
+ name = 'trace 1',
+ mode = 'lines')
+ }
+ })
+
+ output$LPCode <- renderUI ({
+ tags$code(
+ 'plot_ly(data, x = ~x, y = ~trace_0, name = "trace 0", type = "scatter", mode = "lines") %>%
+ add_trace(y = ~trace_1, name = "trace 1", mode = "markers + lines")'
+ )
+ })
+
+ ###### Contour Plots and Heatmaps ######
+ #contour plot
+ output$proteinInt <- renderPlot ({
+ potentials <-
+ as.matrix(read.table(
+ "MULTIPOT_lu.txt",
+ row.names = 1,
+ header = TRUE
+ ))
+ matrix.axes <- function(data) {
+ # Do the rows, las=2 for text perpendicular to the axis
+ x <- (1:dim(data)[1] - 1) / (dim(data)[1] - 1)
+
+ axis(
+ side = 1,
+ at = x,
+ labels = rownames(data),
+ las = 2
+ )
+
+ # Do the columns
+ x <- (1:dim(data)[2] - 1) / (dim(data)[2] - 1)
+
+ axis(
+ side = 2,
+ at = x,
+ labels = colnames(data),
+ las = 2
+ )
+
+ }
+ filled.contour(potentials,
+ plot.axes = matrix.axes(potentials),
+ main = "Protein-Protein Interaction Potential")
+ })
+
+ output$plotly3 <- renderPlotly({
+ if (input$contourLabel == FALSE) {
+ plot_ly(z = volcano,
+ type = "contour",
+ colors = colorRamp(c("purple", "green")))
+ }
+ else {
+ plot_ly(
+ z = volcano,
+ type = "contour",
+ colors = colorRamp(c("purple", "green")),
+ contours = list(showlabels = TRUE)
+ )
+ }
+ })
+
+ #contour plot r code
+ output$CPCode1 <- renderUI ({
+ if (input$contourLabel == FALSE) {
+ tags$code(
+ 'plot_ly(z = volcano, type = "contour", colors = colorRamp(c("purple", "green")))'
+ )
+ }
+ else {
+ tags$code(
+ 'plot_ly(z = volcano, type = "contour", colors = colorRamp(c("purple", "green")), contours = list(showlabels = TRUE))'
+ )
+ }
+ })
+
+ #heatmap
+ output$plotly4 <- renderPlotly({
+ if (input$heatmapCol == 'purple+green') {
+ plot_ly(z = volcano,
+ type = "heatmap",
+ colors = colorRamp(c("purple", "green")))
+ }
+ else if (input$heatmapCol == 'yellow+red') {
+ plot_ly(z = volcano,
+ type = "heatmap",
+ colors = colorRamp(c("yellow", "red")))
+ }
+ else if (input$heatmapCol == 'pink+purple') {
+ plot_ly(z = volcano,
+ type = "heatmap",
+ colors = colorRamp(c("pink", "purple")))
+ }
+ else {
+ plot_ly(z = volcano,
+ type = "heatmap",
+ colors = colorRamp(c("white", "black")))
+ }
+ })
+
+ #heatmaps r code
+ output$CPCode2 <- renderUI ({
+ if (input$heatmapCol == 'purple+green') {
+ tags$code(
+ 'plot_ly(z = volcano, type = "heatmap", colors = colorRamp(c("purple", "green")))'
+ )
+ }
+ else if (input$heatmapCol == 'yellow+red') {
+ tags$code('plot_ly(z = volcano, type = "heatmap", colors = colorRamp(c("yellow", "red")))')
+ }
+ else if (input$heatmapCol == 'pink+purple') {
+ tags$code('plot_ly(z = volcano, type = "heatmap", colors = colorRamp(c("pink", "purple")))')
+ }
+ else {
+ tags$code('plot_ly(z = volcano, type = "heatmap", colors = colorRamp(c("white", "black")))')
+ }
+ })
+
+ output$cars1 <- renderPlotly ({
+ head(mtcars)
+ data = as.matrix(mtcars)
+ data = apply(data, 2, function(x) {
+ x / mean(x)
+ })
+ plot_ly(
+ x = colnames(data),
+ y = rownames(data),
+ z = data,
+ type = "heatmap"
+ )
+ })
+
+}
+# Boast App Call ----
+boastUtils::boastApp(ui = ui, server = server)
\ No newline at end of file
From 2725f4e4ed77fd2ca9ecca74cc2cd85dcf30354a Mon Sep 17 00:00:00 2001
From: Bob Carey
Date: Mon, 11 Oct 2021 09:54:40 -0400
Subject: [PATCH 02/21] Disabled rLocker
---
DESCRIPTION | 20 +++
app.R | 496 ++++++++++++++++++++++++++--------------------------
2 files changed, 267 insertions(+), 249 deletions(-)
create mode 100644 DESCRIPTION
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..6d0a240
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,20 @@
+Title: Data Visualization
+ShortName: Data Visualization
+Date: 2021-10-11
+Lifecycle: experimental
+Authors@R: c(
+ person(given = "Neil", family = "Hatfield", email = "neil.hatfield@psu.edu", role = c("aut", "cre")),
+ person(given = "Robert", family = "Carey", email = "rpc5102@psu.edu", role = c("aut"))
+ )
+Chapter: Data Science
+Description: This app is focused on the common types of xyz.
+LearningObjectives: c(
+ "The student will learn to understand Concept A in way z.",
+ "The student will learn to understand Concept B as description y."
+ )
+DisplayMode: Normal
+URL: https://psu-eberly.shinyapps.io/Data_Visualization
+BugReports: https://github.com/EducationShinyAppTeam/Data_Visualization/issues
+License: CC-BY-NC-SA-4.0
+Tags: simulation
+Type: Shiny
diff --git a/app.R b/app.R
index 80b90f3..3c78d6e 100644
--- a/app.R
+++ b/app.R
@@ -7,7 +7,6 @@ library(plotly)
library(ggplot2)
library(shinyAce)
library(shinycssloaders)
-library(rlocker)
library(ggmap)
library(boastUtils)
library(DT)
@@ -20,7 +19,6 @@ library(learnr)
library(knitr)
library(rmarkdown)
library(shinyAce)
-library(rlocker)
library(ggmap)
source("helpers.R")
@@ -35,12 +33,12 @@ ui <- list(
tags$li(class = "dropdown",tags$a(href = "https://shinyapps.science.psu.edu/",
icon("home")))
),
-
+
sidebar = dashboardSidebar(
width = 250,
sidebarMenu(id = 'tabs',
menuItem('Overview', tabName = 'overview', icon = icon("dashboard")),
- menuItem('Simple Data Visualization', tabName = 'VisualOne',
+ menuItem('Simple Data Visualization', tabName = 'VisualOne',
icon = icon('wpexplorer')),
menuItem('Advanced Data Visualization', tabName = 'exp4', icon = icon('wpexplorer')),
menuItem('References', tabName = "References", icon = icon("leanpub"))
@@ -49,13 +47,13 @@ ui <- list(
tags$div(class = "sidebar-logo",
boastUtils::psu_eberly_logo("reversed"))
),
-
+
body = dashboardBody(
- tags$head(
+ tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "https://educationshinyappteam.github.io/Style_Guide/theme/boast.css")
),
tags$style(type = "text/css", ".content-wrapper,.right-side {background-color: white;}"),
-
+
useShinyjs(),
tabItems(
tabItem(tabName = 'overview',
@@ -64,27 +62,27 @@ ui <- list(
h2(strong('About:')),
p('This app illustrates R code for data visualization.'),
br(),
-
+
h2(strong('Instructions:')),
p(tags$li("Simple data visualization section introduces
how to create some commonly used plots with ggplot and Rplot with exercises at the end.")),
p(tags$li("Advanced Data Visualization section
introduces 3D plots, line plots, contour plots, and heat maps.")),
br(),
- div(style = 'text-align: center',
- bsButton(inputId = 'go2', label = 'Explore',
+ div(style = 'text-align: center',
+ bsButton(inputId = 'go2', label = 'Explore',
icon = icon('bolt'), size = 'large', class='circle grow')),
br(),
h2(strong('Acknowledgements:')),
- p('This application was coded and developed by Anna (Yinqi) Zhang in 2018 and Yiyun Gong in 2019.
+ p('This application was coded and developed by Anna (Yinqi) Zhang in 2018 and Yiyun Gong in 2019.
Special Thanks to Grace (Yubaihe) Zhou for being incredibly helpful with programming issues.
It was updated for formatting by Ethan Wright 2020'),
div(class = "updated", "Last Update: 9/4/2020 by EJW.")
),
-
+
############ Data Visualization Introduction #######
######Characterizing one single Variable######
-
+
tabItem(tabName = 'VisualOne',
# div(style="display: inline-block;vertical-align:top;",
# tags$a(href='https://shinyapps.science.psu.edu/',tags$img(src='homebut.PNG', width = 19))
@@ -92,15 +90,15 @@ ui <- list(
# div(style="display: inline-block;vertical-align:top;",
# circleButton("info0",icon = icon("info"), status = "myClass",size = "xs")
# ),
-
+
tabsetPanel(type = 'tabs',
###### One Variable ######
tabPanel('Single Variable',
h1(strong('One Variable Visualization')),
# br(),
- p('This section illustrates R code for data
+ p('This section illustrates R code for data
visulization includes plot() and ggplot() with one Variable'),
-
+
br(),
sidebarLayout(
sidebarPanel(
@@ -110,19 +108,19 @@ ui <- list(
background-color: #FFFFFF;
}')
)),
-
+
checkboxInput("previewData", "Preview of Datasets"),
-
+
####select between plot and ggplot
selectInput(inputId="plotType", label="Select Plot Package",
choices = c('plot', 'ggplot'),
selected = 'plot'),
-
+
####select datasets
- selectInput(inputId="dataset", label="Select Dataset:",
- choices= c('cars', 'trees'),
+ selectInput(inputId="dataset", label="Select Dataset:",
+ choices= c('cars', 'trees'),
selected = 'cars'),
-
+
####variable options for 'car' dataset
conditionalPanel(
condition = "input.dataset == 'cars'",
@@ -130,7 +128,7 @@ ui <- list(
choices = c("speed", "dist"),
selected = 'speed')
),
-
+
####variable option for 'trees' dataset
conditionalPanel(
condition = "input.dataset == 'trees'",
@@ -143,21 +141,21 @@ ui <- list(
#tags$a(tags$img(src="pdficon.png"), href="DataView.pdf", download="Viewdata.pdf")
# br(),
#downloadLink("downloadData", "Preview of Data"),
-
+
),
-
+
mainPanel(
conditionalPanel(
- condition="input.previewData==1",
-
+ condition="input.previewData==1",
+
fluidRow(
column(2, p(strong("Dataset"))),
column(4, DT::dataTableOutput("dataTable")),
-
+
)
),
fluidRow(
- column(6,plotOutput(outputId="oneDensity", width="100%",height="300px")%>% withSpinner(color="#FFFFFF")),
+ column(6,plotOutput(outputId="oneDensity", width="100%",height="300px")%>% withSpinner(color="#FFFFFF")),
column(6,plotOutput(outputId="onehist", width="100%",height="300px")%>% withSpinner(color="#FFFFFF"))
),
fluidRow(
@@ -172,10 +170,10 @@ ui <- list(
#twoscattercode, #logTransformationCode, #twobarcode, #twoboxcode
{color: #FFFFFF}"
)),
-
-
+
+
fluidRow(
- column(6,plotOutput(outputId="onebar", width="100%",height="300px")%>% withSpinner(color="#1E7B14")),
+ column(6,plotOutput(outputId="onebar", width="100%",height="300px")%>% withSpinner(color="#1E7B14")),
column(6,plotOutput(outputId="oneqq", width="100%",height="300px")%>% withSpinner(color="#1E7B14"))
),
fluidRow(
@@ -184,21 +182,21 @@ ui <- list(
),
br(),
br()
- # div(style = 'text-align: center',
- # bsButton(inputId = 'next2', label = 'Next Section',
- # icon = icon('angle-double-right'), size = 'small',
+ # div(style = 'text-align: center',
+ # bsButton(inputId = 'next2', label = 'Next Section',
+ # icon = icon('angle-double-right'), size = 'small',
# class='circle grow'))
)
)
),
-
+
###### Two Variable ######
tabPanel(title='Two Variables', value='panel2',
h3(strong('Two Variables Visualization')),
# br(),
- h4('This section illustrates R code for data
+ h4('This section illustrates R code for data
visulization uses ggplot() with Two Variables'),
-
+
br(),
sidebarLayout(
sidebarPanel(
@@ -212,23 +210,23 @@ ui <- list(
checkboxInput("previewDataTwo", "Preview of Datasets"),
selectInput(inputId="continuous1",
label="Select First Continuous Variable as X:",
- choices= c('Sepal.Length',
+ choices= c('Sepal.Length',
'Sepal.Width'),
selected = 'Sepal.Length'),
-
- selectInput(inputId="continuous2",
+
+ selectInput(inputId="continuous2",
label="Select Second Continuous Variable as Y:",
- choices= c('Petal.Length',
+ choices= c('Petal.Length',
'Petal.Width'),
selected = 'Petal.Length'),
-
- selectInput(inputId="CategoryVar",
+
+ selectInput(inputId="CategoryVar",
label="Select Categorical Variable:",
choices= 'Species',
selected = 'Species'),
-
+
),
-
+
mainPanel(
conditionalPanel(
condition="input.previewDataTwo==1",
@@ -261,12 +259,12 @@ ui <- list(
)
)
),
-
+
tabPanel(title='Exercises', value='panel2',
#uiOutput("urltest"))
#includeMarkdown("test.Rmd")
#system.file("knitr", package="shinyAce")
-
+
fluidRow(
column(6,
verticalLayout(
@@ -292,7 +290,7 @@ ui <- list(
tags$style(type='text/css', '#question{font-size: 15px;
background-color: #FFFFFF;color: black;}',
'.well { padding: 10px; margin-bottom: 15px; max-width: 1000px; }')
-
+
),
fluidPage(
tags$head(
@@ -308,8 +306,8 @@ ui <- list(
div(style="display: inline-block;vertical-align:top; width: 30px;",HTML("
")),
div(style="display: inline-block", bsButton(inputId = "reset",label = "Restart", style="danger", disabled = TRUE)))
)),
-
-
+
+
# column(3,
# actionButton(inputId = 'submit', label = 'Submit', style="success")
# ),
@@ -320,16 +318,16 @@ ui <- list(
# bsButton(inputId = "reset",label = "Restart", style="danger", )
# )),
br(),
-
+
##########try rlocker statement#########
# tags$samp(
# htmlOutput("statements")
# ),
##########end#############
-
- h2("Try Your Code"),
+
+ h2("Try Your Code"),
aceEditor("rmd", mode="markdown", value='This is some markdown text. It may also have embedded R code
-which will be executed. Please also read the output
+which will be executed. Please also read the output
message for more hints.
you can add a new code chuck with following two lines
@@ -372,32 +370,32 @@ column(6,
######Advanced
tabItem(tabName = 'exp4',
tabsetPanel(type = 'tabs',
-
+
###### Maps ######
tabPanel('Maps',
br(),
box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
-
+
selectInput(inputId = 'mapsOp', label = 'Make a US/World Map with ggplot2',
choices = c('US Map - ggplot2', 'US Map - plotly'), selected = 'US Map'),
bsPopover(id = 'mapsOp', title = " ", content = 'mUSMap takes in one dataframe that includes information about different
US states and returns this data or a ggplot object constructed with the data. mWorldMap does the same but it
takes in one dataframe that includes information about different countries.', trigger = 'click'),
-
+
# conditionalPanel('input.mapsOp == "World Map"',
# sliderInput(inputId = 'worldMap1', label = 'The Number of Color Scales', min = 1, max = 10,
# value = 5, step = 1, ticks = TRUE)
# ),
-
+
conditionalPanel('input.mapsOp == "US Map - ggplot2"',
selectInput(inputId = 'usMap1', label = 'Plot Option', choices = c('borders', 'frame')),
selectInput(inputId = 'usMap2', label = 'Style Option', choices = c('compact', 'real'))
)
-
+
),
-
+
# box(title = NULL, style = 'background-color: #f0f4c3', width=NULL, height = NULL,
-
+
conditionalPanel('input.mapsOp == "US Map - ggplot2"',
div(style = "background-color: #FFFFFF",
tags$strong('R code: '),
@@ -409,9 +407,9 @@ tabItem(tabName = 'exp4',
)
),
br()
-
+
)),
-
+
conditionalPanel('input.mapsOp == "US Map - plotly"',
div(style = "background-color: #FFFFFF",
tags$strong('R code: '),
@@ -422,33 +420,33 @@ tabItem(tabName = 'exp4',
plotlyOutput('plotlyUSMap', width='80%'))
),
br()
-
+
))
# )
),
-
+
###### 3D Plots ######
tabPanel('3D Plots',
br(),
fluidRow(
column(width = 12,
box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
- selectInput(inputId = 'Exsel', label = '3D Plot Type',
+ selectInput(inputId = 'Exsel', label = '3D Plot Type',
choices = c('Normal Simulation via Plotly', '3D Basic Scatter Plot', '3D Texts Plot'),
- # choices = c('Normal Simulation via Plotly', 'Basic Scatter Plot', 'Basic Scatter Plot Colored by Groups',
+ # choices = c('Normal Simulation via Plotly', 'Basic Scatter Plot', 'Basic Scatter Plot Colored by Groups',
# '3D Plots with Confidence Intervals', '3D Texts Plot'),
selected = 'Normal Simulation via Plotly', multiple = FALSE),
-
- # bsPopover(id = 'Exsel', title = 'Understand the Graph Type',
- # content = 'Mesh plot generates a wireframe plot while the scatter plot generates a dotted plot.',
+
+ # bsPopover(id = 'Exsel', title = 'Understand the Graph Type',
+ # content = 'Mesh plot generates a wireframe plot while the scatter plot generates a dotted plot.',
# placement = 'bottom', trigger = 'hover'),
-
+
#a. Normal Simulation via Plotly
conditionalPanel('input.Exsel == "Normal Simulation via Plotly"',
sliderInput(inputId = 'Exsel1', label = 'Please Select Your Sample Size', min = 0, max = 100,
value = 30, step = 1, ticks = TRUE)
),
-
+
#b. Basic Scatter Plot
conditionalPanel('input.Exsel == "3D Basic Scatter Plot"',
selectInput(inputId = 'basicX', label = 'Variable for X-Axis', choices = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width'),
@@ -474,7 +472,7 @@ tabItem(tabName = 'exp4',
fluidRow(
column(width = 12,
box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
-
+
#a. Normal Simulation via Plotly
conditionalPanel('input.Exsel == "Normal Simulation via Plotly"',
tags$strong('R code: '),
@@ -485,7 +483,7 @@ tabItem(tabName = 'exp4',
verbatimTextOutput("hover"),
verbatimTextOutput("click")
),
-
+
#b. Basic Scatter Plot
conditionalPanel('input.Exsel == "3D Basic Scatter Plot"',
tags$strong('R code: '),
@@ -494,18 +492,18 @@ tabItem(tabName = 'exp4',
tableOutput('bspTable'),
plotOutput('bspOut1')
),
-
+
# #c. Basic Scatter Plot Colored by Groups
# conditionalPanel('input.Exsel == "Basic Scatter Plot Colored by Groups"',
# tableOutput('bspTableCopy'),
# plotOutput('bspOut2')
# ),
-
+
# #d. 3D Plots with Confidence Intervals
# conditionalPanel('input.Exsel == "3D Plots with Confidence Intervals"',
# plotOutput('CIOut')
# ),
-
+
#e. 3D Texts Plot
conditionalPanel('input.Exsel == "3D Texts Plot"',
tags$strong('R code: '),
@@ -514,22 +512,22 @@ tabItem(tabName = 'exp4',
tableOutput('textTable'),
plotOutput('textOut')
)
-
+
)
)
)
),
-
+
###### 2D Line Plots ######
tabPanel('2D Line Plots',
br(),
fluidRow(
column(width = 12,
box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
-
+
sliderInput(inputId = 'LPsel1', label = 'Please Set the Maximum of X-Axis', min = 0, max = 200,
value = 80, step = 1, ticks = TRUE),
-
+
numericInput(inputId = 'LPnum1', label = 'Theoretical Mean of trace 0',
value = 10, step = 1),
selectInput(inputId = 'LPSEL1', label = 'Please Select Your First Graph Mode',
@@ -552,7 +550,7 @@ tabItem(tabName = 'exp4',
)
)
),
-
+
###### Contour Plots & Heat Maps ######
tabPanel('Contour Plots & Heatmaps',
br(),
@@ -565,13 +563,13 @@ tabItem(tabName = 'exp4',
)),
#box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
id="sidebarmap",
- div('Heat maps and contour plots are visualization techniques to show
- data density on a map. They are particularly helpful when you have
- a lot of data points on the map and are mainly interested in their
+ div('Heat maps and contour plots are visualization techniques to show
+ data density on a map. They are particularly helpful when you have
+ a lot of data points on the map and are mainly interested in their
overall distribution.'),
br(),
selectInput(inputId = 'chSel', label = 'Please Select Your Display Option', choices = c('', 'Contour Plots', 'Heatmaps'), selected = 'Contour Plots'),
-
+
#contour plots
conditionalPanel('input.chSel == "Contour Plots"',
selectInput(inputId = 'chSel2', label = 'View An Example', choices = c('Volcano', 'Protein-Protein Interaction')),
@@ -579,18 +577,18 @@ tabItem(tabName = 'exp4',
checkboxInput(inputId = 'contourLabel', label = 'Add Contour Labels', value = FALSE)
)
),
-
+
#heat maps
conditionalPanel('input.chSel == "Heatmaps"',
selectInput(inputId = 'heat1', label = 'View An Example', choices = c('Volcano', 'Cars')),
conditionalPanel('input.heat1 == "Volcano"',
- sliderTextInput(inputId = 'heatmapCol', label = 'Please Select Your Colorscale',
+ sliderTextInput(inputId = 'heatmapCol', label = 'Please Select Your Colorscale',
choices = c('purple+green', 'yellow+red', 'pink+purple', 'white+black'), grid = TRUE)
)
)
#)
),
-
+
mainPanel(
box(title = NULL, style = 'background-color: #FFFFFF', width = NULL, height = NULL,
conditionalPanel('input.chSel == "Contour Plots"',
@@ -606,9 +604,9 @@ tabItem(tabName = 'exp4',
conditionalPanel('input.chSel2 == "Protein-Protein Interaction"',
plotOutput('proteinInt')
)
-
+
),
-
+
conditionalPanel('input.chSel == "Heatmaps"',
conditionalPanel('input.heat1 == "Volcano"',
tags$strong('R Code: '),
@@ -631,28 +629,28 @@ tabItem(
tabName = "References",
withMathJax(),
h2("References"),
-
+
p('The Protein-Protein Interaction Dataset is from the Warwick University - Molecular Organisation and Assembly in Cells.'),
-
+
p(class = "hangingindent",
- "Attali, D. (2020).
- shinyjs: Easily Improve the User Experience of Your Shiny Apps in Seconds, R package.
+ "Attali, D. (2020).
+ shinyjs: Easily Improve the User Experience of Your Shiny Apps in Seconds, R package.
Available from https://CRAN.R-project.org/package=shinyjs"),
p(class = "hangingindent",
"Chang, W. and Borges Ribeiro, B. (2018),
- shinydashboard: Create Dashboards with 'Shiny', R package.
+ shinydashboard: Create Dashboards with 'Shiny', R package.
Available from https://CRAN.R-project.org/package=shinydashboard"),
p(class = "hangingindent",
"Chang, W., Cheng, J., Allaire, J., Xie, Y., and MchPherson, J. (2020),
shiny: Web Application Framework for R, R package.
Available from https://CRAN.R-project.org/package=shiny"),
p(class = "hangingindent",
- "Bailey, E. (2015).
+ "Bailey, E. (2015).
shinyBS: Twitter Bootstrap Components for Shiny, R package.
Available from https://CRAN.R-project.org/package=shinyBS"),
p(class = "hangingindent",
- "Perrier, V., Meyer, F., and Granjon, D. (2020).
- shinyWidgets: Custom Inputs Widgets for Shiny, R package.
+ "Perrier, V., Meyer, F., and Granjon, D. (2020).
+ shinyWidgets: Custom Inputs Widgets for Shiny, R package.
Available from https://CRAN.R-project.org/package=shinyWidgets"),
p(class = "hangingindent",
"Sievert, C. (2020).
@@ -664,7 +662,7 @@ tabItem(
Springer-Verlag New York, 2016."
),
p(class = "hangingindent",
- "Nijs, V., Fang, F., Trestle Technology, LLC and Allen, J. (2019).
+ "Nijs, V., Fang, F., Trestle Technology, LLC and Allen, J. (2019).
shinyAce: Ace Editor Bindings for Shiny, R package.
Available from https://CRAN.R-project.org/package=shinyAce"
),
@@ -674,16 +672,16 @@ tabItem(
https://CRAN.R-project.org/package=shinycssloaders"
),
p(class = "hangingindent",
- "Carey R. (2019).
- rlocker: Learning Locker for Shiny, R package.
+ "Carey R. (2019).
+ rlocker: Learning Locker for Shiny, R package.
Available from https://github.com/rpc5102/rlocker"),
p(class = "hangingindent",
"Carey, R. and Hatfield, N. (2020). boastUtils: BOAST Utilities. R
package version 0.1.4.
https://github.com/EducationShinyAppTeam/boastUtils"
)
-
-
+
+
)
)
@@ -691,39 +689,39 @@ tabItem(
server <- function(input, output, session) {
# Initialize Learning Locker connection
- connection <- rlocker::connect(
- session,
- list(
- base_url = "https://learning-locker.stat.vmhost.psu.edu/",
- auth = "Basic ZDQ2OTNhZWZhN2Q0ODRhYTU4OTFmOTlhNWE1YzBkMjQxMjFmMGZiZjo4N2IwYzc3Mjc1MzU3MWZkMzc1ZDliY2YzOTNjMGZiNzcxOThiYWU2",
- agent = rlocker::createAgent()
- )
- )
-
- # Setup demo app and user.
- currentUser <-
- connection$agent
-
- if (connection$status != 200) {
- warning(paste(connection$status, "\nTry checking your auth token."))
- }
-
+ # connection <- rlocker::connect(
+ # session,
+ # list(
+ # base_url = "https://learning-locker.stat.vmhost.psu.edu/",
+ # auth = "Basic ZDQ2OTNhZWZhN2Q0ODRhYTU4OTFmOTlhNWE1YzBkMjQxMjFmMGZiZjo4N2IwYzc3Mjc1MzU3MWZkMzc1ZDliY2YzOTNjMGZiNzcxOThiYWU2",
+ # agent = rlocker::createAgent()
+ # )
+ # )
+ #
+ # # Setup demo app and user.
+ # currentUser <-
+ # connection$agent
+ #
+ # if (connection$status != 200) {
+ # warning(paste(connection$status, "\nTry checking your auth token."))
+ # }
+
##############end#########
output$Previewcar <-
renderTable({
head(cars, 4)
}, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
-
+
output$Previewtree <-
renderTable({
head(trees, 4)
}, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
-
+
output$Previewiris <-
renderTable({
head(iris, 4)
}, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
-
+
###KNITR
observeEvent(input$eval, {
withBusyIndicatorServer("eval", {
@@ -736,13 +734,13 @@ server <- function(input, output, session) {
)
)))
})
-
+
output$output <- renderPrint({
return(isolate(eval(parse(text = input$code))))
})
})
})
-
+
output$knitDoc <- renderUI({
input$eval
return(isolate(HTML(
@@ -753,12 +751,12 @@ server <- function(input, output, session) {
)
)))
})
-
+
output$output <- renderPrint({
input$eval
return(isolate(eval(parse(text = input$code))))
})
-
+
observeEvent(input$info0, {
sendSweetAlert(
session = session,
@@ -778,11 +776,11 @@ server <- function(input, output, session) {
observeEvent(input$go2, {
updateTabItems(session, 'tabs', 'VisualOne')
})
-
+
observeEvent(input$next2, {
updateTabsetPanel(session, 'VisualOne', selected = 'panel2')
})
-
+
############ Data Visualization ############
###########One Single Variable Plot##############
output$oneDensity <-
@@ -845,7 +843,7 @@ server <- function(input, output, session) {
alpha = 0.4) +
ggtitle('Density Plot')
}
-
+
}
else if (input$treesVariable == 'Volume') {
if (input$plotType == 'plot') {
@@ -860,7 +858,7 @@ server <- function(input, output, session) {
alpha = 0.4) +
ggtitle('Density Plot')
}
-
+
}
}
},
@@ -870,7 +868,7 @@ server <- function(input, output, session) {
input$plotType,
input$treesVariable)
})
-
+
output$onehist <- renderCachedPlot({
if (input$dataset == 'cars') {
if (input$carsVariable == 'speed') {
@@ -900,7 +898,7 @@ server <- function(input, output, session) {
alpha = 0.4) +
ggtitle("Histogram")
}
-
+
}
}
else if (input$dataset == 'trees') {
@@ -945,7 +943,7 @@ server <- function(input, output, session) {
alpha = 0.4) +
ggtitle("Histogram")
}
-
+
}
}
},
@@ -955,7 +953,7 @@ server <- function(input, output, session) {
input$carsVariable,
input$treesVariable)
})
-
+
output$onebar <-
renderCachedPlot({
if (input$dataset == 'cars') {
@@ -996,7 +994,7 @@ server <- function(input, output, session) {
) +
ggtitle('Frequency polygon')
}
-
+
}
}
else if (input$dataset == 'trees') {
@@ -1037,7 +1035,7 @@ server <- function(input, output, session) {
) +
ggtitle('Frequency polygon')
}
-
+
}
else if (input$treesVariable == 'Volume') {
if (input$plotType == 'plot') {
@@ -1065,7 +1063,7 @@ server <- function(input, output, session) {
input$carsVariable,
input$treesVariable)
})
-
+
output$oneqq <-
renderCachedPlot({
if (input$dataset == 'cars') {
@@ -1143,7 +1141,7 @@ server <- function(input, output, session) {
input$carsVariable,
input$treesVariable)
})
-
+
output$DensityoneCode <- renderText({
if (input$dataset == 'cars') {
if (input$plotType == 'plot') {
@@ -1194,7 +1192,7 @@ server <- function(input, output, session) {
}
}
})
-
+
output$HistogramoneCode <- renderText({
if (input$dataset == 'cars') {
if (input$plotType == 'plot') {
@@ -1241,7 +1239,7 @@ server <- function(input, output, session) {
}
}
})
-
+
output$BarCode <- renderText({
if (input$dataset == 'cars') {
if (input$plotType == 'plot') {
@@ -1290,7 +1288,7 @@ server <- function(input, output, session) {
}
}
})
-
+
output$qqCode <- renderText({
if (input$dataset == 'cars') {
if (input$plotType == 'plot') {
@@ -1349,7 +1347,7 @@ server <- function(input, output, session) {
seq = ''
)
}
-
+
}
})
###########Two Variables########
@@ -1393,8 +1391,8 @@ server <- function(input, output, session) {
}, cacheKeyExpr = {
list(input$continuous1, input$continuous2)
})
-
-
+
+
output$logTransformation <- renderCachedPlot({
if (input$continuous1 == 'Sepal.Length') {
if (input$continuous2 == 'Petal.Length') {
@@ -1430,7 +1428,7 @@ server <- function(input, output, session) {
}, cacheKeyExpr = {
list(input$continuous1, input$continuous2)
})
-
+
output$twobar <- renderCachedPlot({
if (input$continuous1 == 'Sepal.Length') {
if (input$continuous2 == 'Petal.Length') {
@@ -1479,8 +1477,8 @@ server <- function(input, output, session) {
}, cacheKeyExpr = {
list(input$continuous1, input$continuous2)
})
-
-
+
+
output$twobox <- renderCachedPlot({
if (input$continuous1 == 'Sepal.Length') {
if (input$continuous2 == 'Petal.Length') {
@@ -1529,7 +1527,7 @@ server <- function(input, output, session) {
}, cacheKeyExpr = {
list(input$continuous1, input$continuous2)
})
-
+
output$twoscattercode <- renderText({
paste(
'R Code:',
@@ -1544,7 +1542,7 @@ server <- function(input, output, session) {
seq = ''
)
})
-
+
output$logTransformationCode <- renderText({
paste(
'R Code:',
@@ -1559,7 +1557,7 @@ server <- function(input, output, session) {
seq = ''
)
})
-
+
output$twobarcode <- renderText({
paste(
'R Code:',
@@ -1573,7 +1571,7 @@ server <- function(input, output, session) {
seq = ''
)
})
-
+
output$twoboxcode <- renderText({
paste(
'R Code:',
@@ -1587,8 +1585,8 @@ server <- function(input, output, session) {
seq = ''
)
})
-
-
+
+
###########Exercises Part###################
# observeEvent(input$submit, {
# updateButton(session, "nextq", disabled = FALSE)
@@ -1597,7 +1595,7 @@ server <- function(input, output, session) {
# observeEvent(input$submit, {
# updateButton(session, "submit", disabled = TRUE)
# })
-
+
observeEvent(input$nextq, {
# updateButton(session, "submit", disabled = FALSE)
# updateButton(session, "nextq", disabled = TRUE)
@@ -1609,8 +1607,8 @@ server <- function(input, output, session) {
img(src = NULL, width = 30)
})
})
-
-
+
+
#### question bank ####
value <- reactiveValues(index = 1,
mistake = 0,
@@ -1618,57 +1616,57 @@ server <- function(input, output, session) {
ans <- as.matrix(bank[1:14, 6])
#ans <- data.frame(ans)
index_list <- reactiveValues(list = sample(2:14, 10, replace = FALSE))
-
+
observeEvent(input$nextq, {
value$answerbox <- value$index
index_list$list = index_list$list[-1]
value$index <- index_list$list[1]
value$answerbox <- value$index
-
+
updateButton(session, "nextq", disabled = TRUE)
updateButton(session, "submit", disabled = FALSE)
})
-
+
output$question <- renderUI({
h4(bank[value$index, 2])
# radioButtons(inputId = bank[value$index,1], label= bank[value$index, 2],
# choiceNames=c(bank[value$index, 3], bank[value$index, 4], bank[value$index, 5]),
# choiceValues = c("A", "B", "C"))
})
-
+
output$options <- renderUI({
str1 <- paste("A.", bank[value$index, 3])
str2 <- paste("B.", bank[value$index, 4])
str3 <- paste("C.", bank[value$index, 5])
HTML(paste(str1, str2, str3, sep = '
'))
})
-
-
- observeEvent(input$answer, {
- req(input$answer, input$answer != '')
- answer <- isolate(input$answer)
- interacted_statement <- rlocker::createStatement(list(
- verb = list(display = "interacted"),
- object = list(
- id = paste0(getCurrentAddress(session), "#", value$index),
- name = paste('Question', value$index),
- description = bank[value$index, 2]
-
- ),
- result = list(
- success = NA,
- response = paste(getResponseText(value$index, answer))
- )
- ))
-
- # Store statement in locker and return status
- status <- rlocker::store(session, interacted_statement)
-
- print(interacted_statement) # remove me
- print(status) # remove me
- })
-
-
+
+
+ # observeEvent(input$answer, {
+ # req(input$answer, input$answer != '')
+ # answer <- isolate(input$answer)
+ # interacted_statement <- rlocker::createStatement(list(
+ # verb = list(display = "interacted"),
+ # object = list(
+ # id = paste0(getCurrentAddress(session), "#", value$index),
+ # name = paste('Question', value$index),
+ # description = bank[value$index, 2]
+ #
+ # ),
+ # result = list(
+ # success = NA,
+ # response = paste(getResponseText(value$index, answer))
+ # )
+ # ))
+ #
+ # # Store statement in locker and return status
+ # status <- rlocker::store(session, interacted_statement)
+ #
+ # print(interacted_statement) # remove me
+ # print(status) # remove me
+ # })
+
+
getResponseText <- function(index, answer) {
if (answer == 'A') {
key = 3
@@ -1679,7 +1677,7 @@ server <- function(input, output, session) {
}
return(bank[index, key])
}
-
+
observeEvent(input$submit, {
if (length(index_list$list) == 1) {
updateButton(session, "nextq", disabled = TRUE)
@@ -1691,32 +1689,32 @@ server <- function(input, output, session) {
updateButton(session, "submit", disabled = TRUE)
updateButton(session, "reset", disabled = FALSE)
}
-
+
# output$progress<-renderUI({
# paste("You are currently on problem", 11-length(index_list$list), "/10")
# })
-
+
answer <- isolate(input$answer)
-
- statement <- rlocker::createStatement(list(
- verb = list(display = "answered"),
- object = list(
- id = paste0(getCurrentAddress(session), "#", value$index),
- name = paste('Question', value$index),
- description = bank[value$index, 2]
- ),
- result = list(
- success = any(answer == ans[value$index, 1]),
- response = paste(getResponseText(value$index, answer))
- )
- ))
-
- # Store statement in locker and return status
- status <- rlocker::store(session, statement)
-
- print(statement) # remove me
- print(status) # remove me
-
+
+ # statement <- rlocker::createStatement(list(
+ # verb = list(display = "answered"),
+ # object = list(
+ # id = paste0(getCurrentAddress(session), "#", value$index),
+ # name = paste('Question', value$index),
+ # description = bank[value$index, 2]
+ # ),
+ # result = list(
+ # success = any(answer == ans[value$index, 1]),
+ # response = paste(getResponseText(value$index, answer))
+ # )
+ # ))
+ #
+ # # Store statement in locker and return status
+ # status <- rlocker::store(session, statement)
+ #
+ # print(statement) # remove me
+ # print(status) # remove me
+
output$mark <- renderUI({
if (any(answer == ans[value$index, 1])) {
img(src = "correct.png", width = 30)
@@ -1729,7 +1727,7 @@ server <- function(input, output, session) {
}
})
})
-
+
observeEvent(input$reset, {
updateButton(session, "submit", disabled = FALSE)
updateButton(session, "reset", disable = TRUE)
@@ -1746,7 +1744,7 @@ server <- function(input, output, session) {
img(src = NULL, width = 30)
})
})
-
+
###### Maps ######
#a. usMap
output$usMapOut1 <- renderCachedPlot({
@@ -1790,7 +1788,7 @@ server <- function(input, output, session) {
}, cacheKeyExpr = {
list(input$usMap1, input$usMap2)
})
-
+
output$usMapOut2 <- renderUI ({
tags$code(
'mUSMap(USArrests2, key = "state", fill = "UrbanPop", plot = "',
@@ -1800,12 +1798,12 @@ server <- function(input, output, session) {
'")'
)
})
-
+
#plotly US Map - code
output$plotlyUScode <- renderUI ({
tags$code('p <- plot_geo(df, locationmode = "USA-states", sizes = c(1, 250))')
})
-
+
#plotly US Map
output$plotlyUSMap <- renderPlotly({
df <-
@@ -1816,7 +1814,7 @@ server <- function(input, output, session) {
levels(df$q) <-
paste(c("1st", "2nd", "3rd", "4th", "5th"), "Quantile")
df$q <- as.ordered(df$q)
-
+
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
@@ -1827,7 +1825,7 @@ server <- function(input, output, session) {
subunitcolor = toRGB("white"),
countrycolor = toRGB("white")
)
-
+
p <-
plot_geo(df, locationmode = 'USA-states', sizes = c(1, 250)) %>%
add_markers(
@@ -1842,8 +1840,8 @@ server <- function(input, output, session) {
g
p
})
-
-
+
+
###### 3D Plots ######
#a. Normal Simulation via Plotly
output$plotly1 <- renderPlotly ({
@@ -1855,7 +1853,7 @@ server <- function(input, output, session) {
mode = 'markers'
)
})
-
+
output$ExCode <- renderUI ({
tags$code(
'plot_ly(x = rnorm(',
@@ -1867,8 +1865,8 @@ server <- function(input, output, session) {
'), type = "scatter3d", mode = "markers")'
)
})
-
-
+
+
output$hover <- renderPrint({
dataHover <- event_data("plotly_hover")
if (is.null(dataHover)) {
@@ -1878,7 +1876,7 @@ server <- function(input, output, session) {
dataHover
}
})
-
+
output$click <- renderPrint({
dataClick <- event_data("plotly_click")
if (is.null(dataClick)) {
@@ -1888,7 +1886,7 @@ server <- function(input, output, session) {
dataClick
}
})
-
+
# output$ExCode <- renderUI ({
# if (input$Exsel == 'Scatter Plot') {
# tags$code('plot_ly(x = rnorm(', input$Exsel1, '), y = rnorm(', input$Exsel1, '), z = rnorm(', input$Exsel1, '), type = "scatter3d", mode = "markers")')
@@ -1900,18 +1898,18 @@ server <- function(input, output, session) {
# tags$code('plot_ly(x = rnorm(', input$Exsel1, '), y = rnorm(', input$Exsel1, '), z = rnorm(', input$Exsel1, '), type = "mesh3d", mode = "markers")')
# }
# })
-
+
#b. Basic Scatter Plot
output$basicRcode <- renderUI ({
tags$code(
'scatter3D(x, y, z, clab = c("Sepal", "Width (cm)"), xlab = input$basicX, ylab = input$basicY, zlab = input$basicZ)'
)
})
-
+
output$bspTable <- renderTable ({
head(iris)
})
-
+
output$bspOut1 <- renderPlot({
x <- iris[, input$basicX]
y <- iris[, input$basicY]
@@ -1926,7 +1924,7 @@ server <- function(input, output, session) {
zlab = input$basicZ
)
})
-
+
# #c.
# output$bspTableCopy <- renderTable ({
# head(iris)
@@ -1941,7 +1939,7 @@ server <- function(input, output, session) {
# addlines = TRUE, length = 0.5, width = 0.5,
# labels = c("setosa", "versicolor", "virginica")) )
# })
-
+
# #d. 3D Plots with Confidence Intervals
# output$CIOut <- renderPlot ({
# x <- iris[, input$CIX]
@@ -1952,7 +1950,7 @@ server <- function(input, output, session) {
# scatter3D(x, y, z, phi = 0, bty = "g", col = gg.col(100),
# pch = 18, CI = CI)
# })
-
+
#e. 3D Texts Plot
output$textRcode <- renderUI ({
tags$code(
@@ -1965,11 +1963,11 @@ server <- function(input, output, session) {
clab = c("Urban","Pop"), adj = 0.5, font = 2))'
)
})
-
+
output$textTable <- renderTable ({
head(USArrests)
})
-
+
output$textOut <- renderPlot ({
data(USArrests)
with(
@@ -1997,7 +1995,7 @@ server <- function(input, output, session) {
)
)
})
-
+
###### 2D Line Plots ######
output$plotly2 <- renderPlotly ({
trace_0 <-
@@ -2060,14 +2058,14 @@ server <- function(input, output, session) {
mode = 'lines')
}
})
-
+
output$LPCode <- renderUI ({
tags$code(
'plot_ly(data, x = ~x, y = ~trace_0, name = "trace 0", type = "scatter", mode = "lines") %>%
add_trace(y = ~trace_1, name = "trace 1", mode = "markers + lines")'
)
})
-
+
###### Contour Plots and Heatmaps ######
#contour plot
output$proteinInt <- renderPlot ({
@@ -2080,30 +2078,30 @@ server <- function(input, output, session) {
matrix.axes <- function(data) {
# Do the rows, las=2 for text perpendicular to the axis
x <- (1:dim(data)[1] - 1) / (dim(data)[1] - 1)
-
+
axis(
side = 1,
at = x,
labels = rownames(data),
las = 2
)
-
+
# Do the columns
x <- (1:dim(data)[2] - 1) / (dim(data)[2] - 1)
-
+
axis(
side = 2,
at = x,
labels = colnames(data),
las = 2
)
-
+
}
filled.contour(potentials,
plot.axes = matrix.axes(potentials),
main = "Protein-Protein Interaction Potential")
})
-
+
output$plotly3 <- renderPlotly({
if (input$contourLabel == FALSE) {
plot_ly(z = volcano,
@@ -2119,7 +2117,7 @@ server <- function(input, output, session) {
)
}
})
-
+
#contour plot r code
output$CPCode1 <- renderUI ({
if (input$contourLabel == FALSE) {
@@ -2133,7 +2131,7 @@ server <- function(input, output, session) {
)
}
})
-
+
#heatmap
output$plotly4 <- renderPlotly({
if (input$heatmapCol == 'purple+green') {
@@ -2157,7 +2155,7 @@ server <- function(input, output, session) {
colors = colorRamp(c("white", "black")))
}
})
-
+
#heatmaps r code
output$CPCode2 <- renderUI ({
if (input$heatmapCol == 'purple+green') {
@@ -2175,7 +2173,7 @@ server <- function(input, output, session) {
tags$code('plot_ly(z = volcano, type = "heatmap", colors = colorRamp(c("white", "black")))')
}
})
-
+
output$cars1 <- renderPlotly ({
head(mtcars)
data = as.matrix(mtcars)
@@ -2189,7 +2187,7 @@ server <- function(input, output, session) {
type = "heatmap"
)
})
-
+
}
# Boast App Call ----
-boastUtils::boastApp(ui = ui, server = server)
\ No newline at end of file
+boastUtils::boastApp(ui = ui, server = server)
From 7f0ce3be4e859a01b39c7d08b8ac99f78c60bea6 Mon Sep 17 00:00:00 2001
From: ymy5178
Date: Tue, 7 Jun 2022 17:05:34 -0400
Subject: [PATCH 03/21] preview & three buttons in exercises & font in
headings & reference & misspelling
preview datasets button can work now.
submit next restart buttons in exercises can work now.
correct the sequence of reference and some misspelling
make the font of headings of one variable and two variables the same.
add description in readme.
change the chapter number in description.
change the screenshot.
The last problem left is to show codes of one variable and two variables.
---
DESCRIPTION | 4 +-
README.md | 7 --
app.R | 183 ++++++++++++++++++----------------
LICENSE.md => docs/LICENSE.md | 0
docs/README.md | 10 ++
docs/screenshot.PNG | Bin 0 -> 235437 bytes
figure/unnamed-chunk-5-1.png | Bin 21424 -> 2939 bytes
7 files changed, 108 insertions(+), 96 deletions(-)
delete mode 100644 README.md
rename LICENSE.md => docs/LICENSE.md (100%)
create mode 100644 docs/README.md
create mode 100644 docs/screenshot.PNG
diff --git a/DESCRIPTION b/DESCRIPTION
index 6d0a240..8e3756c 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,12 +1,12 @@
Title: Data Visualization
ShortName: Data Visualization
-Date: 2021-10-11
+Date: 2022-06-07
Lifecycle: experimental
Authors@R: c(
person(given = "Neil", family = "Hatfield", email = "neil.hatfield@psu.edu", role = c("aut", "cre")),
person(given = "Robert", family = "Carey", email = "rpc5102@psu.edu", role = c("aut"))
)
-Chapter: Data Science
+Chapter: Chapter 11
Description: This app is focused on the common types of xyz.
LearningObjectives: c(
"The student will learn to understand Concept A in way z.",
diff --git a/README.md b/README.md
deleted file mode 100644
index dea7fd5..0000000
--- a/README.md
+++ /dev/null
@@ -1,7 +0,0 @@
-# Data Visualization App
-
-[](https://creativecommons.org/licenses/by-nc-sa/4.0/)  
-
-
-
-APP_DESCRIPTION
diff --git a/app.R b/app.R
index 3c78d6e..7130ec0 100644
--- a/app.R
+++ b/app.R
@@ -20,6 +20,7 @@ library(knitr)
library(rmarkdown)
library(shinyAce)
library(ggmap)
+library(rLocker)
source("helpers.R")
@@ -97,7 +98,7 @@ ui <- list(
h1(strong('One Variable Visualization')),
# br(),
p('This section illustrates R code for data
- visulization includes plot() and ggplot() with one Variable'),
+ visualization includes plot() and ggplot() with one Variable'),
br(),
sidebarLayout(
@@ -192,10 +193,10 @@ ui <- list(
###### Two Variable ######
tabPanel(title='Two Variables', value='panel2',
- h3(strong('Two Variables Visualization')),
+ h1(strong('Two Variables Visualization')),#change h3 to h1
# br(),
- h4('This section illustrates R code for data
- visulization uses ggplot() with Two Variables'),
+ p('This section illustrates R code for data
+ visualization uses ggplot() with Two Variables'), #change h4 to p
br(),
sidebarLayout(
@@ -633,55 +634,50 @@ tabItem(
p('The Protein-Protein Interaction Dataset is from the Warwick University - Molecular Organisation and Assembly in Cells.'),
p(class = "hangingindent",
- "Attali, D. (2020).
- shinyjs: Easily Improve the User Experience of Your Shiny Apps in Seconds, R package.
+ "Attali, D. (2020).
+ shinyjs: Easily Improve the User Experience of Your Shiny Apps in Seconds, R package.
Available from https://CRAN.R-project.org/package=shinyjs"),
+ p(class = "hangingindent",
+ "Bailey, E. (2015).
+ shinyBS: Twitter Bootstrap Components for Shiny, R package.
+ Available from https://CRAN.R-project.org/package=shinyBS"),
+ p(class = "hangingindent",
+ "Carey R. (2019).
+ rlocker: Learning Locker for Shiny, R package.
+ Available from https://github.com/rpc5102/rlocker"),
+ p(class = "hangingindent",
+ "Carey, R. and Hatfield, N. (2020). boastUtils: BOAST Utilities. R
+ package version 0.1.4.
+ https://github.com/EducationShinyAppTeam/boastUtils"),
p(class = "hangingindent",
"Chang, W. and Borges Ribeiro, B. (2018),
- shinydashboard: Create Dashboards with 'Shiny', R package.
+ shinydashboard: Create Dashboards with 'Shiny', R package.
Available from https://CRAN.R-project.org/package=shinydashboard"),
p(class = "hangingindent",
"Chang, W., Cheng, J., Allaire, J., Xie, Y., and MchPherson, J. (2020),
shiny: Web Application Framework for R, R package.
Available from https://CRAN.R-project.org/package=shiny"),
p(class = "hangingindent",
- "Bailey, E. (2015).
- shinyBS: Twitter Bootstrap Components for Shiny, R package.
- Available from https://CRAN.R-project.org/package=shinyBS"),
+ "Nijs, V., Fang, F., Trestle Technology, LLC and Allen, J. (2019).
+ shinyAce: Ace Editor Bindings for Shiny, R package.
+ Available from https://CRAN.R-project.org/package=shinyAce"),
p(class = "hangingindent",
- "Perrier, V., Meyer, F., and Granjon, D. (2020).
- shinyWidgets: Custom Inputs Widgets for Shiny, R package.
+ "Perrier, V., Meyer, F., and Granjon, D. (2020).
+ shinyWidgets: Custom Inputs Widgets for Shiny, R package.
Available from https://CRAN.R-project.org/package=shinyWidgets"),
+ p(class = "hangingindent",
+ "Sali, A. and Attali D. (2020). shinycssloaders: Add CSS Loading
+ Animations to 'shiny' Outputs, R package.
+ https://CRAN.R-project.org/package=shinycssloaders"),
p(class = "hangingindent",
"Sievert, C. (2020).
plotly: Interactive Web-Based Data Visualization with R, plotly, and
- shiny. Chapman and Hall/CRC Florida, 2020."
- ),
+ shiny. Chapman and Hall/CRC Florida, 2020."),
p(class = "hangingindent",
"Wickham, H., ggplot2: Elegant Graphics for Data Analysis, R package.
Springer-Verlag New York, 2016."
- ),
- p(class = "hangingindent",
- "Nijs, V., Fang, F., Trestle Technology, LLC and Allen, J. (2019).
- shinyAce: Ace Editor Bindings for Shiny, R package.
- Available from https://CRAN.R-project.org/package=shinyAce"
- ),
- p(class = "hangingindent",
- "Sali, A. and Attali D. (2020). shinycssloaders: Add CSS Loading
- Animations to 'shiny' Outputs, R package.
- https://CRAN.R-project.org/package=shinycssloaders"
- ),
- p(class = "hangingindent",
- "Carey R. (2019).
- rlocker: Learning Locker for Shiny, R package.
- Available from https://github.com/rpc5102/rlocker"),
- p(class = "hangingindent",
- "Carey, R. and Hatfield, N. (2020). boastUtils: BOAST Utilities. R
- package version 0.1.4.
- https://github.com/EducationShinyAppTeam/boastUtils"
)
-
)
)
@@ -707,21 +703,31 @@ server <- function(input, output, session) {
# }
##############end#########
- output$Previewcar <-
- renderTable({
- head(cars, 4)
- }, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
-
- output$Previewtree <-
- renderTable({
- head(trees, 4)
- }, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
-
+ output$dataTable <- DT::renderDataTable({
+ if(input$dataset == "cars")
+ cars
+ else
+ trees
+ })
+
+ #output$Previewcar <- #previous
+ #renderTable({
+ #head(cars, 4)
+ #}, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
+
+ #output$Previewtree <- #previous
+ #renderTable({
+ #head(trees, 4)
+ #}, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
+
+ #output$Previewiris <- #previous
+ #renderTable({
+ #head(iris, 4)
+ #}, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
output$Previewiris <-
- renderTable({
- head(iris, 4)
- }, striped = TRUE, hover = TRUE, bordered = TRUE, spacing = 'xs')
-
+ DT::renderDataTable({
+ iris
+ })
###KNITR
observeEvent(input$eval, {
withBusyIndicatorServer("eval", {
@@ -1603,9 +1609,11 @@ server <- function(input, output, session) {
"answer",
"pick an answer from below",
c("", "A", "B", "C"))
+
output$mark <- renderUI({
img(src = NULL, width = 30)
})
+ disable("submit")
})
@@ -1642,29 +1650,30 @@ server <- function(input, output, session) {
})
- # observeEvent(input$answer, {
- # req(input$answer, input$answer != '')
- # answer <- isolate(input$answer)
- # interacted_statement <- rlocker::createStatement(list(
- # verb = list(display = "interacted"),
- # object = list(
- # id = paste0(getCurrentAddress(session), "#", value$index),
- # name = paste('Question', value$index),
- # description = bank[value$index, 2]
- #
- # ),
- # result = list(
- # success = NA,
- # response = paste(getResponseText(value$index, answer))
- # )
- # ))
- #
- # # Store statement in locker and return status
- # status <- rlocker::store(session, interacted_statement)
- #
- # print(interacted_statement) # remove me
- # print(status) # remove me
- # })
+ observeEvent(input$answer, {
+ req(input$answer, input$answer != '')
+ answer <- isolate(input$answer)
+ interacted_statement <- rLocker::createStatement(list(
+ verb = list(display = "interacted"),
+ object = list(
+ id = paste0(getCurrentAddress(session), "#", value$index),
+ name = paste('Question', value$index),
+ description = bank[value$index, 2]
+
+ ),
+ result = list(
+ success = NA,
+ response = paste(getResponseText(value$index, answer))
+ )
+ ))
+
+ # Store statement in locker and return status
+ status <- rLocker::store(session, interacted_statement)
+ enable("submit") #change
+
+ #print(interacted_statement) # remove me
+ #print(status) # remove me
+ })
getResponseText <- function(index, answer) {
@@ -1696,24 +1705,24 @@ server <- function(input, output, session) {
answer <- isolate(input$answer)
- # statement <- rlocker::createStatement(list(
- # verb = list(display = "answered"),
- # object = list(
- # id = paste0(getCurrentAddress(session), "#", value$index),
- # name = paste('Question', value$index),
- # description = bank[value$index, 2]
- # ),
- # result = list(
- # success = any(answer == ans[value$index, 1]),
- # response = paste(getResponseText(value$index, answer))
- # )
- # ))
+ statement <- rLocker::createStatement(list(
+ verb = list(display = "answered"),
+ object = list(
+ id = paste0(getCurrentAddress(session), "#", value$index),
+ name = paste('Question', value$index),
+ description = bank[value$index, 2]
+ ),
+ result = list(
+ success = any(answer == ans[value$index, 1]),
+ response = paste(getResponseText(value$index, answer))
+ )
+ ))
#
# # Store statement in locker and return status
- # status <- rlocker::store(session, statement)
- #
- # print(statement) # remove me
- # print(status) # remove me
+ status <- rLocker::store(session, statement)
+
+ print(statement) # remove me
+ print(status) # remove me
output$mark <- renderUI({
if (any(answer == ans[value$index, 1])) {
diff --git a/LICENSE.md b/docs/LICENSE.md
similarity index 100%
rename from LICENSE.md
rename to docs/LICENSE.md
diff --git a/docs/README.md b/docs/README.md
new file mode 100644
index 0000000..969695d
--- /dev/null
+++ b/docs/README.md
@@ -0,0 +1,10 @@
+# Data Visualization App
+
+[](https://creativecommons.org/licenses/by-nc-sa/4.0/) 
+
+
+
+
+# APP_DESCRIPTION
+
+The goal of this app is to let users familiar with graphing codes.
diff --git a/docs/screenshot.PNG b/docs/screenshot.PNG
new file mode 100644
index 0000000000000000000000000000000000000000..762ad86b37a581854d569071da19a0c82bbf8e23
GIT binary patch
literal 235437
zcmeFZXH-*b*ESkZR8X1_P!JFsC?YCNdIu3{A|N$_(g}#vgeppJ3P_cbP^H(mx#!$l&T=zZiS+47va~Y(erbJD}LInbW
zsFfeeKLLTxq=G;vE6$t(?%>|Pe+K+P=J-TO7F5uEX%YD1q=k&C3;Gc%YoDThbtpC-3iV^cBK~G
z@f-E939kF@E5_#Chu)<+J%%7kP&Mfe9gx<@ZTG(kU`*CqC(29?`*=)q%pr&3;H
z)Ig{A>~((F_SLyH;ZHAgMD1|jONtAnM3*?s=R$f~l=|al?QaWnO?WyNLFv7P;o0#A
zb8@{UKL@XyALOcsWme7a&gw$$C5DQjdJe}|-$dOJD6Bu$_lOP^f#M0CqYHu|qt@(b
zRj!;R1#FlCRx6wB&xkS=gAW}E$73g-vFkR%F*XTI38!n6$hj$Qvq)2}A4dAk#fh~h
zg2RWeRfZqCgq@`k5|$#QimZ0$`u3k5EsmI==cuA`?eRoz6|)M>J}I?@+50pY-5`s$
ztr77-E}4A$WMz&vP~=kM`qzL>%Jv#4rY;7>LpiS;i>S3F0l(*e^B2ZDlo{azjP_jd`ajR;mIA8SYyeq(6UmlvSxYsU+4P9NVB8Iv!b
zmSXm0ac};}c1fQNR8)QUpLr3z8b#)sGeTyrVwnfoXp=o0$~_l$D@NCE{8|qaZ%!^(
zL@OkYwZ}-tB-o+(MZ3SzGf+-r#oun(K#^yxE+p-g>9
zaCyB}8^3=3)@^-M)3Qg`#jo34Wl6Fp@d$Z|kI(RIVviAEKi%7++hWF!@FLzDDj+`)
z6)N+j2HiiIyEr~aF;^dYo-pK4qilA{4!-dIvw@iTTwFq7DxpG8)
zys5&J@byIm4GKzn(1q9iRp#wBg)Ig)ouSP0@f@G3T#KNQcCi}OB7&FHv)M9#?{Hsw
zW4=Q%PPK&%=Ty#~&sWCw$AJ!y(4e8V0|o)U4Erg^28Dj3rp+riK3UK4dfh8{usuyv
zJcE(~V$K>rqf94l^@0^Fy&m9;QT==`Sr%&aF;H~=O=8#9e9FC$Sl+O?(uIbn@6CY7
z3zFME#MhqaT#ii%nSZDV9S|xzmr)Row(*6%I=;QRky|)m`}WB*K3*f+%bwnW8k
zJn}{65o*C)i~IV3(2t1j{ebwr>C*MF7V(|AV*RzgtNUe+J;mGVemdwd?PlHaUD4RW
z2g2y^ApafAlBkZTIbttgG$y9(#hSkQWz)oUuK3)PI2LM)vMqwy`WU$E2!0f4Rgoxo
z=fQ&qXhC(*b(@2+8ACoj+WwM*T*pG2%V(3&>97s)pU!M-+jFcX1z5f
ze?(%P-KCE(slA;F2|oSf&sv2c1>QRk7A{yO5$g$&UTbeC|M4Pv`eK7iLbH7d@Dc^*
z=C@psOXZqO-zQ-FT?~Ak{HzgTH{dHk%4IME^|fh5EUQzdGWPN&#I8_GbspG-#y&OK
zSXS~~Nhd!?$`w@cKVDgKE?;L}hc
zz7aou?diO(JvS<5btfFTk7(dZ$Ye>zX}(q0ktji52NFSrrLmAt$s})@4gBgumM4l+
z4A+zJGK<`VLz7r-dys;#KlxqQ+5J0sD|tD=VY82#jf_>4e1wJXtB?e$PtW?`>JB{)
zPe5i1KSIt@ILMF2S#+ICJ#=okIp=phWIARKQ^hWP6#o7G=_@`ZwtF^$*pzUKY;3CH
zsy+V+?&>VYRI0G?82`u*r&X)DD<2b&b+R+tihrgs{}BLzfzMKMHYbm_wh~yfdeIzl
z#HRx@L8I3R;YgNTJR*lD$A2f~OUXOykNHn$uKGOrqIgQrn>jhE>F}i
zFB!jfD-ZMKp(+zUZWv2Ibxc09Q>#6|C(PBP~>
z=m*SCv130-dRFA^HTc}R+vmNWuWO35Vg3fi*Ze$R>Hx+mq#`h74BC0&zh+xd;oka(
zH`iAf_Rf1)vX=3#ZoDid=hpAm;_Heq&}KIu&6LYB)F~yRIUFAjT#cAy2xyR`I;!l5
zh7}}<<6?ECKp8|VdZpX~I&}Q4_8>~w2YENrU3~;9@nc9OZAl4QCS@_^{x+WYO~oOX
zis~b`1h|`15W3P
z_yL=s@JUs5$qQ`igUgX{rQ+;5JQCFsJK#0caWDPCU(%F!F*kOz;8EsENr^dqEf!GA=BOJ)vrrC`yuNUu-hs@4maDq8F{
z!!X;HNYNDhm|fBx%5n$y$0Bpx>tETmoV;kdvuAb!NVez%eM6e5bcSO;8TTv7P`YCl
ziT%C|I#OlRG_=zRT=JKfC_Q!&A8Qf8;`^<UUbLyspTg}`BZAYX{P2Uk-vg-D3%o8XnM9Yd7CZzgeDy11
z*Vq^h1qGjfg|Am8OKR?jQIwea0qfnxDrA58G(XzTI{Z*eVx^LHp^V)pp$dI}?f4~y
z#^C`!58W(2;OpT;*r8c~ER=J6iO;F)#leCkdjG8*kuK<;tTD`cURqh#S=syP=@2pT
z?r!WS`oZp{X6lj!r2`hhuS#qN*;+wmAFd?aB#S1mZmxre;C0Z?@?Hg~-u{Sz*gZ+*
zR1ZuI?YeE9YjKv1uj9u^#7UfT1#^5}QLs~wgJsR2StKsw1N#+M@uRqr#f1JP_Hg7y
zvS>J=Fr+t8KG`N~dHbg2G>ul2#X=UmvlLyTNybPa%XqH%8ubV86N#wofb${V`9JD*
zJWC5;wjAS*BOKSp`Tkjd;ILj!=^OE{L3a6Uc@AH{3Ob8_a9#L>%#LMneu?M}k-f41
zp*}yrV4zBVg5#^OK7h)dLfi?AgGNUPzHf|PgN;G(8&xhXb(s6(XY7m49oNg;UICWTKtNZzB=~30yffrnzB5<6?wn|;0_TW^fAt+Ro}a8nv;^v
z^ou%ZQ?v8M>?8HC;;4voU*G<*zpmFiOFj21x?lt1HM<#=PkLk1^$mmGjy|pNQ(h3x3wgt6@YdD|TAmHW;{ua)2h-6YF38|e=aoDnTEifhs#9s)
z!HiKr(?PG%^|q&{UhTWPVKk}S%gDs}jYZdlgA~vEEG*nSp9e#c+d-}nHtIK5w}|@{
zlPzmdSz**JZ
zLD=4Z_lFHuat#bNlyl0RL#Vv6UA*uEOGxkBZ5Y5`(h@BAd+Eecs5}JBSiicmVAT35
zsa)@v-+JB@v=;uPYWD-KbJ|R0W@wT7_RH3p4X8Otfns`-<5RS|n5V4$
zd7vcK;^y%I>hF&8v2rVNLNC0{CXO(KJ_s43x7eA~KZO_5QfC_#N#$~s-C!Y`P=Ze0
z3cd8r=lbgv*~c1`!kx8fbykX71zx7s<_mIlsg`Z$GvWutg2d{dUM1(Ym~eg3Rm90D
z;JJ!q?rhSdO?-R9=qdk}YU!OrgJd|jvE23VQ#9^rK7lxupcd@6sI6Q2q1gMbHLJHt
zv=}3lp2R~4L~hRTrRkAHi%XPSx`Vr6ZeN!z7gDuWt59>*XMP>lhHXl2cv=BuXLm7S
zNb=oifbFjuJA)3|?Qs0-xFoo49~1sf5lYPeeLlHfD@B+xQ)mR}5!ra+O?6EPWvNSu
zpDj}r5lj7QMq8C~{@HE?oc2$%u^Qr3hP!ogy9x^>WQ?wPw>m;pn3djy%&aBQQD09t
zfgSFRX(#~O;}lLZ7#Cto>|a|M4=~ZXBiIq6yUk}6nEc)>WZfkYdDAgdLFP1vpVOg+
zpL?E@?f7NYNWC|K8unMJV+Q)WulL(UgpXIpUYg*Fo`Ep`6_rEVd;8e^vnovSXtf8|
zhlO7Lt{19JkmSit31%)a-4!xMsUOh;T8|UD#vmiv
zpl?9YwPWI4qP{Us=$sMk?>Ag(FfpH)W}Xo_n85uDH>58fsV={s0_2ejJeEc-y9L&n
zG;`2-u*2H@i~Jb)Sv8Nclk&Z=mJV=)6r2KOfgRw8@xiPlSt=@?XB#w}X=m5LS#gjX
zKFH(;V?X8lN<6SNTW2=MBK_74yXtR*NJO`9eyF+dE?I390R$bV&l3vM6$$fgpH;QXUL@3zNhf9(kC^V=MrA}{R@xTbow2A
z+JfK;mkU=uOX`|WyovtHQS;9vy|j#@qY!-Bwu#$U@S=vzRIF=DoAu=d%!u5IrcB*s
zE|;Z61$+=tk`fT1B72qqo3i(6UZ2Z&a4pUG)_dess6gHa4SNN#ZDppl9ETdO
zNYrhxlcSG1^_{=L>qZ8c|Jm08?B@|SnDK~o&SVd4m7AODE2Vc6*ES5rVC1X-pK9sU
z8)l8`-RuAP1m>$#|JTt5KmFc0yC1(}v04g0fKB_s)-O#hy#rD0zsWIABlw|C{IO9n
z-3ru?sHZkdI!B`>f$95(@vzfRNJY;+v+PP)VQ>daa5JAv7GeAQ&P!x!Fx55!^<*k0
zG1=qpt?8N{)Ty6flVP5tyAtu1?uSz^49inqu-BKf92W^}Hef~9k`Lr-GasqntLRQ<
zBIde0OBM&J;W)c)lV^|QMZXhcLIpMuC(Ew)4-xEq;We8%+#1g{X+@OfPVFJ6>8qKJ
zWXs?k50~<#I|%M`K!v0vj(+CyIgh7&ICa~o)vl&i$k96kEyYsJHPG#S^$f2%;yM}|
z8^RtRc|jIK5OkghO;}PhVI)>x_3>S;TBeO$W&THKl3zCL$I}ncSQBglI3w|nW^-&0
zNqn>}p0T7C-BVATlOIfMESsM@*=qg`zarB-8_y@nT2YXCH?V<9>Ve~0cG%qb^2Q8u
zx<>42ct`^+T7;M?*|BrtP69DotRVDGuQQ*BxIT(wl`bTP_ujnJgU>exklXX(uN)bR
z)=%8M(o=Nb%*kCGvpq6hk5YK^p;uhFdj5e^qd&Z>7d^=8=l
z5X%K_iK|)gtJJ38b=-x%$bECpPsgclI9Z+XS#hf<!8X?&MKFst+_R1Enw
z?w`DQo2oi{hoKy|m%xwIP@;c&SvU1E?`6zGIWii0JoH+Jc(WUrI9?=Y%^72iKi#co@3CnFE?W}JZJ_O=7)b^IHy>g5o*dbVO>tZTo#kxrRVb$^qF
zq>Vlk@kR*mVf$_sqJ>7HVH2%sw--`XL28!W1~K`+Xdn6%zG%
z!gu^Su^jzmUI|g$TQV-JK@7Wm)5nx;J%#7>q(OuP@v)P=U(8j?)YO7`DTvS&(SROo2Y$X-b(c$exh(j%`{ie0e1vYT+xY?sRmml7DBK#K}Vp*y3
zxy2C(*D^`5v9Mn6+|!ic`SB1OpTErmL>Wj?@90YiJp3XcC_TpsgfPx%dq^y!iZu}s
z==dvN3E>$Iv=|GDOTfFWw`z#EG|4P+zd6rk^;lDE=S>u&ba75dE`Yn`sV|K8KX_w4mJnIsIU3G3B_F9Iw%)Bx@&(D;L)GI
zcdomt2BK7Pma+Mp1ykuadc3Y-OW%U1{xH%NAvyG^7z)9x;G75&c-+l?hoSu;NBHrV
zhy1||NqP4kHyL9m4;kYhiHP*^Tn_t@Ao&}yN7Co5(@+UqWw)1YDgOlzlAdUK^MCIB
zj}87m=?5j|E4EdjT&z<~*HpL$PdDG{O4=Kn@
zPgDMR_bweBsY$+kne5NIr^v~<0rtms?a!NEq@_t{y!h?OKkr^R^NVEt&tm_7ZCUAx
zl9%o0HN$^bY#
z&!ys^5xa)Z=F4fWaX>%OhKbj}bi!@Zo9U>+xE}yl23-vLOhAZ;odxys-qzcgn?I;5
z$|Ifvotcv4S)d?I>yWP0sxoKLENj-Xb+_kpB+OxP+Rb$%4JJ?+L$5DH`f)1Y$Hfnp
zOEqQmh_s;hr+Uu*^@AXvV+8LBZhYMjpdF0`i?3tum)(ZTTS3sycsui-!)aaaw381W
zu+bMMo&+s0nfD~Kfuk?NPlHN|f_D!7bwc^
zh&ucQUf9aug1GTv8}zGCVBq*Q!0bPp7}Vt{X0Z@&3E;7pLz5Zc#+{!;`2Spk0fmMT
zyK88C>CY;+{(eBtuq|z&IIV<7Z>E~rupyj!ziWAM^UGnDFO-hHMj7N|C)50r67>Fb^2Oiw0(E6U0jbCs<{MwJ+w4}_uUBRp
zG_s!1pSyXhsTkBTqH~
zk%J1g>4`OAO~_?Ob0w%R13cxc3-B-H2Dlf6#
z`LMqx&i$?gpb1DbJdt2ekVj6zWIHgT<#yigcn6?6*rXyj$03}=Y#a5XHDcmhZP80j
zfi)Es=ENP2Vyhxx5Cci_R_+@or0Lzv|9S=pB#;tAlbYwa{*#+~dYZN{jW}eZm)*)B
z76F&ljNmSXcy*JSy60oloNZW_JqWvBuL|?4Kp;%KYoBB1l#$Ny7BGBfZd$Xq=f4#7dg>5E;qblD7w_31SDOQN*kFb$A
z*e-S44vV$xEWjp>SX3_oRJDmWY|q)l$nS8V*gMGJqGMZr>?y!YhIoJok-m2k6#Rw%
z#P2Pq?v*)#%(mpBx>)Uxdoq$ikNSR!QC&&rRazPn8Wti{u3islRq3F4cF140!8D#G`Q)nfqmHX(w>?gsiwq&$ExegCOU(g93x
z$-+KQ*6OYH@GwQg^
z+@Kf*c$3iDgRLIHevh4Mho=KN=c>P_CRpJ=HWtW9eB>@ln~?g|7|OCgMsGK6|3E@}
zd!<(o`>5ZZV|OpBGMPKVcuN8O%$!hNK%{IMIxMDsw=)*Z0Yh-VEj7=tPEE4-sT
z)_r7mk*yrF(HzCs1#E}J?FSS)+~*O^?oBfCj~V`B>RfkA6V^>%>NVYiV(A*(_!suHKu^h-t#
zzQ-Y9-SIq8+<5nAwA;-VkHz$)oI;*ZQ}^*oKnu5?b2wV#KV~nd_ewRN{ovlL6)Ixc
zrvMy_;9;1?-FYCh6~@o`%QWrLs^!G5;sT*PRH*`{lL8(Qr0%`V+=mn?lK{7zpdsO<
zSqh9d(PlbM5;~56Gk#gmx_TuB{2%Rm->0O3KJf>OJ{RrkPq8H<_&b|{;}%T$f$&o@svoV*tx-`~_S6TZlQ6vRB&tQF$05Zz%NGvhBqYLF&a
zDgSNgm7Q*vL%XeB{1Oj)sp*@!|TE3f`HvV8)nI_kXK5~Vsb&yq)bwLpekQ8T>|HhL
zQBl{t+Hn0SLn|<#m{))N=BjW=1O0SUO<_TNtMyxv3UPwQE4c9zb!zm;U*4-~EVX%T
zskhUar0Lm3Q!KEJ5wjk(lQ?c#a3(ZtBIpy93P)1I{MXmri)H?MH(>NWldRAY6USC4
zQYUIe%*V=R2fWu%zsf>2OPXELDSyd}?xYi^(!6bq68JU8A-pE;)cCwc0Q{}U7B)-y
zRjBXOHG$<&Pt_G(67EXa9wO;D{ep~YmcQ292CtCd@#)LhJ(cE2c_2
zPTm#{gGw(lDA^lPi$fo5XD^f|roiv+?}VvKYVbie03QjirT&^kBtSoP-7m;+4-GI4&TkO
zOWo(Xuj)z>zhsA90Azijs{Xm?CH@fOz!>LY=!>pm`vUdHZimUw4JcHb#)RiFA{8EM
zTM}^YNMPZ}$8e@7S8eBjnzMYq&2Bsy_}J4X(2n7anfeACeoQ_2>R}Qsbor
zE*UKSA#7N9NpEM8k$2udekYMMDsr>~47pIDjz-&S(h58m?cgwNlf14iG{fJwR!IA5rdl-HJyU?clY!(x(9F2j83rPu3i
zNeq#P@iow)?)>D}LsHL2EiM9phwuw)T;1*xb+a|gzD$itXV*`U;jre(k`U&ywtuTm
zRrGF@^NP@;{|J~zK;QmriqM?q(ytw`F0H$!1tbJ84bbpKH<9qL_n1>MY#zaSD)!?K
zQa^?d(XiHf>AdZH&GbE7+>-eibI-@_bUoUgc(g4@foXhOoQzS=Wik&a`6`<&iNw;e
z-5)2uy68|3&LBZ5z=*SH+J8pY)TwQo?4O=#Ew9;^*+Jzjao=`PCam&bgMsGlUzD%z
z=U#T!N9LH@!SK#XCjed*-JueDH`ntT@X64fFY*#_OHYIgr=WNzU(Zpj$kD`7+TAus
z6(+?x4-y;Fd^LA?nkya{D7Z6xRR!SA3KbH-j9tu#Fjg#O@u=^0mW>)MsyHVA98!>#
zhj>p%-$5e1|4XXnWs}yMpPu^F1yx<~{%f&-erurlAI-c73Kj?8jQLcq%5>L?RGC`7
zSeYuoV)AeO$4cYzt2?~;ACvrV5yJA^=3E#5{3pk7*hV|ojIMr)_wiolkl=Z8HK=M;Id!*3SwamtDoL=QMQ}GzKtyXv8-&NDkS}La#xOpKmz??7a_gX++|jF#00+N4V6n8^6s^UZpedC#%1z&yCTimdqIxleqsH-^`W(73?IZ!$IzkK@>tz_zaN7>ouI;3
zR|Xf45SfeH9c%%{i@i=&$B9En%dFp^jdwu=H{egC(e
z@6H8rCEu0W$3)~%1PV;<4^e21F
zGj5?6!Olj^J-WC63f|r8@n+A5d}RmEZx%T%KG}Rj>v1_jz459u>q!lK*2j=`7XNQd
zM6kz_&?=gEj6cqOn9NL_Vlv;aAvu1MEPAeAjVzku_-DX6&)=wNh2n2>V)%@;EBD6c
zC7HpS)j>LEQa`=^c5@K=U@5P3TDQMycRD0@^U~`!&h^~!6J*i*z|47d?RpC$r*k!wzfO(x<{asg-ULRFNK&>7KVG?!hAhq3paMfh7CoQhJyE-v
zv=)jo2@@O&gs57KJ7dE}m&UqCVpO^Ns~&@qEBDBvhY+|E+|!>NyFatPwd&7oF1(Ru
zQfqs_p!NWWNB37JxUVXOheGl>$hkc^ef|~^dp&-u*W;ZVvmIRqfa7MriV{A2-=yxf
z5oHN9&Krh%zkL7tc1Ab!qOjd3J&Ppg&S0Jb%LyP1l^VYt?syX`M%>rxfW$Kn2
zD`~pqeYidsi#{|Pi0TlVSf|-M-a$`#thrC}+Z5Kha1hss$9&19vL8Uf{v7*D5TbSc
z{$QbE<7{401JxYs<%Tk8M{sSt>=1L4WQa}jbYcT!-1GIEZxWFCjLq&C1udJ
zr>O5+d~#64mjs{ED5%|dw3#J!)Sg$?_XtDCe1WiWAs+1rms<3M8&$Th8vFqN6!f)u>%|5SdZ`)Pk{6g@-~lglgC2V
zxjSFVI19hk>JIm4wO(?3d>DLhKFKwCZ&BTw#dF&YTQdP(aqQcCywf=qz`^dRxa$o#
zh{BThkiDDj
zTq(9*M@tZ;Rykb8jxDu9HkO%JpRwYxVhSr^?1+@CCN`6IK_A!eHqpsp!U=Te;E4lkz!05+KQ^D6br*7?3?Vn94lg>aE
zRJ$!cPo2uWfJBzn7(&3iPowS4M6dhY_uSvIHbBSWUk_^QYUA2*b~U`oeauEP)@jlT
zmfWmhN$~ksvGX;+bIh1bN;Q7Uc8tQ8^7&J4vg9a1omc!v@$93p`6L_Ez4UE8vQj#`
zHo1dL@;bKdRzl#_@WA;tW@)P}R2aL&=;LH@5vos>n>EKkZVfL8y0&pj<4(=;{nF$8
zCG2gSZpR~0?@={BRoTrdYe;1B+aran(;7`+T|-UJ@TJ;o2#`P2_4}LCErmmUfjd+O
zFzZRrov;Fj@e{}QCAW(sn)7Wij*mI@&~;0$^_xkR&VG42b`-C`OwO?%euN26Ti{6xRB7gpTXz(d5+&NWVID?gxCGL=KzECkb>|
z(td^-#S}1uPkC;f)OadC#8(Ct12bzEdHndGgk0LrP74qAqA#$bYF=H}G@4p1H=x1C9ak*D%2Gk;XE%*@_Zw?~*G3
zZ`z5K$fQCqBoBIe1GoVDP99jMJg}KMf9~hV@7)y4hIC0MjFv>zN7Z;6QL48h=P6Sw
zq1ymPTez5scwe?6DhcmW!@BHtCJ6G3s;Oej)1OC?f23;v{Lp(Tzd{ik)$o`~{G34k
zVP}zm>6v6U*RkULP}(|giS6MRgFRq;kUTb7J#B(#dH$wE)Hco@y?_RP8zdlog5Y%h
z5;HF*Su;@DJHBw{KB0w#CzYye#Q|(C&%~Ad%63-GI%48`0Jw}1@SGTR?2$+_R%G|u
zomwdE-CdvQ0?g0AtGl*@A8b>SC>b_3->T0CC9b*}?NnQoJ?1s&ALM_O&GkS6vLb}9
zNxG|
zdz4@!TQRVz2cuU}|Dc$1pk|t)HtrfYX&g#Lq488hdqK8e@Lfds$B5uL)M*+*5z_au
zge_3u2BFF<^)hl4mAEMXU{QqZdyQxF{3&~n%PxT%Wrts+U5W8;(G)(`%2Er<@^5F5
zrVkqx%EfK^MiiLg)D-Tg04`2#_8eE)7+RUVbD8>jhR~=Nct!t%8fEGk@bf_(zxLj`
z&o=F+E-?D`5_!tb-@245ZH>*p3xuYXm?~#!I{QuY?oSuN9)oIfjw2d|nsYrV5F?2G
z^On`9r>{6EjS}}~1SzS(rm<=6!>!aX%fPcoX#Yw|Hb<3-UoLO`;8XhZ7#wd^#J_H5##=LMMQPy6-)kITku~eC@t}O
zhyc-Nc9@xH$KqMFmIK+y(G3!p12IyjdJqpL)z4i%0}fbz#g_<0=^a}00gxg%^X5-_
z{Ge?1U0@hmbNzMZ%t1XZ`lC7a4W4yD!tD_0LtbMGd6A4cVLUP
z3m`66XFY_cV?-F-0K*qn`jE#IjA%pUSL1VltTRv(%Bz;6#0D-gEFtGkC@^*xFp|hg
zH>z0ud2YWM#?z-v#z-(V!3Fq3D}e-_W(D`JB#Y8`*vXcoB=NK|TZyr*AT^|c(<-~t
zI#$d4!3_dD)r^~a3Q{Ud@sjW!Ayl(kZF6YtxxikG2-Z@U5cDc%mij@DhkfO;2Lbvt
zE(RP~1Av$u=uzs2HmcO@Sg@)V{b4gRBoxRwvZq``yw(KpBMOB;8lGF{$yWtVZG(l1
zpOO&s!hKr9-j*rJRjd#$c^1<~Di)8dpCxEK`=(Tf&aRVWwvq~dzdf-+LmxNq=+l$r
zI-!>&#YpaqsVi{V@0>cN%vfLC(Y879*U^A_!~Z@TX6K-SR{=-h9Bm`y5_Uq_gjN%H
zttQLoXEUGIJ?q?+bxh$W!4(osI(!tzarphTrWj#@{tB-TlGYtXmtjl|bfH@$&B_nO(?QGgej*7iT@K5uOxFm9a
zzanJRGQpdALFD-fIu^;Rv@YB!_rKDOtLXcmBV0&Dz?Qe}%P@y*8+1_lsf@i32v^WK
zqXfK`b!EdYkz7P?q3ZJlc))9+7qOmOmrkKEz#5b!+|&C2AEp2$Zdah23!lDfRLf_1
z>bRH*ypio`hx=S1=y!)Puon$Jqk{af2DSrU?$nbd6T?a7x|Y#dt&LMHk60}gqP_0Y
z#rm^yYv1Le9`{D&!>L|t`aCUM;*asq{Y@?w1b$cJUS{X<0?79R1vcj;F90dG=3C!9
zFI}~Q!cFT&=>aS+4aL$w*-C?nWE?2U&H|VBd%b&jHgzF(!zIE0s|H3;l~9620R-Y;
z`Z}XhUDmL3&X;8*d1_M3AcZIUKxvqf@xrI-R`bK%_4V9EVDnF2;tr*i107~sv~ej;
zeah>(V8HHnZnFUSqDgkwr8dbx;U%)bi|L@?VSqcPZCBqgWQ-{_Asg?Q4(0C-Jgz(1
z#wig|+=m&)PXxMXnJQ%>%8=zD$;>XvWxd8M`1LP#-j;FqT-gv)^1&ql{ZQ=aqq`z$
z*Y=|AJ;3}H1@8Mqy5eNtMACT!v7ffha-*FKaHPw=Nttv(M^7%d1FZM5^-=(nlj;IX
zSw~;F7;NLmg5E%InHETav#TU~K9VGKU^WC!CQ0rrpan05ciWr~^C&Dz$r?yhPDa$W
zgtHkKxh895st>vE5RWE_+F9PKjwvAx&z0qj_6`A$3!l@Xd*F1*aGWl}8+bFQ^WLBp
zPhOGl2&s~B7XJk6R
zLNKaokttEM(cQW-!s+I<9s+499GbR^;*b^r*l$jMu)aM;ui38V9Dw@-&IKm908Ev{
zLlHaxXZn^sTn!*-g}SfVy7B5B(+rvqTWB1vmCCXMYQnQaYf%88g^i)a{WQTRpzdr+
zu|UFakaU65>*|?(bfe5y$fD2?s0|v;wV>IlPZY3v;;iSwecDK6yF8xXLa{Ii;Jn(9
zl>26n4y`F%<5FrH)hjtq5gu#sp>&xjG?@S{fYujLqY|_ntv^_0MJI$O+gHy6a?>ui
zVI>fRKpk1wN69e9gEutjAJ78a2dIXAuQ#4Y&e7Ho=yPmu@a`EwnQFtSH76PiIn8n<-VNF{(a0vRHxd0xSE5=`;7PlI!3hJ)zVCDiT;s6ca3DTgng()AH>
zSm0ESi
zVoV?vbv4%z2aPleKXMQPPw!#{3+JoY%(;1fAUKsb-gEi%EkMNx16nh>{hDjkF6?OR
z2Vh_Byo`cYZ2}ULfKF#Tu9WMm04uC8?++tmobsB(9N6o($qH=LHFzcW^?Jd21z*Mr
zJ4`nLTHg=qh+BDCmxHNy^ud=UHaq!ebjq_U&R0N<2Wzy?5NbEpyoqA?pk`s
z|D1`>_>$_T@>#vg@j3_~qpjz5DfxkGj13-Euhk#q6kZ3L-Cn&bDXMt#w`m3gA>}m45Nq<|`CmmYZFq>HF3QD5`Yb=B;+T1p=0SdbyWczHu7#pUp4^oi(
zFk*$6e{!+x4n?fX1Z*BJ>SQ=j(*nEzG;*@4DKvQil6gVZp#n`E(vB0+GrsT|8e@rM;k{JG-p2`5h
z4v@>m9=1gs`4!eL?=1EJWr~g!Rm3^SR_p%?2IvRco+}-Y~5pXa`-ieSzAox`23i&APd)_<1`+mS*Rfrx%YpDf6pb*h}K+4KZQh!5BIF(AA07SuQrn-gL1EE*Q
z{;z~Gk|Ku*VL8^Lz#VXOicJud0TK4tzyz#F}Qufm_Uvm`&p2C%IvO0@3+c!%*>Nq?|m3L$mMb-9|+|I)+in?6WmK`%fT
z04jFTD^c3&Q{a;r8~q-@1uj$+kdn3nFdg)K_&Yx3cq9e<<__7K^~&ZU0QSv(
zh=g1N8Wbrs{)`*%!6iip=@Z%sdJon`097pqH_PNd&@abA+{dDGp#8!9EGT(7h7r^e
zy|mR3$_#u-`;|`518Y_m(OWz|$c6-R-Gt-vLQh`&8)VXA6HqBlT_g!!B|ss|U|NMn
z+*D$Ry&Mn=KQ@q1yXMC%a64wyvMn*s-DKlOyQYB%d}{&d?_h*Rq(e};J*SQ;$S;W+
zD_cskmbKw8%FA4;>H6!r?e42pT*>DZ8^?xG2;;|nOVU
z=oQ0Q!0L+`XyCMxE#V8g%dmDTJxlJBeue@@6d8a}cqREfKtDyQ8dfWol)(3I4k
z`O*ZC{-g(a;r=}(jm@^G5pxVjXxR6>((d4xDxh_inB+2gbKl-OE`)A7j@xh((3)Bc
zhc<>^L?|ejlto_NHMQq94}r*EdsS0tad-T`Fw>-dodE*_taUO8IrLW+DFU|e`T
z`Yt@?paVmQ2CKbtuO`VuhxjkOykyZp^QBPq-K0GrLrF?lE(6Vu!JRkhCVMOdV@-9C
z!djKfI3Tp{AQA5(-H!L>XNWlfwaUL6B8f{!m>_L;6(y2)&#?$(S0BpJh+Oj$3?;Yr
zdjGhtJDpmJ8yH#EKN`!PV*ahZjZ*(LH2+fAv0G$b9x{~sD%Ea2;M~RY)DQ=Z0<(g`
z8Su9DLn9MEa8C1yqYcS{a+voijWRC-?kBNJ5#k#Ui{j!GlHWIfJ+L{EqW(B|u_v5nL;2bAtAwZf30V$gb
zyiZcm=t>*a+W`c7Z`2=P5b?@UH{yZszoS11FmX+`JD;`PA1w}mf^qzT#}KUU`BjZu
zLhoNSQVTa}H5$Hdzdi_KH10(^LvJx=F0BA$;x5oubr3Kjqaeifa+lH6*yRTQU+leS
zRFiABHH;`KL5d0%s-P69Ds2k{kkAq7B_JRh=>|}mgep=Ll&VxIp-AWmp%YLM0qGqA
z1QDeL2oORq-<7@H`@HWN&-wZNc*i*YVGPGmlIvdgwbq(z&bfZU9n_h|En8vO3Uu`)
z8h1<=1=k)dj4Ux97rGlrqnq*pA$1o#bi6C4-|8pyjgli1hbP&ur3$JjjmZq}U>u0b
zsuA{l+eO^KrqH`A?zD~j10yUDR8<~h9sZj*L#*bKO
zNGIdGAenv(T2>KJRtc#%zhftKvn$DJTq1AY;S;d#;?GGk-+4@{TVL3XS~WFj=rS(
zuD~rU)oBck%^Z12pyR&D>cy>$j|q+Fkdlkdh1`CvXbthM6>OWm({feTP_fOsVTMER
zv1+I}+mD54stAXTs(i)5tYQ%e-%g~}J`aQ=qz!;#5H)n`aqn7R++vf{e?*%nkjH%$br)GEXptkYatox=UE4_KU^|OKU+e~1l02a
zw@j#VFON$(4-30@NscHt&y0@vNs1J!on;{)#z8Bp`=I?~RC&V|-gl-}5dDD5X|A5q
zhVDu9g07IaG@#4|oNLiNgO3ulp%yI4MzUC9$mct+pO&J51I?EBr1av=E~~`Cqgugb
ztU2l-&^D7VU*BkS)vH+=X*%?Dv$P7_^Ee2_?KpvZV5_Os{r8KDx%hXH)#joKeK|jp
zCuq9A;@u=}wf*^GmQ|PF>C8WaBV=}m2-e{o7Y_O*UV~&de{l&6szwSsI`vzWn&uLC
zxakgpO`1$ilJ2ysz6~w#1R8
z)aZ>Ck1JJ6mLIr7*a#tG9<9F&pZs-|4wamddo0VLpBPd(iPt@VfV5(p@K(hhpS>^b}#Ak}2tk
zbw#yR{ixLP#2_IED?MlvnJ@`#75dr`2GKlHZ?fG>mj~TckSm23#mIl4()r87I@{S4
z&$3=nhB~72&eLDdaf=)zXZq`xo8
z54dkg)9>y6HE4|oyak(rWiq>ZR;RBD_84;{UYg|#pu2JHjkacGMk34iy1g6Ehk74u
z4PmxiCQXo4`QGQSVuj(CmLu`?L(Lsxfje66y?0Kjz$EQZJr5wR3*sLswc$MJ{iKwC
z`T)tW866tdr(dQsUSeZ2HCM^;S9#MDNtu@fXI%XK%He2!tDrC!1tA3{=UFrjsq{V(
zV_*y~1B_faZvLrk$YiXiL&IfmsuwLrHF;N-!aMc+KWY8{AV8M$iOrDs`NZmhJe_DO
zZPlg}e^5WNc4b>t9`_Lc?{rnhzX6GJxKs4@4}8V-O8I@@j=68Md?*9H)>0}D{{Qh`
zgqyq6=CUf@28;Hg*{!anWQE=>y=P;Z|DE0s=IDT!!*LCBF>t$?tKeCj6`14Bf@@106t8HXwU&!r
zbYcxmp@t<*he&ry^6K$laUZH;Ltyk8P6Vxl{&!Kr@5!T*@7g}8Cw0ig3d<_oz79&r
zjK3ljjOS-~sXWB~$8R1FicuT|_MZiF*Q%Y5r{o{tH>;|Xy|Dy~*{fVTFLpq!Z!ZNH
zBpx|EK~wfY`#+Jh{yCTb^dI~_?El2c
z|EFyJPb8|}E#QA*O#MEz|HNnfCy4$Nqx*MQ{wLP)?>7H`zuNChAam#cx2MLyT!nuA
zVl+e4wCqX%>_MFQ6?SCABM_)29|ISO#cs8bim?N1o@mxE9n(7J{(j_FFAH08m
z{Yjfuyz`He?)Rsr{P=%NnTeARdeZrYvtqm*IvaS@Z_`MQ=Oo3l_}dva^a6%+ur)wehE&McV!N>$i(MVS9{Vi*Plo8s-C5u6oY?Vz(*u6g=*5A&;1
z)JS0oz^!X^g<6qtGw{%_0^m`~p)e~Jmr_7eso_}I)_2n3N6Mb&uZr*y_?umv^{RrOT8W}vc(y{dLHGTfNVbHl#--P5Sy@1YkhZ%~G4ZoavY3?1;TChFGC
zZ0w@gmywg+$G!1B_N#uTN1(Jw0k`;b`;pRAdzfIUXmUKLAff_4^`wr=d
zuKLr;x-0)i5{K$WQvAwk9iqg@MEMryACHu3wDUOP4@Bp0nsZFpL?vHJk9zHWg;GNV
zx5V1zlkeF003K&2rFfIW4~tY!^fv&G+8TRH4PYS#cVJek#$70S)5nDFD?;klLmwP@
zPiJEI1^2_F63IZKgQ^9o;>U1H@7nNVMiG;`&{ZIvtbYb10^QC>ah^SJ&wIb?NGh|?
zs?(YKd+VH}yo?6Q@j>qa!?G&A-Fksb^e9
zb~EX?7=u`z`TjjOCyE^K@mQ8V#J;p|89$3K@tBocPH}%APU_rmK4TZq~JWzW$Z#
zL5}yX6~nSD_WYwnDoypYapHcFB(mf3X;0#q&4r`5w-z1
zK`+{~c(M>|OiVJo!ILcm4pVNpP#`g@xjupl*?bg)`8Lw$`PrMWlunM>#Ld%#EpApMnF$ItvvUo?jROwHxp?1S!2Z~
zez6Osa9rs~99@pjcBR!Jib+0t3uO>G;+x=W=Q=`dZP#M=*!|$qJENM=+2>q@B~;#h
zAf#A+au>AG@($?CUXQ|+ozmidn?nND6>o5Krux%Y*%&6pg){5SWs-NJ!wA=dKl4J8
zLlXE|?pnAQ3Yz3Te^|d
z6DTx6`f`}<+i7CFax)NL(R!xoJ#nMqkns7N3`VqAe2}lbiGe60AXMb`#dF$ApT?es
zZHejHq+Q`jT`w8FiLWwC-=wR(C-IxCX4eZ>@uxl08i>!|dNO!WsRZma35{nlb@xe!
zk8g8&J4gF$?Fo|lj;nf6u5XNXMe4A=0Y(II1rWQ#}1}Zy^rHjW$G7XhGk|^zuI#w
z#c<1%a5|}bVoov{urOPeuv>WlsKUy5EdPd_93WG60rnk>hz-bHcH67db}JLLkN=gG
z52FC6$dAX{9M-^c+w!ft_n`6fQ-Qe3>ZC%e(W55^oE1|vEyp>{5{6N~9Ma6Z(H3n+
z0ps=bi`XlJCxxnK5DyfiF9&$mSY)$5@gho9DN(iHuRb9i|BUdfh8B5q
zk|oYN4QP8QQK|H(u?g}7^`|ggJE1ERUWC^)oG^}+6@xdOPCU=^uhDHz($LX@
z$gCNQ^3FJ||G52ak4L!|nSuP7p^|ndlxR3y|2h2gz=shp#>}=U7rg8gm?n=)D1~O7
zMBwU604N09Z01Ar9+fB#{xSicnUCPf>3&?T~)ia*ZH5>4{QpkTM
znD@9&I(1dIjpd+u1X7z;M6CpHJnS}?#vVI6(13&>O}PzMYv7R~XYfyF=-rn-w4O|~
zF;b+#9R~vq-oolD)B?ZX^WFvUZEO=~glM{_Tsc-^AIAIpMrM{M?D|JvmRafAsam+{
zn{G@C-6n+%f^ZdqQNC0D$B5a!vTL?s!;k3(P}Y8j7r3Gs1B$jP)1sGeP96C0?ypx>
zH{D*IfzGBXtbh!uFH2lA5QH5$m`@$WYMLJ$RR{FjQ~?cOacLM!KT>)$d!1;*x0&SW
zT@vCsNEb{^%eAW<4d0P|ySz5%4My92y&|~T(qjF~VP97=!k+aJa8bQ}KE;5)xs;5MR^)mwN
zKIta&H!}|Pqjwf$pmuHW>7Dz_Buy-NehL}&sK&&$zET*fwjtNoBt2U3L}9OE{>1n(
zYJp;%^kDZ`PR4Si;a`m?Xfs)>!;C2zBAcf=3`ff$TRR=bmf}O2Z7CjThvXDjbj#QQ
zs|pY}oSD31
z1T-h?AiqR5_eHubm>$aQ&T^6}jtB?d>h$zEmJ$-ey_!}G)gKOj==hJ=SJF%lNf&I$
z#IwB8W%^aqK5hF8&}9`j^2LTlN492;O3$sH?#gII9vA3`&eaVoA&hq{TvH`r+|P9D
zV*;pbSMhJDebL2*5k!qS0WFIeuiJrm@rkdCoHn6h`wPIfX?bcSpm&_F>*zphYKM(O
z(ecaLGMGdn36JLzZ8z@#tM}buU?$FJctk9$?4ZpLvNm)0B40W@ifLtksPR?N9Y3LqdtO9cg_O|i;qz&enNvX;JUe^_4l{m;5VNw}5V~5#$#Ghkg2|;shQ-ry
zm;h_1-!Im@huN*5Eb44($nLNDh?2vNtEHtIZKws8n|e@f^nA^tS!HS9!A&-~4L
zZ0(At*WyjCZ3kjGvl6X{5Ev^oa}}>nYqF8k*HT{#jr)FYc^eZHmJ2Q;p@GU$IM(eN
z9Jn@8*Qc4xi43Z?nhZ2;U^N-fz`9p%hTqrQ2~6WBf45FVxf8kzKR0!4A{cvf
z*6v+@Tg7#BH+rYp>usP=P)=r)lBvs0dB^$+!{~E$-IcGz{A4G-?vlBTarxf#lNE;>
zfU3auV<+Rz+jQMcXwwrBhpFN5$|ruF+KZ#RBx#wT{ueXm;G-xe2hwjBm|X2D^yS}J
z60Tre)X*Soca-6!0y*&BY!m63U@qXX@~Bj4y(w_grYb7Ki1nWKRy5l^J@k$I#LIgP
z`lhN-`uys5T#Y*oxY?<cNb*beV^B#4MpD8X))a7KgB4e#{M`YS;o@|
zgSX4VpB>Z+t`{rW4XqAXNK+YJgZq<*x|$gk*sJfU&g}wy&+G11?r`=$rSMN}DsWDP
zMv2+MyC>NmF_GWjvirHTZ!YW(
zcqWD6OO;4w1lkcS=xOv`+#w2=I}*jB=kCr0(}~`o43{&ua(ZU
z2uOeY^>Uv(Zqf^y>Y?zOLskkoC9-?S-QQg)e||f|dXNqWPUZqM@SsN?X_Y_c|4-?5
zGA!XtCOSOc^$4S{Yo4IeKib6L%wIe<;JZvq`jwnLn`7
zI(m#4jN{2SBJ=|r62x-_XuD)}fkj4@TIi(i__fK;9>CKc)DOM#==n#-S&iu>r>o;3
z(W6qhSzR{s-nV8h{be_Cc4WQ><10@Mr=)zS1*UdcIE8ENO
zQnf6S-HLzM!fUKWZoTd5T3mU%AoI9Q
z7Qt(@%vv&ZA_iwUN#|2KQbZo1Y?L4s6qaaWrz||_^Qp{xR&`Z~_8d(>_#-ZOdcBb(|yv>ygzJ4lP*Sbv2H{%+c{7DvDI`T7+PMHRF0|iU-8dS&ZZWC#0k83vw5F3
zpP)6z?<{NaU$N}<%JVQ!JJpUsVSn}WG!tSD&_~jJ6znXH`)JqUSr3vmS|9f3XoTVo
z$cL!ChPI09%lGS1-8?rVR`!fJ
zAN6!YXjgl4*|B|G4Rpc?e=J
zlo&E@iuh!VjmptZT=c&-__bg)8nIWbSV|2V)WCNGvKA=Lz`DZ8R^W(DZO!eR46-Px
zj8u>qt(z)WaO$jxO-oOB9yrH#{pRvf+u?EFS4!$$mz`ZNx@2=kJW9>Eq5?u~D=6)~
zZS4TXnqD&j-dYV(G#NtbJ}T%;WajH|9+n3L%=N7S-@HPAO4SuodsmGJK}UwhBc{Ik
zTP_@~<<&dYNR3x@-gZ?Pf2MlTz>rz*tOQ0lpHr|u0uP`36^?9j^8qDpC(wpmerHk;
z^fnA~edg
zsYNMDvWA}z4R07tOJL5hdG&hbtG{Crtoack^dr|;ziiAO2T?}fN028Xd&CrCmxh38-
zNahFEBR9v0o-IZL<=vs_{>YPIvx$y9t*R$8C~bwK(WP7uPrI
z;=M|iE7XW2vRonsdsF(S=oh)Gc0#uZ)@l?H#X74D^PF!Qf`x`9Z6AvHM!p8*E5rR_
zZ>(`K2;(jKEHED=dHQyitxfNMY9u0zkMcm&*~g{wx6T(X8+{jXrQeG9e!*kwb}7+g
zswV*3Z`|S*nDh$dbMx(cvc~!_kI|}e_H!=rb|8K}U-7aeC!KeSSEHxTvTZoJI=#?!
zIn)b(A@Ym1Avd{_@in-#y#-}0xLE`1O6w7*nHl-g4bJa6-W*=GuHyiL~3*s&OSjaP}2MGA@s$U3N3SR1)XNuUAEsiNk*B)%v
zV0D}`rx9Th_h*h1V3T`1R9Zb`pv@|C5wP-QCt^M;!<(`g>9q~39@GP{^~7AEnuQPu
zIE#jjhbejjRW21>QpvFEASA$shB=!w&tY0o{!*VR_|IC^b#$2?Uh&R3#}Ulkx}*E$
z>Bk(Q%5Ujq1SU*28#E^47wKF0o%iCXkBQn+3v5le>o`3vM@wMSVRi
zN0-Db>Le<*N_ZCKDZJiur6e!fOo<=21;_z!=HN+QC7zSc0>#LTw<%(Tv40%dj;jHW
znRSLwGlieGV=9oHbB$v*jr#|jq(p1zY|_iO*1Q1CSxAKmD*}V!Lf%VX4a(a4C~5%H
z3&s6hlTO_bRcofL9bo=aKF}Z5(+)8gkh9GbYRlq$%20=Kt-l8L-^6+PrJhxM{M?*1
zPI&PB3;13ySg}Gc=>I+2KQDAJM#syi&~?ze&Oc1~Sj|T!+Y*-;;lkEjuL=$afS)u4
z8*yL72w#SrFdY<+K&sPr%@xFGoCBgqOE=DBsfJfo=1o87yG)`5;~Z;ZRKs)uOY{*?
zD@A|beTe(O0&m{FMq|o+!SUg|QWOvXkVhY~5L$s$blBV#`(0v0_j~@MPbSbliCZz*
z2kMI~pZi}aeJDg$YmCnok%351Lh#F#EsD-5U0n&fJUHGFQ5u%!^aWc)kiz&m4>MUi
zVz1cJn0~vzg|rw^cWBHi7zxvLrG<|tGM{z>3z7PIuTt>4Zj(|o%i$P3+YB|^S=SAB
zl`Ss;v?mblNnSf`H&l-4WLgFa^`Gv#QasA0#{N%8CFARG-e)J+U9Gmtn_4fv?EU
z92)O4Kz%_b+MHeYvY9fByx&y1nH23;&Us^;dNDOdQ5z^l8^`*_G@IOL1!>7-W-&;&E)VTz2%>g{a^499U
zV{ayP7A)q(q)%6`iPTdr3qR0zNu(Ko&nH3@an0`}J--9ucJ6ID@1ew03e~sNIo`qd
z7Kl@<9ExY*u$FCDmT7qyx-8x8Gwm9C*8005~n@O)RsNPR4rQck3
z4dwPyi4V1t6AaUsoEO>{Xq(CYVQx0BL^FV)(zJx3vdd|#=zVmFWwaXUUO316W8roe
z89iMFf-T^Lp7V;19x)o@MfTd~7Hjz>tn?~^MO6gEm6J;t$!_OTbnM8YMzeJpps`?f
zqw6yHf>GL0Jf$1b9i2Xo@*(K8-fb0qeGig(AGwhGX)XzG!Yl{rGAKR8?xuKSVqozY
zv&B&zqY^3M=Jioq$4%cC>CUeY8-7Ou)oT>*aRGf85BkO>i1W34{JnsB72EBEj>P`0NY@MbH9sYS2X~AXseiAIlX}jV|^=l?$L004^-`<9(YvPPko-J4_
zlX=H7u;TIGFM4^byPxDltb)ZfFTKe6ruSx5g%g*;_6N;RR?r{wm8!s+aiXxbXmuLz
zQ?!Uxou+2_MLyajgSo{{zL;@Bwp-k|Y*g4U0Q>Y{ECtpr2h=RBYWZ34AC_~YGL-Bz
ztUsup(q(<@$97rq@?)FmomGAzgr{g+n9LKz7fN~YCy@dWdz-~cHRS3hDs+LmRc_z0
z@r3Tl1h6KkJfi5T>Z{Wi@(tBH&OcFKY*(gP0kfA|e?;FEEE75%JCqt0_Puu>QhU0X
z@R?4mbKj^s7y=QNfRNqdj87X=wYp^M3^zEo?CTP#DEjWpl1_#m`%5xLRK65xr?uBa
z756~Ir`M3okdjL9{HKqytY8c1@E6w&-YbuUS=i$V*POR=cv@fkvG>4^y_Sujwj%-H@WoZ6C_=6STS&;K!~BUu}HfN;A1*O%5*Pw
zhNI-6S0Bk*T&2)Ha3O8D#vH{Utud;IDhsT5EomP42gQyeJ6hfhDqm+w@jo4O9!QZA
zjuY6EbNWIOrkgzONGyH=G&T8mM2`H8M_%LkJ$l5zyjbSFQb%vuLr0i)yBtb-*?V~J
zMU>UqZ+>pM<
z*a{*)!SF>?r$XuX|Cr<;y{4Wur4(ODqy`*Hv2fm^N)t>7#eDBbs_4%
z5d{&fAhCph(bKh=v=D?=3cUGM<$hcVpx08@_zH0X7lA~hrKv;9@G2;}5AW*n$aIdV__
z3hfp;_9kLkQJh);9@?KnrD06u9M0h>uB-HpY%S4f5oGc1k0{i~dOD18yEGka4!Yej
z)_=mBgzZYrOw^#2xwC8qvR+*%Y3@3^ndd8(
z!`{uYU-?P-S$1f(7plyU0J*89Hkd!}-4o5()l=~1&4=_EZ}Og^e`SE-(kD_@mW$aH
z*n0$QjPj;CgTK@`5Rc(Dm)uh~Nv5}(!foP@qVaU(
z^d#l6IlZgt_KrD|fx~iG|Ah&mkoUfuK(yz*aaX;bbN$SC{Dl-|_(;has6xL0Dfv2q
zGl3OShPQue_FWPf|6nWTIak}=g$L3Le@D*^x4$8Kdp$~?UjsX!L(VH~SznbD=P%`G*2?`X;p
zXqFA&=PZI&vw&kGqaVig4^8OZ(O*vU9M$$rQ(!uc5n@vu3%u)E4<qHaA#O(XHdGY{bdDKK8OHA@Hi^wfqZ*z+W@zAXjz
zwxQA<$wEz(K;YC;@|VLlm$vyd3=}wW+vWIQp<(PiLHZv!96()6bDD)msUsdmrJ)~9
zWB%xaO2)`Tw0dEt8oKx{An2WbzpCQE>1<|gvX{d0K!X6!5)d5CWjP+NbOK_Rb6}>R
z6RY0=Hj`{7F2Zxt7?X{4yA77&WV`{-(bb82AWx6RJoFy(llJG34Z*?iVS8<%sJZK$
zd@Q0OJ`ov^XQ6GB+sYOQ(>{R|cpW~She0sX7r&K!XQD55R}^W?3CwC3WK(0j2OXM@R3fD0ew>|C@|7sB2y$(|KcA%HKc|
ze%6|J9QKF3eA2$l&Rrp&@zaNkf^1YXyG#)Pdjyco+4v7?4$4Ono(Q2shqy3%@rN)W9PCQ;`$=L^(rpcLwgJNfP`Ef3q
zurzAE3dT#z7-Pmv^(M9Wn2ha5xyyUex;bGtRQt3mV&
zoM?1q8wU<8c$`gCT|Uvn#N1B@lDUs`Bi8j(A9pFcF2r=hVE|tRLP8%qOp^`-)0
zOaO!gWb>DWF*tYfYh>PBE$1X2UbW*rwQxdLug_vID%jNiticJv$?ych-
zpE3x6_51vg#oSo_H|`+uo@};+_b7*&R3QDFzCi!6?m5r_5B}$|i$=(nUa`#qYFa%a
z|2R1bWwUp$V}LFqp%{2Go7tnaukL^L7HqjkpZs_!2j>V1XuVi`#!4OO0~TRoQAnh~
z)%DS+9X7{4kRcB)63E@84{vwVVfmaM5*E)+(-`kB7}K|B$3)=xXmpoibk{Srnh`(E
z0v8ZlTjHM)Ih)hj87qkK7gXO=yDMkYn{@wZtp-MGIGY?BpZzyDM=+dt>nP;+2h{NW
zm0|7lySAWq
zc}#%7dy?dil_N{{idG{H(YnnKv{R)-ycsp*UkkV}DpT?HR3=Cn-UZ2^BHh03o@9fm
zL$YybH0IDQw$inZ-^2A?5}ec5Vi$1bHs7Fn}B)L$#T
z917Di)~mn=7psgsR|4D$x97JHw`a0BPxK>$KfEulKHCCAm8m%dI1B7w`BtP**qUC>
zS1d~yo2>)-5f$uH2`6-saCtVc8yyFpKHP?er`q@Lm5nTTda>eXwc0u)=cH
zd5;2<&5!_BPIb?_jXPW!mH^Z+0yUx|7;=I?rzFAW{hZIR`2AxnTmB7}%x0iUE};l}
zy7KeVoha(ac^OT%0!=%M^ElV#KnKf0P@^s$biVQIAwUf>Y|7gp&#plk+15DYHreBR
zR`h-+lKDWu_TZTeYLk&Qf~26l$Y@(I$@4P%$lGphVm#|l7zacF^!MV`@UXDal~vA)
zv4FSV+rt&c%;ycogis$f3s31XCvAUk72ji!V4YLO#
zzpEZ^aamPm&R{wb!H|CfK6q~={(WH@?#OP2vtp#}n~Z0agv8shFMS?ce$rq;H;YnP
z#~Z6%%bGM-oMbVl)kfXQMGo<_#Dmt2Bv=XhQ8iNX3GB}Et&%jWf;9S8fr-qSV$VhL
zq)y2@n{lmgfk$=T@BpgZ*w*U1U>f;qj4<6Ah@Q}Ktb?vf?6Q7<#;QYQD-lO^WltDu
zQ8y6blvk$@TDqr+V7BZhZzNj3wf=S(faLvY|6EnS$4o>TBTOy8GX4x1c^&>R^wvZ#
zOg~epG(U*hEDB=aGA&S?7@A{sA}`dq$Omc9#Q)As$t}RSzn703=Y`+rjsl1*Qd$6a
zJR~8X`qx=Cc58~0)b}T(B*T4Y)#={;SHa8sJEZI^Ojx#V4=d`IU2+v(m6B(TK`K8rhy*O9*sQ4UE+ZuO$e{8{S_G-;{xwI*V87e!ww
zApt<_TT=FCTamNUUhx5Am-EoyWl(wgbJjoa!d}~=f--}HQMT&9Z~*u?#T3mM|6eyE
z;GzUt;cXfZ1~gH+FpZEf`RfG<*5SFmfbOPSFCn=fD)L}Nm
z%m4V9HFda~0O|;O)U|w0-9fEbdWY>}%wuTEAb7pY$T#no-d2ok;MLNzG(B-qgp92v
zL?RGD4Ly(J$P(^)YofylIj5LE${-;W#3QkE7hG)1j(1uNSo990C=3}1i)O9ufgIT-
zWwU3)L_|xR(cM^|NCSB5hjg9?tnl#_&QuKEVgHKG1;H2#k3N-rSON1*$H^`Mb~6bp
z2cO}FIZYK$mOKE>_6+K(Sq==3zxaV_t8eEJVfNcZD)ri57TwWzwe#{
zj*={i7migo94jv$!G1oeavW+LdWK@>_Ef{Vyh=>xaXn?bt;^um
zd&#{ook7C#5J?L>-1%e+A7YC_3gw>)t@m&pVjFbts^cqP5l`M&QqRKo+=Y+W;Yn}E
z!U-sULDHG(huFZMwQ9dvpP5IFk)XURWAu8Oz*T%%6hCY9Uv$=AdL$?GC30pa=Lu%f
zr>*sZE$~oD`K>Na(s-9p(=20`D}qcFu?age)`0+)&B9p~8sFtYByHcCVKn4$zXW(f
z=)+tbPP5U|t}logDX|Ks7tY17C`{P|+(6&DA0E+$+Nrn;yh0}O6VH+B$`;L_b{)q_
zG&=XaJX;+3BO0V(pKhsU5?ql<71WztSpLsp4p@O4ty2ReDetfzGmy)bR)73o-*$A=CopXDPSPFCn3=dmY(az)-kB
zRYH3URiegWkam%*o`bi2l-d9mgZWxELyGrPHB0qy@@ZmFtANc}k`k)8*RSO7OnN3W
z$CHJ~z!p1r&tf<-#~L9ocq@N9@!uG8ID3PRB@YHW4IL9qMjj#5X(>}``>@*!{pWIHGKJ8i~#cJYhkb?&BeC~7PoYso^@
zNu1Glzza)$`S$9v_zzym1dM%x>=)Bv>Z@N;JhdH~DvwY;
z#WDdZ=q>T{{}Ns<3E=pGc*sINEU%4j80zUat1{D`L>JF~XfAMoo7tg7j4?D8EJWA<
zP@_~nI<+YB{wH_w9KGXlzTLpU6m!FSi%%?@=NvAjVYuxkG9z`2Z>r3S+#`Easi4D?
zdh2pzh1KS_%_cK7&p|RMCa^2k=lbu;H2(WG7P;p-i;6JmmO2s;%4@ngp|KD9pL{E7
z8UrhA_ey?LhpDqlIOw`v28O0_{5eL<(8LWtNb$gOvicon8hxeZiA>E4wxzz2VY$h`
zu*AYzBCRl|Om}$m*L9afKv24pjX2X~{uNADge@CJDgLW9>;#|z>!J`UdSU_F`Wd!&
z{aez%=d&r_0ha#!%cfdZHK)DQG}b#r6v16@Kr;B1W9cJ
zHg8Um?6a^Pk2+B4_ug}m0o?iofC?QKaQwvN82*x$UTk`^lVWt23WmsyI&5tEePuT&
z4pSKm{b7bm^Pbv_UG_#qAs=-%9#|c=QX&FFT?LhbM8CRplV?;F$E3?jVRw|QzQpYV
zk?AdpH=-eM%pJ2Q2)=n~$IKvN3#o$KI>R9&@ka(xl@0L_Xt!-C%GP;S(ewIF;A9^z
z*UL&IXeE=afP(gu534N>x{^I38?e9q8CHmXYKdtL7miDJHs15QyLe1^MC-Rkpg$xXCm
zy&q=u2`xvwENZsW7JK!12g!oMx1|_J0<+Ha`5HWM!2pitlq8tu>Ef{;p-Z%XUo@8~
z-#lM&_kzZ=`-R=HQ5ibP_BEkYzgs{>-+r%S%mi)|!?5TNs5rTT;@Q3il91@;z3xFoa;*=EhTbd{iLlmL=8awvkr1RgA
zN-^;Hv{StJK^=N==M6m2j8X0uk?GcJW$e?tsZw3+fZ|XacB0+aFEaCUL)b0w`)~yA
z;=HRC20o64x}VhcP*=jzANvG5xe!G~|0*CX01DQ#TEv7x_SCL^rrQfSu`XBG-)%5P
z>PM3bP~pr}l+3)EcJ!`?M+kF;MKeX-AL$`d`v%Lm{w}q*GD&sVU2Xv@Pq>{VtuD=k
zHHDXV+y0-$Llu3dX>{_ajhAd~>psy63B&;XHuB|vx_(y%j{g$ch(RgLnY#(VUg1yQ
zF@{0&yX{(LACyD6$#2dIMxf^x<1lGXiJOrR#v>J9fQCZbq+VkE1l(}jRRULXHCpag
zjeP#<>!_o@2KtSFcBBluniFfZr2k1jw1WvwBbNMkF{bbONvenZvgT9j&?@XTwl_(DuI3!s-L|7R=Ht)Fw9RReY_~0vx2raA&0L^h3IruVg
zpmD=Ofa9V1&P00(kWQYH%*jO*D-t=ifDKM|vvecub6zatTgs8L6=$C&2iSc>GB~B+
z9>%gfbX0xO3+xj9ZXq(Ej(b!PDHDoFaoJW@*Yzf^m?K~*n4&~CVaI5jOhR&|?F<`I
zfL&7Ai^35li@y4wJ4WSUaT-?(%M3BP_fK%-^~&T%?ExAW*E_y}&$knbX2h*Oht$|w
z4GJj@i!H`S1X8ZaMUhcEn%7m6UgHm@bp#$f2GT;Bxr+BJ5fu^Pb%zuxO^xRzL~7Md
zi6&0~;XNjpePb4@KrZ%`@z)ujJeQVHG_BUJbb=gr!LOG@pqNeu3!oNQPf`>qfM=7x
zRabh7zAJth_`~?~5^kpq!9vnQ;oMm{?nzSbk_WM=%yHk`ttycqICn5Md5(!z0X`El
z3XqEHgBQ%+5AMNm*wU>;%3S{A^G)+Tu9Oio%&GUFzyC#Bzy}Q!@llF_?vUi2XR>B*})A9%dxZORvQn-PfiA1VH0w@*>P<7geqSoxX2m@CCqh@w2<4^Uy*Jwe_}WCSw>D0^m|^
zreqI>iYV=VzdAcl|IpdT+Vx%_#L7toPQBB@5~Y%avAB@oLUMS*^#N+SMFg+V$0VsH
z^}T&-5hRx_mjAuKU4NYt$#g*J6%T>4k7R)r3>Bc%fW-;~zu#x}@gvxbXuu2Xt4A%X
zj@w3D_t7v5kKk47)1FeuSbZt#Wy@I}{l
z;~c>dB%LRRbGU<;h1&&ZIo&=Un*{=t*K=r@nEi|o=RUeH&v<^Djb
z&gFK3R6`Yh7a3OHQ*q534BWqzar{#c0o5=S@)I)1=DI`xg&U_DL}6I>ebfnD(9
z!vo}~G*K*-v`>AX<`Ins^EQ)U0>#-nxuq2otef2?6V5#}6Jn)HA1n1G+VJKgs0a%W
zWh`5N4I1clvB<}2sB9E{&J{Kbsva~i8*<}k-Ml6dZDgGZ3?2j_GV`pB0I%<&m|H#~
zq#6r!vnj^nPFf7eG|7n7$uqN_uB;S%in?KR&Zj%PLbMOo3|Azi)#H=N)=&pWybKUg|}Hg7?aV(kEwk_D;N^&wV1E@jLE`zrB=U(rGBYgOWS-(S3pcB>E3uI$v#7R@wF{r>G5T|F|b?70q+TP?nkN&?~Gs_n+;G@M#-cCQq0!quOWKwd1Tw-Gv$$Q
zAVHj~96J0}8&Cuuhm1UY554+*CR)J~`V}dEZIWm!FTPNl0wL2lD&Y_5H0!{`)1+LmAQx^sd7!K~1yvt`dEk)hXkl*_}z=d{YZ!@^)`g
zR;89P@f`O6#7Gnly$o7>0>XvT2@QM)KbrbzENS5DVPlKD&PhyG^y3C^kR`sMHsxUl0)Gy>
zf54Xok+)}}rNh~usJo@yg#2<8c5Apc04d;ht20gOSt$v{F{QKedVt)&v$DbX7
z`9~4ibl~$@v8MgELA>v`|ua21MIdvEvZ3ZW3I
zBCI79gYJ`r(G{@M;?pJ>WZ_fqH?JA+ozBX9m5_E}R)a2hknMiIWY$(YX3hwQRKaul
zDq-n{_T)NJN-YnVg1a5D&{z3$X~2H|8lKJPIAdK@Qn9os1pbVQ4Pkz0{usHDJHxd;y9;?;z^(k;JLyvA
zl3F{%Q3eiiD2(}=p!k_+YQu{b9(n`K{8?>GH{c`o=fK2>HASOGnS%)AK!ctX8t5!;
z1&Oq{z0nKH-qS*xyaS(!yd=a5>D~KcWMW|pHjr3)ud4i{uL_0ilha2)d`V(nn+5i{
z4nhHT~J0HV?n_>wv4#fK}+3k
zamGo)C%QB&+6RnCW@^{7nIfop;jk^m)sdhr#96Q^;t}NnP^V7!9A~p}OC6Lhp$1rY
zi61wUnS-O}OZGg#Eq+?`YWr&`T-z%y1$h!XZCW1is%C-c%)g^_Ruoatntn=jR3SAh
zYI)5lnu)BtSvMlVv6VHa^@)`x4HNCt?i;uuWBA8cdfMF3hV>BQ;EX{!rw22;Tj|-*
z3Z>Ey-jMOO83dy7__d?K>PdDxGf!mOklqd|;?6Z2*AAPM={Uf+V?d{mXnaYhJ+
zd7)43naNQdV#A&fD?Ja*YV*%sO)nwwY#HKwUtIh5?XLa(cB2mTxHrHk^F=^xDN5`S
zN<{_p>G`R@3^f=1bJ}90mR~`V7wJ_d56AJmfY&SVogyD_pY42U?jg%~
z9={_Q)bHMgJbCu)+3|mEBmVaRg8=XT4)WFwo7N~vH78xE{fE^L>L*QW+)$UHNX(d1VR0v@HCUI!53PlQ%9@GL;UgvJv3~rRscM>C&qWt0xTSXe6|0lp*vE(fONs3AfjGbn#^X(RG0fR8f
zl&WqS0%f=P7lTZ_)q|^4ivJ&3-yN1@|MqRWH1C#5WokQfQJI=MEwxf}?UKqD!sNr1(fO+XxB}j`-mT2Y=;0^;xQbWxBo2YejfY(V};Ugn#
zQ6qpM>jp??x8Z<7QX0_SUd1-t0K5)FY80rlm(hSWp|748JD}mu^LxMz`Ox|E*xL>rBR8YGIbwhG~yZKJwLpGsXjh#{Oy+X9kGG
zfqj=ZiO2){^nYG3IbL7nZzTuKnRg3XGdTE~sw&XnHEavnztCX^v2G$cL*}pmXY8Ta
zUchxF+tI&v=>FRQ0A+I94WQCB7%2k-foxkJl1MDqbmZh7KoEjly?YSQionQo(0Q3>
zSJ*FbZW`
z=_PU}a|$G%&Tb1m(dQuCkgN!8QX^oau0D>gxi6AWz=1Pw{^#K)SJ1TtZtg$NHv|ZX
zM_J%W+OVDhy?eUTYQW5}E>T~4n5#QEfe!ATFGR^^CaU&a%Ip2)$6w}qNO=mMn_ZQ0)^j!XLWXM(zu~M{b~XSJKAmrYtF
zHthkN-rmYlun8Lv(?vqwEFhEKh5=tt0qYY^bXcD`Ui`9#HIDd!e?5;d06_n5x%L1i
zJs@n_>v1>XWHC8Hil5cP=h?4nKNoNW=ieCf#SgvzUr%wjbXxe;W-dO%ZhgyMrvsvw
z%8hg(e@Q8SsZkXy`ye+*xb4hd&Ho9_X}LC}mJ2qcBFn<`iXj^NlS<`Se8ajgtZ8tKf~bIJ5D0+`{9+Ebxw|ViDEgIkRd&dBvVp|M&YtW^Ir+
zLxmA`NGN!)vOXM;>sx3J0?Z3`pS3&_@bL0KpG=F2?(=g}d(=t-kqdD8k$+l59_?lF
z-i)FyPL1Xt^SoGNmcSn%Zao}e#wcQ)Y2AU@n1&ApTd(TYWwszf^i8i-Y!W#r|8H2A
z-%QO-x6tNq+R2aO?$ChP?9pLHYmS(2J1BG<_KCSGhJ&As2B42zQ4~{r~HMCx6kuFGh_f|jNJnVr{Od(
zN0uVw4=bQ#t~B7YHmc7p|1p*uI_n$~>{F;Ok|P9!#8WlN*-uOG+y4DHWVlcN{I(BV
zIu^_6R3G(;nE|@%bU-t_z7e5QD$Q_<09qV-5|U#iCjl4%0=V8y5_;H2f4`sK!23D5
zk^HgV->W-i;9kH^L<3NXdZ2Sknicp4P->sh0UmNWiS~ofEha=}H}Z{+WAl41ll4P%=Nqg3`{96h_2DM?B%_RGdV(MZsKu-;@Q&a)K6q}t
z$PG=WW%PFvXz%1I`^=sRkjT5Mx(JUo(3^;`vk!8Azna58C^$TP5gZUcx`
z>Zi>&r_c)j@5}MI+SmP_x#Kr*VQo;0<@i%qJcuRTz~y%@Y{Y#>FyJ+4;xRp!L(soC
z)Lks-1rFJ_`*41x|H#HQ2aIpK1}yYtLd(al0ga>gk9fI2;AY;V>fM{Y5CssC%gMDH
zMqu}ECCzps(*Y}iR6s$$)$h~S?Xb7=fd5#Yhuik<%GnLqL0FyZ^g&9*^Tv1#5W9a*
z#A>SQ$Ko>u6ENdQi
z{`eDM(f_&TqV^-}IWax#%W*kYeT&Wnuy@NlW@G0XI+VsNJT#`x8sT7H59pS@Yu#`T
z^hb^X>cLub{ifhI1u?z48&Xsz`1ehav76;2pb_b5&H`k454#FCL}x=WkzHK)Z4_0j
zCyd>QQy=rr^X3*E|{?VnfOn8-W*ANsb)dxyUfU7f#ASRaX6=fW2967!zJs
z?XByHO3qC{L0k^k!Xg`h;=#Ah0;L@b|B(vZQ%piaj&J=>(&jjfeyusJI-9KKMh|Wk
zM!)xJilY@mvDf{5cOsl)$543J6ZE*K3Tb4(x(lS>B^`o@q>H;M=9$F5&FZE>oknq+
z*BI!OKW@O<9!tOlcaITtp6TV?mtG}A0((plJbrB#-#m}vLd+qnzJ?K%49A$|{J!8;
z-IOTfK?b_2tJc?NMwdWlg|GxG`WBu!)D11nPytYIfwQdTqE3%`{%WQ(1<{eLZ{ozC
zz12qT=Iyw;zED!$?>9ZKxH>;Q$e4@1u*NWH;1W9VfNqewI{L*6*m&Fn8~{sukSy2$
z3LF@(+X&c$jIdYMhVw`-vq(`YjV$MCLD-H*fT`r)PLXw50y%$X^!3}sWo_!+=YKc$G`g|Rd%O;(ubi~KBTu~&;N;9U3`FBh`CwX#b0H>IaH(UEM}aKUSH~h-Xzh#AF${O6|9;KRF`LY
z*%4R=CckY=gizBT>LX64@d@Nxs~8o32tbT=4;%GF{*G=LGtp(OOa&BT>O#$dqi6dS
zYHsvc2i4x+3oG`>2!+k34cC?j+pku;<^eHE)=a)mf7LzGqC@5zf0b{V$aUpY^upuz
zh~9Xv2LiEOj;_jPd$^OX-@-R!?YQ1n6NNe;;JRl~RT@zOwY&N|*4M|a2L;Wv!;ugP
z-K>-Vjtc}w3W-BhRMEthHE`8V3zx{MPFY?_Jpk`>(pFrfpqOW6_(R6HF6_3!$|M
zM1A$mEZL;%C~-rwAedzPQeI3r^0SP!CCAqQ|19&2V)jRm@^iNd*hv7!o61cU5$S&X
zubtV#I^u%_`~8+2X`Wkl&v
zc<#&t=X0h7Yw;#-SH|bSrsIVWh(AEDRbwxT!P3g2u^ae@62~xE0F?Ue`#DctlEr=PSYDKQ
zOwxu^azoiWE!J27t5ye+qRz#ff0auQ&4B?X?#%o~QTH{NhIqL4(0JmSBjfa>Z)EI2
zA95#8$Ka^Fq}AXl3_pCh8hZ$L!)i67qZfLox(>Xjv0!3zVoz{_VS95V<38;Q^YmVY
z-%@OsC14T`ijunK&jMP{C-?@T<1t*Y;X3_=jLzRCXH3M2f)O5xCWO;Fu9m_saVEAOk)}f7+#b
zYV%+aQEHjnIt7&dd0?P!NbG0k
zKqf!JtWK}++j3=W+z
zjBPoxfp_o~Gz`g67fw&|-y6F=JIy~|jAtt9up)fWURja%m<^(t`qX%#;(*RJasPT@
z8xo#bW|-WAtoxd!O^sLPl{RDz>Q)Mkk_66`vu(mDc}jdJHE(SwvptIij0^1IAHPjp
z!-L=Z2$@kEvD+xSA;oMbEcd7kzAgNM7g}U$)mm6x#@|Z_cr&n6Z^F91AE;6t?y?1-
zJ4QWdVgBId38Fv^$utXEj;8{{R%w_!MFnSz?FqSZXd!3}vqQ}lD`9=?yPL(B#>QW!
zB@RZX>Bk*!zw``pZBU)O-iU9eslq;gB(-q6Zb0oWPNP$iRrDBzo|0?6BxEE!GbN^l
z%&J87F4y7FFk0ywfFL@ZOX+UWaAs!M8`Upa4-{w8vXUaEr=_lL^w+#j{456kq0)ccP`hCM|2G=^Ucd4zCt9Wsg@zL40<
zr|zKfaF33MfSc~=B01BJj&lrCgdgNEVDYAB!3gUH^JwhE*gcW@pmo%)j}^;+;l;-&
z`n-^Nh)T|juOM_DmI4=Fw!-mG^Zb8tbWX%Z3-;0Yr>phq=L}dvpf|U2z1I)*DJ6n(
z$;*Saef}s4-@|1_^%a7jKPe4&<~n|9X{V(A!J1G;3SljM?4@tt1;qD;$4oLotb_Nn
zYFIV*`~qbc^iqF>Cv-J5`f$Mf*)=$x|^UaNaHv8InyRmGu+|GxX
zh4=v!%5a}SM%Lm~Wu@arMi$B{t&D!r7hKhqz1Ra`69uN<4=u%M#(t3jG@@nAQHYHAif-^2&>H;i)LQoOu8X^%{OE
zc}xPRHchF?&HC{@oaNkpeX{IK&g{a-82D{fi^E@%Vz$q2ND~Yx
za#|tY3(E>z&v;?mjbS+oXR3`~W!7%SAUlcWw0;&%rs*hDP&zpm4Iwl0@d25pT%(-$
zw@5g3rf1;g@!ALVCftm*S@Vs4)v-nBX`K*U5$s7y-0~2?#k(Yc^LZW=DG_E{T+5@+
zkPfm|AM!HoGk%Q%N@+}~A=EH(>ja>>>sXucvq7(6tFQaPXQ<7NEMx?*2=UEQR(Q^)
zrZXqHOh;LU{-w^BdY3>xIFin@p31k=z`80uqB+#%Vp;6lhh#U)4<=ZxVC06QX~FiY
z5bQc8|5;Ctskg2p-7%`N4{!+4uA*V@VKwI3u$3!18oWE71TR#~<;{W-P2GGu_TWdTim)^nxrjy-{2)4)m}tV=P#d1+iK
zgzC+Y{FBLX0X!GF-1KqObshygPv|9%(ZF~n`#7#zOYu>*yW=FT#SwMBW&*GU&l%I3
zcTw|&GO}@>BRAhR#OJ?#3_}fj<&+&S&3Xa!DJG$8A6A3qIh+(c^i4r+?X!wN8DALu
z8rN(d?)KghrMZ9(<5Fb7+{GYb=PIFyAQw9o@RXKVmSs}4M1)jt{!U~3sTsIg+LIod
zRg+1BWlDrB3$yw|k;c08Un&Al*&Bi2^S*V~?F8I*ftM<*@ZB13fTSz!&_{X!P({yh
z0w+~{C_}`}9G)jWQ6i*Imy96bI9$_#39p913pGk2WXONI__sn6=LB#=v>`%dA^vrl
ze$S--ySu}c2C+PM3Opy7`NAo$7b&126BHr}V=k@y7Cy{kfwlQj4Ks~~F%)AW3A?FG_}x)-y7Sal%uEb_v~6^!SQCwZDh
zN{d(VNRG5y$#A*9R^5-t0`YnMi_}g-tan}K0P_OiJ{WQ1f?!G8hh+hm>PJVqK;3JE0hzq@AXRTk)0I`LcNgLL>*N(zoCIN!rf
zy}CZ07!uf^d;aGIU5F!(kzC(?QNN}nr#?FEGbR$SI}XDrjCjGM2EvLP0!hC_zpl6O
zffb=AEq%N*x%Igtv3?z2-(#M|wHv4YHGg`5mY<6cKoF)qQLZ%ZO}jl3*U5p>{5KxR
zTWfsF@!x+HC)T-YsjGj_hF<@+X%vg8%Hq?4Pf^k3c(uv8q5lTjUDXzZ-&TRH!)oyASnu-7}S4NlTQ(gC@U0=|LW%pPaf9t^-OU55l*%zd{2|MgJ_Uh#~1o3CthDzs@n
zd?;&}8fn!5AH6jb7Y%ctuN$hoJkatos84Vo3uLBkcEYh6zLY7Ub#a$2Y3e^gRV{9m
zLPw<9%w#k{XulpeU>Wd8xmNwU3xQV6va9*;gl!LoK~6?*KgS8Q7i#r!
zEfOHlKxiS*7CCGcwsb@Vkj3nq;KdO6IT;R)zV8@C%tiR21U7bV2e7S8D`%mTkWpF5
zg5ctxP)DnU(H12hgz6he&RXQ4cW!wIkY9mJ0g8@xF~ju9LFt-R~_f|
zadB|?*&BV-&Q_sIQs_u!0{8&AhK(tNh8Io5JGn!m{=m=?QlV;RAKU
zPl<}p2q229-C;fqGNYR{$=e8kNIgKW8@QOFIbVM_>)M_AgQ~1yecT)H_@cy!_v+eQ
zJ|XyzeqKLqGO9us(Ny#L;sT~6MmRCZZ~?Z{@+Xd$vKK>K=Q&mW)fJ|~F@-39DOZ$f
z0$on}F?3HyE}aBat=zaw{j8ftTnm0tAU{@HE%b~Nw%1~L
z#=?CgKf%zu{c;pIzKiqT8e%8)RXFq__M|CN1nP4AF&qp6
zv;)ZNMr(b-*07^A`f=O|RMcC4N1jJYEoLKIXwM{M9WrY1+fP%IP%yi=f_9V;!t#rv
z);1iq#1GY(t#A998AzL{?
zBPu7TS*!6r{ao)u6Oiqlxp+SeF8{a$%#MS8W4ZFI+LU&}w6Sl?tH57gh#}SPnzC7CV|yDaI3lKr7()qA8=yU1uR5OOI=AuTIy;
zb32t*9Q(0?_dSI)4B!bcTr&hO4X=;V>s%+9qC8>&1|ZWHsCRPT5CFSUIzCcg*r=QR
zvxfAD%T`jJ_%rola}`0Af@x8X)W0GH6fRs@FtoCfWjDNh^P4Wn$NeqvTa(vO*oiMO
z;>8W^;IlfUx;|!Vm~s>AbC=dlX7iaQ2_S3;UY>ama7|^T>c?CSyZ-R70C|8U!NdMB
zL@?I<-_u-$fi}|j6rKp{@AR?6MAn6inL8RJX8CpTpW6cN+_^LOA)w_u&-~6EI>z@-
z?&t6~l45J3Kiu|OC7j+VFM8vE!DXXuMpw120cxB<@`4uF+~Q(trfQRR_3Wa1LtrI$
zA+X28pn3Uq$nU$(_H@&&RDEjuIf+L73;R4_Jj&j=#`p^eVdqEr
zakBo~*@l+9iFn>jb>O#LhGUL2#t#7)5G(@vRp#0d*WmKNL6{P+y~gtCn(29Zy45e1
zUMb|kn}g?b$&^_P;cgCij@NDhH0_3(3Ifn`L9jWP&s-ropI#6f{)C6Lv@0cARWOe7
z@V0eqHeS~+QQ&6dHh^aQ41=uE2a4KH?vB}>v4RGB<~p!CtYK~-Uw&)$Y=pB)$FO+3
z##MhqI|YvWZ~fl3E+t_=b1swEun2#dYr5}5Xb>z5~Dk%OBH
zoo(FNq|a}UFpa8U;Z!@SKMHxBVLC&bV}z>C3ljqZ%WHlE1q*V?_r4*TMb*fSXXiN2
z+k`H8P>%{JPDs41sR!*M8b0x-vUiB&Q$f06dlY(Q9NpT&&LXM^7z($@8XaioaePD$
zz9d}E8!;Eha*((n2NIH;EZ?;||A6u^?lESh7>$Pa#mp-p^GbHZY_LB>5B19}R|RL9
z1ob?>BpZGxB)&7IVA+jjKv`6t7Jm^D?_ufvotS1{0F6axPn^3Y(Tq#4I*8vS^31DR
zEc*y|?u7bX+KkQ8RUztgbPk3=1%~p0+?v!mh!*C>4Qls7HIyG
z{0Emq3lsk*psI6jpaUiwH4S#q#R~oAoQTnDpRrXsa6g>sOk7hPy8jEiQz9n+Aglq!Z+E+YBXR2>0-q
z`=}yY3EPtAXsKM6KsO%V`~&lCV`hw7;Qi4rO(+|5g~&ajS}
zzA#9}qT4<>A+={u%y+F2@;lX&bNX&EY4eR|hdIUut^-lXhrp>B0|r=$9s_;VK3F)v
zfAd{*-A`_vy?k4=H5
zX9#pzgRkNA2tGu(HmxsrS8x0e;(6zA&^{3fRJX#TAYT;Te|f9~aD^GE>1#>T{VG@{
zR6q87YU600=MyuRAGtjla8H>yQchXN))+;8oh__u5t(Z`;%|@3(#-_jB6vm)nZ|9}
zvR#6SzZKOd>`<)yhX^AoFN&~03Z(x
z?GHwF*S4@1J%nMB_bX_cqL@JAHX-``e8c?6dio;-0Mm>c<24C62^#^lEQgh6DS^?n
zYJq^qaJ)G}!69Tp_br15t(Gb+>L|Ssbrkn%665>d;lm?mae(EBWX*1&-mYMX0u$4Z
zn7qnXI*{*%{ZuqA6VB!!EH!ilkc84!HIP-7m`e!JzOBURY;YkH3g9`kb6)weY=!Lo
zVGwp@`Z}=J?$)olO
z_)>FYy_%{pPDo)b+HBM9Ow$c-31tADp=qlnn3cLyA$2A8bBmSbhgo1(b3Gl~a*M1t
zTW9vs*Z%8^4d+y9<1M2KTI6VNjlk}EjVrJ#ssms_mr$R_?$zGUsW=-NznWru^vt+w
z?N1gjY!_75STo$0dl%GpdUe$3
z*+J<~&xCoC{a&owlSo@SZ?h-oipAcW{92q1jM|p+wfox^rwMmZs4pOe6n_2pdc!=X
zomc3a_vONw=Akb=i|Zf#CC>!}hXm{Y2$c~c>i}1DUy9i6W1ah=UgaS*qa3FZk54fB
zizN7E6tQW5xtR%SH2`NH;Q~U
z3w!mhJOgFOGC7@F7LSl=J;IP@u&@~~tKJAe`>oF95X}oLJw=8V2kuESO=27%F4enOl>%OWO@?ht^mrld>!D&TaSk%
zK~q4&+CTc?JUm>la~G7K%&9)FU{&$$PBe|fs_hENT4w>i-naG=a4(}%{tyx9w_g4e
zihLGBo`o56z1$29=UrnS|1)J>6`HXNYd9h
zSm?d`^92q>D?Uz!?PekJPA=U@WR_+zHd+;G3)zZwy;v>pO3GO4nO1lIb;K(xtv+R+
zjS3_@Qef>|+p=&^{r23*mkVw000}Pl^PArQYwOej+jQu3OUZfjBi)jhHCdBh
z?>)K$<_AiCtao=`Ix^k(R%q&cY>%*(x$V=t+4VlLW3Wxu)kMN9C9V!W^bxr=|1vmH
z4Z#x2Ep=<)Ov=d<#iE-7tVI5bK*TTE9mm96Z-5$XHa=O7EmT;+V4Cuz+U`MWa<|PAhtu>
zt!U|1%fubQG8(qSjo`bp<{Fbp97(_POKySv#FJq*ymoMx>CDk)?At^^a5wfyF+*9@
zy;5IzUUALK!zS0|g&-713dVC4O;V{Xi^M{!`0EFGB)>Z9p5q;`;yPL~8}5c5=EN9L
z@+=FqA-W`TWV;b%x;$wo7d@*xht3kK%K1%RU!KmStu(W2i-#{iQ3zyA+6$mIf8W+@
zw?KiY_qNAXwVVGGRzN^1?yN!trtTvtN~rVAEwL3LkPMRR(;O`@Pe1%PAhS@Q62NOO
zbx_v6daQ$EY=lQ*eKY+Q9BmE2<{&8qUTf4Q+l+f@G17|69~&=!(G}um^xq7*T`kWg
z(T#^Ph;c!=t!frODAtAqib;(+we2M=#R|EPS!kl%&0U71E7UM
zmQh1~>S%jYolr99H++S^k-?c)mObtwVQ!qYMMbfH#99hf(sfD5;wM|H@zi;IXB
z_5e~a5~=9il3h*v7=@#9X+&8E6*mb8m{$qin)2)8=DVV+FDprAX5vCx
zNI44uNNP1mssK{)g1sWQEigFa!U9O>BEhL@M+DsERMGftFS-g1aa^&Zsnn{`26S(MU9)XPCB`3RBZH_t5
z(Er@^l!kdw{RVY?OzSH3^f76|+^2knc(KfSY$U4)yqljqXh3>2+{f*_Sqy0~KDNlT
zU%>q+x{CgbPsy^#Hl0<=)Q#6^ija5_uqw*kYUu{ZWc6oSis19yQnj
zq2b;81zoTbd3s2#Ov*Wgx<;EEkF2mMHKMUVlhObH*bXY>vrg2$J_#gLEm>;d)N(%xGh^;;HhkuTXQt5dju_cYj)0CQ_;`F%N7<999~eq=D4tL5Eu
z)hkO{-9JQ7DRuTqhor)$r0#Ebc35h?KJ@zt)IPJ_el?alIF=6;f1U
zx|;uqW{3u6^z^AU#$s|@=F)RSw5!#z%gYnlw8zt~)BnczXiE(#7pP^Wsxth@Vzt;O
zDn#&et6p$b#qz2m6>(?^aW)&AWWZ;U;)JtLlvYn=A`KyH>$o>&?casI4`8qCVoW7?
zkmr-2a|S>Wdo|M0nk@KvHHo=gdF2B|uY)HRnK}bQpXq!EGeOI-e|Zrb*PW3&o!S4~
z{Y2QJu+};!C*JU9DDicyF!)s0Lut*RkGHP>zL}TeP;fId?TGV10cfFZ=T%NTO5wVK
z;s7@9?l-xJrIv=(DJ;CT`P16|HI5?lKWP@}uE=+7mK47*4hPz4GggaXuTJRh2~RS^
z0oCdLDhN_i4)tt7;cIK*R!jB{5m)>P(5EyHV290@SK6p$bARhYo~~U?-fBU4ASFO1zyb0RR*hAi7XJ_E$xUJ!nck6n~gcIF$#DA+!I|9`C;HxL$
zGBuchYab7;<03UgXfU^~8bq__U|VdX({kPGD!Sz6;#@_hUn-NA!*YfICm$%&$vCx!~5a>6NHuMJPfLpG;lchoeTKtq*>
z#D6y1nr7}bv}7Be+{m(vBC$RE>(f^{oEz)|6c<-+tNdF_OlP-_`etHou*!+y-Ra?lxy`GtKWxg~*K~WgFd<cPVIyd$TcZV9Upg#Zu(3fZ2EsQF2d4u7ftM~3mM-?3#mGS4^QGIprY5x
zAAjXy8}OfRd*@mXZ4;7ie3&kP#tA_bE1Kr0Wt#_|
z!yK5Cnbp~y`)<0BUoN_j&bcdklnpU6F7B1Gs=!(!)QyiVggX3eEY0X>8n~}F+NvRd
zrBQ<~LU`rgSIe)({-2m!-YzjA6&xZ?aSD53vg>tZy=q6WrAiI9hBy(qgSrE84Of1y
zGe$wLd2%JjkzO=@h#572867|VKIQzwJ41WOxt2h+ij?ODo5Cts_Pxc)J8Pv9#9(&y
zfkZvEOr>GicVf_$-eBuv?WH5n9EqPIwj4|=oO3mk*ls89z=#i`8XqGvv^yB6CCDE1
z8r0uyI>xP(a5O9lMs6ElFdd<2DG4sex11@Sm1Q;EsQVIEXEgpXC?Mi1S4S=kieV&Z
z(W`QTuaI6k>n*_F0J&6vTevf+sQL%9-Lt~$sb9p?Z#3O+P2dSTD;_y&4IVxeoKv9@
zC{K{K{Hs+cV@ous(Q~(Qq_gC@74QF+5)sYo*=`AEjg{YI9lP_T>$95E=|1d>o>IZP
zb(Lk}>shhP6xqQGvGsl`YGCCn-hj-UCHhm#rS&adZi&dAYDh~|BBTBiP-t%M1RdYV
zxMP21HwYk|+WviM3nzVwo2Ey#K4*3g+rr-AV?;UvAx&+Lpk>ZWi_M+u{N*_NLMIjL
zy{C%0QtrBJme)Nk{;&=(yJ9aRd=zJ9&HQ1TURNE7k+;c_Su=WGzbg`UUewu#W`cb!
z1pHMKg&l8&+fuoT+rfg4)2YP}UUV-2c9VROiEYWg$4$Q40=5E%9>#TGiU4GFKl7;B
zK;76)|H^PpwA-Ud$Z>M?VC13a*3CsyR>Nl&It})PLi2dXyN%jAh=EYeiaw|5`(_wPAOD(|`|Fs#McI
z^92DEQo`Hmd^U$a9XNTCygonjB67ZPHVVN{Q*Pcbk=57Pbq-%l`=eFZJaA7NWeN