diff --git a/R/ggplot_shiny.R b/R/ggplot_shiny.R index 7dafcb1..36b5140 100644 --- a/R/ggplot_shiny.R +++ b/R/ggplot_shiny.R @@ -1,4 +1,4 @@ -#' Creating a graphical user interface for creating ggplot-graphs. + #' Creating a graphical user interface for creating ggplot-graphs. #' #' @param dataset A dataset (optional). #' @return A GUI for visualizing data from \code{dataset}. @@ -16,174 +16,175 @@ #' @export -ggplot_shiny <- function( dataset = NA ) { - - ui <- fluidPage( - headerPanel("ggplot GUI"), - sidebarPanel(width = 3, - conditionalPanel( - condition = "input.tabs=='Data upload'", - h4("Data upload"), - radioButtons( - "data_input", "", - choices = if (is.data.frame(dataset)) { - list("Load sample data" = 1, - "Upload text file" = 2, - "Paste data" = 3, - "Data passed through R environment" = 4) - } else { - list("Load sample data" = 1, - "Upload file" = 2, - "Paste data" = 3) - }, - selected = if (is.data.frame(dataset)) 4 else 1), - conditionalPanel( - condition = "input.data_input=='1'", - h5("dataset 'mpg' from library(ggplot2) loaded") - ), - conditionalPanel( - condition = "input.data_input=='2'", - h5("Upload file: "), - fileInput("upload", "", multiple = FALSE), - selectInput("file_type", "Type of file:", - list("text (csv)" = "text", - "Excel" = "Excel", - "SPSS" = "SPSS", - "Stata" = "Stata", - "SAS" = "SAS"), - selected = "text"), - conditionalPanel( - condition = "input.file_type=='text'", - selectInput("upload_delim", "Delimiter:", - list("Semicolon" = ";", - "Tab" = "\t", - "Comma" = ",", - "Space" = " "), - selected = "Semicolon")), - actionButton("submit_datafile_button", - "Submit datafile")), - conditionalPanel( - condition = "input.data_input=='3'", - h5("Paste data below:"), - tags$textarea(id = "data_paste", - placeholder = "Add data here", - rows = 10, - cols = 20, ""), - actionButton("submit_data_button", "Submit data"), - selectInput("text_delim", "Delimiter:", - list("Semicolon" = ";", - "Tab" = "\t", - "Comma" = ",", - "Space" = " "), - selected = "Semicolon") - ) - ), - conditionalPanel( - condition = "input.tabs=='ggplot' || input.tabs=='Plotly' || +# ggplot_shiny <- function( dataset = NA ) { + +ui <- fluidPage( + headerPanel("ggplot GUI"), + sidebarPanel(width = 3, + conditionalPanel( + condition = "input.tabs=='Data upload'", + h4("Data upload"), + radioButtons( + "data_input", "", + choices = #if (is.data.frame(dataset)) { + list("Load sample data" = 1, + "Upload file" = 2, + "Paste data" = 3)), + conditionalPanel( + condition = "input.data_input=='1'", + h5("dataset 'mpg' from library(ggplot2) loaded") + ), + conditionalPanel( + condition = "input.data_input=='2'", + h5(strong("Upload file: ")), + fileInput("upload", "", multiple = FALSE), + selectInput("file_type", "Type of file:", + list("text (csv)" = "text", + "Excel" = "Excel", + "SPSS" = "SPSS", + "Stata" = "Stata", + "SAS" = "SAS"), + selected = "text"), + conditionalPanel( + condition = "input.file_type=='text'", + selectInput("upload_delim", "Delimiter:", + list("Semicolon" = ";", + "Tab" = "\t", + "Comma" = ",", + "Space" = " "), + selected = "Semicolon")) + ), + conditionalPanel( + condition = "input.data_input=='3'", + h5(strong("Paste data below:")), + tags$textarea(id = "data_paste", + placeholder = "Add data here", + rows = 10, + cols = 20, ""), + actionButton("submit_data_button", "Submit data"), + selectInput("text_delim", "Delimiter:", + list("Semicolon" = ";", + "Tab" = "\t", + "Comma" = ",", + "Space" = " "), + selected = "Semicolon") + ), + conditionalPanel ( + condition = "input.data_input =='2' || input.data_input == '3'", + h5("To use ggplot, the data needs to be in long format. See the", actionLink("data_format", "Data Format"), " tab for more info."), + h5("If your data is already in long format, select \"My data is correctly formatted\"."), + h5("To reformat your data, choose metadata columns below. Metadata columns contains unique identifying information about each sample/observation."), + radioButtons("data_already_formatted", label = "How should we process your raw data?", choices = list("My data is already correctly formatted. Do not reformat." = "no", "Reformat my data from wide to long." = "yes")), + conditionalPanel(condition = "input.data_already_formatted == 'yes'", + selectInput("dataIDs", "Select Metadata Columns:", choices = NULL, multiple = TRUE) + ), + actionButton("melt_data_button", "Submit My Data",style="background-color: #80c3ff") + ) + ), + conditionalPanel( + condition = "input.tabs=='ggplot' || input.tabs=='Plotly' || input.tabs=='R-code'", - h4("Create visualization"), - selectInput(inputId = "Type", - label = "Type of graph:", - choices = c("Boxplot", "Density", "Dot + Error", - "Dotplot", "Histogram", "Scatter", "Violin"), - selected = "Violin"), - selectInput("y_var", "Y-variable", choices = ""), - conditionalPanel( - condition = "input.Type!='Density' && input.Type!='Histogram'", - selectInput("x_var", "X-variable", choices = "") - ), - selectInput("group", "Group (or colour)", choices = ""), - selectInput("facet_row", "Facet Row", choices = ""), - selectInput("facet_col", "Facet Column", choices = ""), - conditionalPanel( - condition = "input.Type == 'Boxplot' || input.Type == 'Violin' || + h4("Create visualization"), + selectInput(inputId = "Type", + label = "Type of graph:", + choices = c("Boxplot", "Density", "Dot + Error", + "Dotplot", "Histogram", "Scatter", "Violin"), + selected = "Violin"), + selectInput("y_var", "Y-variable", choices = ""), + conditionalPanel( + condition = "input.Type!='Density' && input.Type!='Histogram'", + selectInput("x_var", "X-variable", choices = "") + ), + selectInput("group", "Group (or colour)", choices = ""), + selectInput("facet_row", "Facet Row", choices = ""), + selectInput("facet_col", "Facet Column", choices = ""), + conditionalPanel( + condition = "input.Type == 'Boxplot' || input.Type == 'Violin' || input.Type == 'Dot + Error'", - checkboxInput(inputId = "jitter", - label = strong("Show data points (jittered)"), - value = FALSE) - ), - conditionalPanel( - condition = "input.Type == 'Boxplot'", - checkboxInput(inputId = "notch", - label = strong("Notched box plot"), - value = FALSE) - ), - conditionalPanel( - condition = "input.Type == 'Density' || input.Type == 'Histogram'", - sliderInput("alpha", "Opacity:", min = 0, max = 1, value = 0.8) - ), - conditionalPanel( - condition = "input.Type == 'Histogram' || input.Type=='Dotplot'", - numericInput("binwidth", "Binwidth:", value = 1) - ), - conditionalPanel( - condition = "input.Type == 'Dotplot'", - selectInput("dot_dir", "Direction stack:", - choices = c("up", "down", "center", "centerwhole"), - selected = "up") - ), - conditionalPanel( - condition = "input.Type == 'Density' || input.Type == 'Violin'", - sliderInput(inputId = "adj_bw", - label = "Bandwidth adjustment:", - min = 0.01, max = 2, value = 1, step = 0.1) - ), - conditionalPanel( - condition = "input.Type == 'Scatter'", - checkboxInput(inputId = "line", - label = strong("Show regression line"), - value = FALSE), - conditionalPanel( - condition = "input.line == true", - selectInput("smooth", "Smoothening function", - choices = c("lm", "loess", "gam")) - ), - conditionalPanel( - condition = "input.line == true", - checkboxInput(inputId = "se", - label = strong("Show confidence interval"), - value = FALSE) - ) - ), - conditionalPanel( - condition = "input.Type == 'Dot + Error'", - selectInput("CI", "Confidence Interval:", - choices = c("68% (1 SE)" = 1, - "90%" = 1.645, - "95%" = 1.96, - "99%" = 2.575), - selected = 1.96) - ) - ), - conditionalPanel( - condition = "input.tabs=='Info'", - h4("Info") - ) - ), - h6("For more info see the 'Info'-tab or visit", - a("https://github.com/gertstulp/ggplotgui", - href = "https://github.com/gertstulp/ggplotgui")), - -##################################### -########### OUPUT TABS ############## -##################################### - - mainPanel(width = 6, - tabsetPanel( - type = "tabs", - tabPanel("Data upload", dataTableOutput("out_table")), - tabPanel("ggplot", - mainPanel( - downloadButton("download_plot_PDF", - "Download pdf of figure"), - plotOutput("out_ggplot")) - ), - tabPanel("Plotly", plotlyOutput("out_plotly")), - tabPanel("R-code", verbatimTextOutput("out_r_code")), - tabPanel("Info", -h3("Background"), -p( - a("R", href = "https://www.r-project.org/"), "is amazing, but daunting + checkboxInput(inputId = "jitter", + label = strong("Show data points (jittered)"), + value = FALSE) + ), + conditionalPanel( + condition = "input.Type == 'Boxplot'", + checkboxInput(inputId = "notch", + label = strong("Notched box plot"), + value = FALSE) + ), + conditionalPanel( + condition = "input.Type == 'Density' || input.Type == 'Histogram'", + sliderInput("alpha", "Opacity:", min = 0, max = 1, value = 0.8) + ), + conditionalPanel( + condition = "input.Type == 'Histogram' || input.Type=='Dotplot'", + numericInput("binwidth", "Binwidth:", value = 1) + ), + conditionalPanel( + condition = "input.Type == 'Dotplot'", + selectInput("dot_dir", "Direction stack:", + choices = c("up", "down", "center", "centerwhole"), + selected = "up") + ), + conditionalPanel( + condition = "input.Type == 'Density' || input.Type == 'Violin'", + sliderInput(inputId = "adj_bw", + label = "Bandwidth adjustment:", + min = 0.01, max = 2, value = 1, step = 0.1) + ), + conditionalPanel( + condition = "input.Type == 'Scatter'", + checkboxInput(inputId = "line", + label = strong("Show regression line"), + value = FALSE), + conditionalPanel( + condition = "input.line == true", + selectInput("smooth", "Smoothening function", + choices = c("lm", "loess", "gam")) + ), + conditionalPanel( + condition = "input.line == true", + checkboxInput(inputId = "se", + label = strong("Show confidence interval"), + value = FALSE) + ) + ), + conditionalPanel( + condition = "input.Type == 'Dot + Error'", + selectInput("CI", "Confidence Interval:", + choices = c("68% (1 SE)" = 1, + "90%" = 1.645, + "95%" = 1.96, + "99%" = 2.575), + selected = 1.96) + ) + ), + conditionalPanel( + condition = "input.tabs=='Info'", + h4("Info") + ) + ), + h6("For more info see the 'Info'-tab or visit", + a("https://github.com/gertstulp/ggplotgui", + href = "https://github.com/gertstulp/ggplotgui")), + + ##################################### + ########### OUPUT TABS ############## + ##################################### + + mainPanel(width = 6, + tabsetPanel( + type = "tabs", + tabPanel("Data upload", dataTableOutput("out_table"), dataTableOutput("melted_data")), + tabPanel("ggplot", + mainPanel( + plotOutput("out_ggplot")) + ), + tabPanel("Plotly", plotlyOutput("out_plotly")), + tabPanel("R-code", verbatimTextOutput("out_r_code")), + tabPanel("Info", + h3("Background"), + p( + a("R", href = "https://www.r-project.org/"), "is amazing, but daunting for many. The programming style of R, compared to the point-and-click style of typical software, is a hurdle for many. Perhaps particularly so for those in the social sciences, whose statistical needs are often met by @@ -193,576 +194,615 @@ p( To lower the barrier to start using R, this package allows users to visualize their data using an online graphical user interface (GUI) that makes use of R's visualization package", - a("ggplot", href = "http://ggplot2.org/"), - ". There are two ways of using this functionality: 1) online, where users + a("ggplot", href = "http://ggplot2.org/"), + ". There are two ways of using this functionality: 1) online, where users can upload their data and visualize it without needing R, by visiting ", - a("this website", - href = "https://site.shinyserver.dck.gmw.rug.nl/ggplotgui/"), - "; 2) from within the R-environment (by using the ", code("ggplot_shiny()"), - "function). Importantly, the R-code will also be provided such that the user + a("this website", + href = "https://site.shinyserver.dck.gmw.rug.nl/ggplotgui/"), + "; 2) from within the R-environment (by using the ", code("ggplot_shiny()"), + "function). Importantly, the R-code will also be provided such that the user can recreate the graphs within the R-environment. The main aim (or hope) is to get more people using R and its wonderful (graphing) capabilities." -), -h3("App info"), -p( - "This application was built in ", - a("R", href = "https://www.r-project.org/"), - "version 3.3.2, and uses the following packages: ", - a("ggplot2", href = "http://ggplot2.tidyverse.org/"), ",", - a("Shiny", href = "http://www.rstudio.com/shiny/"), ",", - a("stringr", href = "http://stringr.tidyverse.org/"), ",", - a("plotly", href = "https://plot.ly/r/"), ",", - a("readr", href = "http://readr.tidyverse.org/"), ",", - a("readxl", href = "http://readxl.tidyverse.org/"), ",", - a("haven", href = "http://haven.tidyverse.org/"), ", and", - a("RColorBrewer.", href = "http://stringr.tidyverse.org/") -), -p( - "This application was created by ", - a("Gert Stulp", href = "http://www.gertstulp.com/"), - ". Please do report bugs and send feature requests to ", - a("g.stulp[at]rug.nl", href = "mailto:g.stulp@rug.nl"), - ". Visit ", - a("https://github.com/gertstulp/ggplotgui", - href = "https://github.com/gertstulp/ggplotgui"), - "for further description and code." -), -h3("Acknowledgements"), -p( - "Thanks to Wilmer Joling for setting up the ", - a("website", href = "https://site.shinyserver.dck.gmw.rug.nl/ggplotgui/"), - "which is based on the magical but incomprehensible", - a("docker", href = "https://www.docker.com/"), - ". Thanks to ", - a("Hadley Wicham", href = "http://hadley.nz/"), - " for making such good packages (and open access + ), + h3("App info"), + p( + "This application was built in ", + a("R", href = "https://www.r-project.org/"), + "version 3.3.2, and uses the following packages: ", + a("ggplot2", href = "http://ggplot2.tidyverse.org/"), ",", + a("Shiny", href = "http://www.rstudio.com/shiny/"), ",", + a("stringr", href = "http://stringr.tidyverse.org/"), ",", + a("plotly", href = "https://plot.ly/r/"), ",", + a("readr", href = "http://readr.tidyverse.org/"), ",", + a("readxl", href = "http://readxl.tidyverse.org/"), ",", + a("haven", href = "http://haven.tidyverse.org/"), ", and", + a("RColorBrewer.", href = "http://stringr.tidyverse.org/") + ), + p( + "This application was created by ", + a("Gert Stulp", href = "http://www.gertstulp.com/"), + ". Please do report bugs and send feature requests to ", + a("g.stulp[at]rug.nl", href = "mailto:g.stulp@rug.nl"), + ". Visit ", + a("https://github.com/gertstulp/ggplotgui", + href = "https://github.com/gertstulp/ggplotgui"), + "for further description and code." + ), + h3("Acknowledgements"), + p( + "Thanks to Wilmer Joling for setting up the ", + a("website", href = "https://site.shinyserver.dck.gmw.rug.nl/ggplotgui/"), + "which is based on the magical but incomprehensible", + a("docker", href = "https://www.docker.com/"), + ". Thanks to ", + a("Hadley Wicham", href = "http://hadley.nz/"), + " for making such good packages (and open access books describing them), that allow even low-skilled and low-talented programmers like myself to be able to contribute to R" -) - ), - id = "tabs" - ) - ), - -##################################### -######### AESTHETICS TAB ############ -##################################### - - conditionalPanel( - condition = "input.tabs=='ggplot' || input.tabs=='Plotly' || + ) + ), + tabPanel("Data Format", + h3("Data Format"), + p("The following explanation of long and wide data is from R-Ladies Sydney's blog post on 11/28/2018."), + p("When you entered your data in excel, you probably entered it in wide format. Data in wide format has observations spread across several columns; each column contains data from a different condition (or combination of conditions). wide data is messy."), + p("In the wide example below, we have scores from participants who were tested twice (Time 1 and Time 2) after studying different lists of words under two different conditions (Condition 1 and Condition 2)."), + img(src = "wide_format_example.png", width = 700, height = 500), + p("In contrast, data in long format has all the observations in a single column and variables in separate columns."), + img(src = "long_format_example.png", width = 700, height = 660), + h3("Changing from wide to long"), + img(src = "wide_to_long.gif", width = 400, height = 400), + p("The dataframe on the left is in wide format; the performance of each baker in each spice test is listed across different columns. The dataframe on the right is in long format; all of the accuracy scores are in a single column and information about which baker and spice test each observation came from are represented in separate variables."), + img(src = "wide_to_long_bakers.png", width = 700, height = 370) + ), + id = "tabs" + ) + ), + + ##################################### + ######### AESTHETICS TAB ############ + ##################################### + + conditionalPanel( + condition = "input.tabs=='ggplot' || input.tabs=='Plotly' || input.tabs=='R-code'", - sidebarPanel( - width = 3, - h4("Change aesthetics"), - tabsetPanel( - tabPanel( - "Text", - checkboxInput(inputId = "label_axes", - label = strong("Change labels axes"), - value = FALSE), - conditionalPanel( - condition = "input.label_axes == true", - textInput("lab_x", "X-axis:", value = "label x-axis") - ), - conditionalPanel( - condition = "input.label_axes == true", - textInput("lab_y", "Y-axis:", value = "label y-axis") - ), - checkboxInput(inputId = "add_title", - label = strong("Add title"), - value = FALSE), - conditionalPanel( - condition = "input.add_title == true", - textInput("title", "Title:", value = "Title") - ), - checkboxInput(inputId = "adj_fnt_sz", - label = strong("Change font size"), - value = FALSE), - conditionalPanel( - condition = "input.adj_fnt_sz == true", - numericInput("fnt_sz_ttl", - "Size axis titles:", - value = 12), - numericInput("fnt_sz_ax", - "Size axis labels:", - value = 10) - ), - checkboxInput(inputId = "rot_txt", - label = strong("Rotate text x-axis"), - value = FALSE), - checkboxInput(inputId = "adj_fnt", - label = strong("Change font"), + sidebarPanel( + width = 3, + h4("Change aesthetics"), + tabsetPanel( + tabPanel( + "Text", + checkboxInput(inputId = "label_axes", + label = strong("Change labels axes"), + value = FALSE), + conditionalPanel( + condition = "input.label_axes == true", + textInput("lab_x", "X-axis:", value = "label x-axis") + ), + conditionalPanel( + condition = "input.label_axes == true", + textInput("lab_y", "Y-axis:", value = "label y-axis") + ), + checkboxInput(inputId = "add_title", + label = strong("Add title"), + value = FALSE), + conditionalPanel( + condition = "input.add_title == true", + textInput("title", "Title:", value = "Title") + ), + checkboxInput(inputId = "adj_fnt_sz", + label = strong("Change font size"), + value = FALSE), + conditionalPanel( + condition = "input.adj_fnt_sz == true", + numericInput("fnt_sz_ttl", + "Size axis titles:", + value = 12), + numericInput("fnt_sz_ax", + "Size axis labels:", + value = 10) + ), + checkboxInput(inputId = "rot_txt", + label = strong("Rotate text x-axis"), + value = FALSE), + checkboxInput(inputId = "adj_fnt", + label = strong("Change font"), + value = FALSE), + conditionalPanel( + condition = "input.adj_fnt == true", + selectInput("font", "Font", + choices = c("Courier", + "Helvetica", + "Times"), + selected = "Helvetica") + ) + ), + tabPanel( + "Theme", + conditionalPanel( + condition = "input.group != '.'", + checkboxInput(inputId = "adj_col", + label = strong("Change colours"), value = FALSE), conditionalPanel( - condition = "input.adj_fnt == true", - selectInput("font", "Font", - choices = c("Courier", - "Helvetica", - "Times"), - selected = "Helvetica") + condition = "input.adj_col", + selectInput(inputId = "palet", + label = strong("Select palette"), + choices = list( + "Qualitative" = c("Accent", + "Dark2", + "Paired", + "Pastel1", + "Pastel2", + "Set1", + "Set2", + "Set3"), + "Diverging" = c("BrBG", + "PiYG", + "PRGn", + "PuOr", + "RdBu", + "RdGy", + "RdYlBu", + "RdYlGn", + "Spectral"), + "Sequential" = c("Blues", + "BuGn", + "BuPu", + "GnBu", + "Greens", + "Greys", + "Oranges", + "OrRd", + "PuBu", + "PuBuGn", + "PuRd", + "Purples", + "RdPu", + "Reds", + "YlGn", + "YlGnBu", + "YlOrBr", + "YlOrRd")), + selected = "set1") ) ), - tabPanel( - "Theme", - conditionalPanel( - condition = "input.group != '.'", - checkboxInput(inputId = "adj_col", - label = strong("Change colours"), - value = FALSE), - conditionalPanel( - condition = "input.adj_col", - selectInput(inputId = "palet", - label = strong("Select palette"), - choices = list( - "Qualitative" = c("Accent", - "Dark2", - "Paired", - "Pastel1", - "Pastel2", - "Set1", - "Set2", - "Set3"), - "Diverging" = c("BrBG", - "PiYG", - "PRGn", - "PuOr", - "RdBu", - "RdGy", - "RdYlBu", - "RdYlGn", - "Spectral"), - "Sequential" = c("Blues", - "BuGn", - "BuPu", - "GnBu", - "Greens", - "Greys", - "Oranges", - "OrRd", - "PuBu", - "PuBuGn", - "PuRd", - "Purples", - "RdPu", - "Reds", - "YlGn", - "YlGnBu", - "YlOrBr", - "YlOrRd")), - selected = "set1") - ) - ), - conditionalPanel( - condition = "input.jitter", - checkboxInput("adj_jitter", - strong("Change look jitter"), FALSE), - conditionalPanel( - condition = "input.adj_jitter", - textInput("col_jitter", "Colour (name or RGB):", - value = "black"), - numericInput("size_jitter", "Size:", value = 1), - sliderInput("opac_jitter", "Opacity:", - min = 0, max = 1, value = 0.5, step = 0.01), - sliderInput("width_jitter", "Width jitter:", - min = 0, max = 0.5, value = 0.25, step = 0.01) - ) - ), - checkboxInput("adj_grd", - strong("Remove gridlines"), FALSE), - conditionalPanel( - condition = "input.adj_grd", - checkboxInput("grd_maj", - strong("Remove major gridlines"), FALSE), - checkboxInput("grd_min", - strong("Remove minor gridlines"), FALSE) - ), - selectInput("theme", "Theme", - choices = c("bw" = "theme_bw()", - "classic" = "theme_classic()", - "dark" = "theme_dark()", - "grey" = "theme_grey()", - "light" = "theme_light()", - "line_draw" = "theme_linedraw()", - "minimal" = "theme_minimal()"), - selected = "theme_bw()") - ), - tabPanel( - "Legend", + conditionalPanel( + condition = "input.jitter", + checkboxInput("adj_jitter", + strong("Change look jitter"), FALSE), conditionalPanel( - condition = "input.group != '.'", - radioButtons(inputId = "adj_leg", - label = NULL, - choices = c("Keep legend as it is", - "Remove legend", - "Change legend"), - selected = "Keep legend as it is"), - conditionalPanel( - condition = "input.adj_leg=='Change legend'", - textInput("leg_ttl", "Title legend:", - value = "title legend"), - selectInput("pos_leg", "Position legend", - choices = c("right", - "left", - "top", - "bottom")) - ) + condition = "input.adj_jitter", + textInput("col_jitter", "Colour (name or RGB):", + value = "black"), + numericInput("size_jitter", "Size:", value = 1), + sliderInput("opac_jitter", "Opacity:", + min = 0, max = 1, value = 0.5, step = 0.01), + sliderInput("width_jitter", "Width jitter:", + min = 0, max = 0.5, value = 0.25, step = 0.01) ) ), - tabPanel( - "Size", - checkboxInput("fig_size", - strong("Adjust plot size on screen"), FALSE), - conditionalPanel( - condition = "input.fig_size", - numericInput("fig_height", "Plot height (# pixels): ", - value = 480), - numericInput("fig_width", "Plot width (# pixels):", value = 480) - ), - checkboxInput("fig_size_download", - strong("Adjust plot size for download"), FALSE), + checkboxInput("adj_grd", + strong("Remove gridlines"), FALSE), + conditionalPanel( + condition = "input.adj_grd", + checkboxInput("grd_maj", + strong("Remove major gridlines"), FALSE), + checkboxInput("grd_min", + strong("Remove minor gridlines"), FALSE) + ), + selectInput("theme", "Theme", + choices = c("bw" = "theme_bw()", + "classic" = "theme_classic()", + "dark" = "theme_dark()", + "grey" = "theme_grey()", + "light" = "theme_light()", + "line_draw" = "theme_linedraw()", + "minimal" = "theme_minimal()"), + selected = "theme_bw()") + ), + tabPanel( + "Legend", + conditionalPanel( + condition = "input.group != '.'", + radioButtons(inputId = "adj_leg", + label = NULL, + choices = c("Keep legend as it is", + "Remove legend", + "Change legend"), + selected = "Keep legend as it is"), conditionalPanel( - condition = "input.fig_size_download", - numericInput("fig_height_download", - "Plot height (in cm):", value = 14), - numericInput("fig_width_download", - "Plot width (in cm):", value = 14) + condition = "input.adj_leg=='Change legend'", + textInput("leg_ttl", "Title legend:", + value = "title legend"), + selectInput("pos_leg", "Position legend", + choices = c("right", + "left", + "top", + "bottom")) ) ) - ) # Close tabsetPanel - ) # Close sidebarPanel - ) # Close conditionalPanel - ) # Close fluidPage - - server <- function(input, output, session) { - -##################################### -### GET VARIABLE NAMES FOR INPUT #### -##################################### - - observe({ - nms <- names(df_shiny()) - # Make list of variables that are not factors - nms_cont <- names(Filter(function(x) is.integer(x) || - is.numeric(x) || - is.double(x), - df_shiny())) - - # Make list of variables that are not factors - nms_fact <- names(Filter(function(x) is.factor(x) || - is.logical(x) || - is.character(x), - df_shiny())) - - avail_all <- c("No groups" = ".", nms) - avail_con <- - if (identical(nms_cont, character(0))) - c("No continuous vars available" = ".") - else c(nms_cont) - avail_fac <- - if (identical(nms_fact, character(0))) - c("No factors available" = ".") - else c("No groups" = ".", nms_fact) - - updateSelectInput(session, "y_var", choices = avail_con) - updateSelectInput(session, "x_var", choices = c("No x-var" = "' '", nms)) - updateSelectInput(session, "group", choices = avail_all) - updateSelectInput(session, "facet_row", choices = avail_fac) - updateSelectInput(session, "facet_col", choices = avail_fac) - }) - - -##################################### -###### READ IN / GET DATA ########### -##################################### - - df_shiny <- reactive({ - if (input$data_input == 1) { - data <- ggplot2::mpg - } else if (input$data_input == 2) { - file_in <- input$upload - # Avoid error message while file is not uploaded yet - if (is.null(input$upload)) { - return(data.frame(x = "Select your datafile")) - } else if (input$submit_datafile_button == 0) { - return(data.frame(x = "Press 'submit datafile' button")) - } else { - isolate({ - if (input$file_type == "text") { - data <- read_delim(file_in$datapath, - delim = input$text_delim, - col_names = TRUE) - } else if (input$file_type == "Excel") { - data <- read_excel(file_in$datapath) - } else if (input$file_type == "SPSS") { - data <- read_sav(file_in$datapath) - } else if (input$file_type == "Stata") { - data <- read_dta(file_in$datapath) - } else if (input$file_type == "SAS") { - data <- read_sas(file_in$datapath) - } - }) + ), + tabPanel( + "Size", + numericInput("fig_height", "Plot height (# pixels): ", + value = 800), + numericInput("fig_width", "Plot width (# pixels):", value = 1000) + ), + tabPanel( + "Download", + numericInput("fig_height_download", + "Plot height (in cm):", value = 14), + numericInput("fig_width_download", + "Plot width (in cm):", value = 14), + radioButtons("download_as", "Download File Type:", choices = list("PDF" = ".pdf", "SVG" = ".svg", "PNG" = ".png", "JPEG" = ".jpeg", "GIF" = ".gif"), selected = ".pdf"), + downloadButton("download_plot", "Download Plot") + ) + ) # Close tabsetPanel + ) # Close sidebarPanel + ) # Close conditionalPanel +) # Close fluidPage + +server <- function(input, output, session) { + values = reactiveValues( + data = NULL, + data_melted = NULL + ) + + ##################################### + ### GET VARIABLE NAMES FOR INPUT #### + ##################################### + + observe({ + nms <- names(values$data_melted) + # Make list of variables that are not factors + nms_cont <- names(Filter(function(x) is.integer(x) || + is.numeric(x) || + is.double(x), + values$data_melted)) + + # Make list of variables that are not factors + nms_fact <- names(Filter(function(x) is.factor(x) || + is.logical(x) || + is.character(x), + values$data_melted)) + + avail_all <- c("No groups" = ".", nms) + avail_con <- + if (identical(nms_cont, character(0))) + c("No continuous vars available" = ".") + else c(nms_cont) + avail_fac <- + if (identical(nms_fact, character(0))) + c("No factors available" = ".") + else c("No groups" = ".", nms_fact) + + updateSelectInput(session, "y_var", choices = avail_con) + updateSelectInput(session, "x_var", choices = c("No x-var" = "' '", nms)) + updateSelectInput(session, "group", choices = avail_all) + updateSelectInput(session, "facet_row", choices = avail_fac) + updateSelectInput(session, "facet_col", choices = avail_fac) + }) + + + ##################################### + ###### READ IN / GET DATA ########### + ##################################### + + observeEvent(input$upload, { + updateSelectInput(session, 'dataIDs', choices = NULL, selected = NULL) + values$data_melted = NULL + }) + + observeEvent(input$data_already_formatted, { + if (input$data_already_formatted == TRUE) { + updateSelectInput(session, 'dataIDs', choices = NULL, selected = NULL) + } + }) + + df_shiny <- reactive({ + if (input$data_input == 1) { + values$data <- ggplot2::mpg + } else if (input$data_input == 2) { + file_in <- input$upload + # Avoid error message while file is not uploaded yet + if (is.null(input$upload)) { + return(data.frame(x = "Select your datafile")) + } else { + #isolate({ + req(input$upload_delim) + if (input$file_type == "text") { + values$data <- read_delim(file_in$datapath, + delim = input$upload_delim, quote = "\"") + } else if (input$file_type == "Excel") { + values$data <- read_excel(file_in$datapath) + } else if (input$file_type == "SPSS") { + values$data <- read_sav(file_in$datapath) + } else if (input$file_type == "Stata") { + values$data <- read_dta(file_in$datapath) + } else if (input$file_type == "SAS") { + values$data <- read_sas(file_in$datapath) } - } else if (input$data_input == 3) { - if (input$data_paste == "") { - data <- data.frame(x = "Copy your data into the textbox, + # }) + } + } else if (input$data_input == 3) { + if (input$data_paste == "") { + values$data <- data.frame(x = "Copy your data into the textbox, select the appropriate delimiter, and press 'Submit data'") - } else { - if (input$submit_data_button == 0) { - return(data.frame(x = "Press 'submit data' button")) - } else { - isolate({ - data <- read_delim(input$data_paste, - delim = input$text_delim, - col_names = TRUE) - }) - } - } - } else if (input$data_input == 4){ - data <- dataset + } else { + values$data <- read_delim(input$data_paste, + delim = input$text_delim, + col_names = TRUE) } - return(data) - }) - -##################################### -####### CREATE GRAPH-CODE ########### -##################################### - - string_code <- reactive({ - - # Variable used for how to deal with x/y in ggplot - gg_x_y <- input$Type == "Histogram" || - input$Type == "Density" - # Variable used for how to deal with colour/fill - gg_fil <- input$Type == "Histogram" || - input$Type == "Density" || - input$Type == "Dotplot" - - # Only plot jitter when graphs allow them - if (gg_fil || input$Type == "Scatter") - jitt <- FALSE else jitt <- input$jitter - - p <- paste( - "ggplot(df, aes(", - if (gg_x_y) { - "x = input$y_var" - } else { - "x = input$x_var, y = input$y_var" - }, - if (input$group != "." && gg_fil) { - ", fill = input$group" - } else if (input$group != "." && !gg_fil) { - ", colour = input$group" - }, - ")) + ", - if (input$Type == "Histogram") - paste("geom_histogram(position = 'identity', alpha = input$alpha, ", - "binwidth = input$binwidth)", sep = ""), - if (input$Type == "Density") - paste("geom_density(position = 'identity', alpha = input$alpha, ", - "adjust = input$adj_bw)", sep = ""), - if (input$Type == "Boxplot") - "geom_boxplot(notch = input$notch)", - if (input$Type == "Violin") - "geom_violin(adjust = input$adj_bw)", - if (input$Type == "Dotplot") - paste("geom_dotplot(binaxis = 'y', binwidth = input$binwidth, ", - "stackdir = 'input$dot_dir')", sep = ""), - if (input$Type == "Dot + Error") - paste("geom_point(stat = 'summary', fun.y = 'mean') +\n ", - "geom_errorbar(stat = 'summary', fun.data = 'mean_se', ", " + } + + updateSelectInput(session, 'dataIDs', choices = names(values$data)) + + return(values$data) + }) + + observeEvent(input$melt_data_button, { + if (input$data_already_formatted == "yes") { + req(input$dataIDs) + values$data_melted = melt(values$data, id.vars=c(input$dataIDs), variable.name="Observation", value.name = "Value") + } else { + values$data_melted = values$data + updateSelectInput(session, 'dataIDs', choices = NULL, selected = NULL) + } + }) + + observeEvent(input$data_format, { + newvalue <- "Data Format" + updateTabItems(session, "tabs", newvalue) + }) + + + + ##################################### + ####### CREATE GRAPH-CODE ########### + ##################################### + + string_code <- reactive({ + + # Variable used for how to deal with x/y in ggplot + gg_x_y <- input$Type == "Histogram" || + input$Type == "Density" + # Variable used for how to deal with colour/fill + gg_fil <- input$Type == "Histogram" || + input$Type == "Density" || + input$Type == "Dotplot" + + # Only plot jitter when graphs allow them + if (gg_fil || input$Type == "Scatter") + jitt <- FALSE else jitt <- input$jitter + + p <- paste( + "ggplot(df, aes(", + if (gg_x_y) { + "x = input$y_var" + } else { + "x = input$x_var, y = input$y_var" + }, + if (input$group != "." && gg_fil) { + ", fill = input$group" + } else if (input$group != "." && !gg_fil) { + ", colour = input$group" + }, + ")) + ", + if (input$Type == "Histogram") + paste("geom_histogram(position = 'identity', alpha = input$alpha, ", + "binwidth = input$binwidth)", sep = ""), + if (input$Type == "Density") + paste("geom_density(position = 'identity', alpha = input$alpha, ", + "adjust = input$adj_bw)", sep = ""), + if (input$Type == "Boxplot") + "geom_boxplot(notch = input$notch)", + if (input$Type == "Violin") + "geom_violin(adjust = input$adj_bw)", + if (input$Type == "Dotplot") + paste("geom_dotplot(binaxis = 'y', binwidth = input$binwidth, ", + "stackdir = 'input$dot_dir')", sep = ""), + if (input$Type == "Dot + Error") + paste("geom_point(stat = 'summary', fun.y = 'mean') +\n ", + "geom_errorbar(stat = 'summary', fun.data = 'mean_se', ", " width=0, fun.args = list(mult = input$CI))", sep = ""), - if (input$Type == "Scatter") - "geom_point()", - if (input$Type == "Scatter" && input$line) - "+ geom_smooth(se = input$se, method = 'input$smooth')", - if (jitt) - paste(" + geom_jitter(size = input$size_jitter, ", - "alpha = input$opac_jitter, width = input$width_jitter, ", - "colour = 'input$col_jitter')", sep = ""), - sep = "" - ) - - # if at least one facet column/row is specified, add it - facets <- paste(input$facet_row, "~", input$facet_col) - if (facets != ". ~ .") - p <- paste(p, "+ facet_grid(", facets, ")") - - # if labels specified - if (input$label_axes) - p <- paste(p, "+ labs(x = 'input$lab_x', y = 'input$lab_y')") - - # if title specified - if (input$add_title) - p <- paste(p, "+ ggtitle('input$title')") - - # if legend specified - if (input$adj_leg == "Change legend") - p <- paste(p, "+ labs(", - if (gg_fil) "fill" else "colour", - " = 'input$leg_ttl')", - sep = "") - - # if colour legend specified - if (input$adj_col) - p <- paste(p, "+ scale_", - if (gg_fil) "fill" else "colour", - "_brewer(palette = 'input$palet')", - sep = "") - - # If a theme specified - p <- paste(p, "+", input$theme) - - # If theme features are specified - if (input$adj_fnt_sz || - input$adj_fnt || - input$rot_txt || - input$adj_leg != "Keep legend as it is" || - input$adj_grd) { - p <- paste( - p, - paste( - " + theme(\n ", - if (input$adj_fnt_sz) -"axis.title = element_text(size = input$fnt_sz_ttl),\n ", - if (input$adj_fnt_sz) -"axis.text = element_text(size = input$fnt_sz_ax),\n ", - if (input$adj_fnt) -"text = element_text(family = 'input$font'),\n ", - if (input$rot_txt) -"axis.text.x = element_text(angle = 45, hjust = 1),\n ", - if (input$adj_leg == "Remove legend") -"legend.position = 'none',\n ", - if (input$adj_leg == "Change legend") -"legend.position = 'input$pos_leg',\n ", - if (input$grd_maj) -"panel.grid.major = element_blank(),\n ", - if (input$grd_min) -"panel.grid.minor = element_blank(),\n ", -")", - sep = "" - ), + if (input$Type == "Scatter") + "geom_point()", + if (input$Type == "Scatter" && input$line) + "+ geom_smooth(se = input$se, method = 'input$smooth')", + if (jitt) + paste(" + geom_jitter(size = input$size_jitter, ", + "alpha = input$opac_jitter, width = input$width_jitter, ", + "colour = 'input$col_jitter')", sep = ""), + sep = "" + ) + + # if at least one facet column/row is specified, add it + facets <- paste(input$facet_row, "~", input$facet_col) + if (facets != ". ~ .") + p <- paste(p, "+ facet_grid(", facets, ")") + + # if labels specified + if (input$label_axes) + p <- paste(p, "+ labs(x = 'input$lab_x', y = 'input$lab_y')") + + # if title specified + if (input$add_title) + p <- paste(p, "+ ggtitle('input$title')") + + # if legend specified + if (input$adj_leg == "Change legend") + p <- paste(p, "+ labs(", + if (gg_fil) "fill" else "colour", + " = 'input$leg_ttl')", + sep = "") + + # if colour legend specified + if (input$adj_col) + p <- paste(p, "+ scale_", + if (gg_fil) "fill" else "colour", + "_brewer(palette = 'input$palet')", + sep = "") + + # If a theme specified + p <- paste(p, "+", input$theme) + + # If theme features are specified + if (input$adj_fnt_sz || + input$adj_fnt || + input$rot_txt || + input$adj_leg != "Keep legend as it is" || + input$adj_grd) { + p <- paste( + p, + paste( + " + theme(\n ", + if (input$adj_fnt_sz) + "axis.title = element_text(size = input$fnt_sz_ttl),\n ", + if (input$adj_fnt_sz) + "axis.text = element_text(size = input$fnt_sz_ax),\n ", + if (input$adj_fnt) + "text = element_text(family = 'input$font'),\n ", + if (input$rot_txt) + "axis.text.x = element_text(angle = 45, hjust = 1),\n ", + if (input$adj_leg == "Remove legend") + "legend.position = 'none',\n ", + if (input$adj_leg == "Change legend") + "legend.position = 'input$pos_leg',\n ", + if (input$grd_maj) + "panel.grid.major = element_blank(),\n ", + if (input$grd_min) + "panel.grid.minor = element_blank(),\n ", + ")", sep = "" - ) - } - - # Replace name of variables by values - p <- str_replace_all( - p, - c("input\\$y_var" = input$y_var, - "input\\$x_var" = input$x_var, - "input\\$group" = input$group, - "input\\$notch" = as.character(input$notch), - "input\\$binwidth" = as.character(input$binwidth), - "input\\$adj_bw" = as.character(input$adj_bw), - "input\\$dot_dir" = as.character(input$dot_dir), - "input\\$alpha" = as.character(input$alpha), - "input\\$se" = as.character(input$se), - "input\\$smooth" = as.character(input$smooth), - "input\\$CI" = as.character(input$CI), - "input\\$size_jitter" = as.character(input$size_jitter), - "input\\$width_jitter" = as.character(input$width_jitter), - "input\\$opac_jitter" = as.character(input$opac_jitter), - "input\\$col_jitter" = as.character(input$col_jitter), - "input\\$lab_x" = as.character(input$lab_x), - "input\\$lab_y" = as.character(input$lab_y), - "input\\$title" = as.character(input$title), - "input\\$palet" = as.character(input$palet), - "input\\$fnt_sz_ttl" = as.character(input$fnt_sz_ttl), - "input\\$fnt_sz_ax" = as.character(input$fnt_sz_ax), - "input\\$font" = as.character(input$font), - "input\\$leg_ttl" = as.character(input$leg_ttl), - "input\\$pos_leg" = as.character(input$pos_leg)) + ), + sep = "" ) - # Creates well-formatted R-code for output - p <- str_replace_all(p, ",\n \\)", "\n \\)") - - p - }) - - -##################################### -###### GRAPHICAL/TABLE OUTPUT ####### -##################################### - - output$out_table <- renderDataTable( - df_shiny() + } + + # Replace name of variables by values + p <- str_replace_all( + p, + c("input\\$y_var" = input$y_var, + "input\\$x_var" = input$x_var, + "input\\$group" = input$group, + "input\\$notch" = as.character(input$notch), + "input\\$binwidth" = as.character(input$binwidth), + "input\\$adj_bw" = as.character(input$adj_bw), + "input\\$dot_dir" = as.character(input$dot_dir), + "input\\$alpha" = as.character(input$alpha), + "input\\$se" = as.character(input$se), + "input\\$smooth" = as.character(input$smooth), + "input\\$CI" = as.character(input$CI), + "input\\$size_jitter" = as.character(input$size_jitter), + "input\\$width_jitter" = as.character(input$width_jitter), + "input\\$opac_jitter" = as.character(input$opac_jitter), + "input\\$col_jitter" = as.character(input$col_jitter), + "input\\$lab_x" = as.character(input$lab_x), + "input\\$lab_y" = as.character(input$lab_y), + "input\\$title" = as.character(input$title), + "input\\$palet" = as.character(input$palet), + "input\\$fnt_sz_ttl" = as.character(input$fnt_sz_ttl), + "input\\$fnt_sz_ax" = as.character(input$fnt_sz_ax), + "input\\$font" = as.character(input$font), + "input\\$leg_ttl" = as.character(input$leg_ttl), + "input\\$pos_leg" = as.character(input$pos_leg)) ) - - width <- reactive ({ input$fig_width }) - height <- reactive ({ input$fig_height }) - width_download <- reactive ({ input$fig_width_download }) - height_download <- reactive ({ input$fig_height_download }) - - output$out_ggplot <- renderPlot(width = width, - height = height, { - # evaluate the string RCode as code - df <- df_shiny() - p <- eval(parse(text = string_code())) - p - }) - - output$out_plotly <- renderPlotly({ - # evaluate the string RCode as code - df <- df_shiny() + # Creates well-formatted R-code for output + p <- str_replace_all(p, ",\n \\)", "\n \\)") + + p + }) + + + ##################################### + ###### GRAPHICAL/TABLE OUTPUT ####### + ##################################### + output$out_table <- renderDataTable( + df_shiny(), options = list(pageLength = 5) + ) + + output$melted_data <- renderDataTable( + values$data_melted, options = list(pageLength = 5) + ) + + + width <- reactive ({ input$fig_width }) + height <- reactive ({ input$fig_height }) + width_download <- reactive ({ input$fig_width_download }) + height_download <- reactive ({ input$fig_height_download }) + + output$out_ggplot <- renderPlot(width = width, + height = height, { + # evaluate the string RCode as code + df <- values$data_melted + p <- eval(parse(text = string_code())) + p + }) + + output$out_plotly <- renderPlotly({ + # evaluate the string RCode as code + df <- values$data_melted + p <- eval(parse(text = string_code())) + ggplotly(p) + }) + + ##################################### + #### GENERATE R-CODE FOR OUTPUT ##### + ##################################### + + output$out_r_code <- renderText({ + + gg_code <- string_code() + gg_code <- str_replace_all(gg_code, "\\+ ", "+\n ") + + paste( + "## You can use the below code to generate the graph.\n", + "## Don't forget to replace the 'df' with the name\n", + "## of your dataframe\n\n", + "# You need the following package(s):\n", + "library(\"ggplot2\")\n\n", + "# The code below will generate the graph:\n", + "graph <- ", + gg_code, + "\ngraph\n\n", + "# If you want the plot to be interactive,\n", + "# you need the following package(s):\n", + "library(\"plotly\")\n", + "ggplotly(graph)\n\n", + "# If you would like to save your graph, you can use:\n", + "ggsave('my_graph.pdf', graph, width = ", + width_download(), + ", height = ", + height_download(), + ", units = 'cm')", + sep = "" + ) + + }) + + ##################################### + #### GENERATE R-CODE FOR OUTPUT ##### + ##################################### + + output$download_plot <- downloadHandler( + filename <- function() { + paste("Figure_ggplotGUI_", Sys.time(), input$download_as, sep = "") + }, + content <- function(file) { + df <- values$data_melted p <- eval(parse(text = string_code())) - ggplotly(p) - }) - -##################################### -#### GENERATE R-CODE FOR OUTPUT ##### -##################################### - - output$out_r_code <- renderText({ - - gg_code <- string_code() - gg_code <- str_replace_all(gg_code, "\\+ ", "+\n ") - - paste( - "## You can use the below code to generate the graph.\n", - "## Don't forget to replace the 'df' with the name\n", - "## of your dataframe\n\n", - "# You need the following package(s):\n", - "library(\"ggplot2\")\n\n", - "# The code below will generate the graph:\n", - "graph <- ", - gg_code, - "\ngraph\n\n", - "# If you want the plot to be interactive,\n", - "# you need the following package(s):\n", - "library(\"plotly\")\n", - "ggplotly(graph)\n\n", - "# If you would like to save your graph, you can use:\n", - "ggsave('my_graph.pdf', graph, width = ", - width_download(), - ", height = ", - height_download(), - ", units = 'cm')", - sep = "" - ) - - }) - -##################################### -#### GENERATE R-CODE FOR OUTPUT ##### -##################################### - - output$download_plot_PDF <- downloadHandler( - filename <- function() { - paste("Figure_ggplotGUI_", Sys.time(), ".pdf", sep = "") - }, - content <- function(file) { - df <- df_shiny() - p <- eval(parse(text = string_code())) - ggsave(file, p, width = width_download(), - height = height_download(), units = "cm") - }, - contentType = "application/pdf" # MIME type of the image + ggsave(file, p, width = width_download(), + height = height_download(), units = "cm", dpi = 300) + }, + contentType = "image" # MIME type of the image ) - - # End R-session when browser closed - session$onSessionEnded(stopApp) - } - shinyApp(ui, server) + + + + # End R-session when browser closed + session$onSessionEnded(stopApp) } +shinyApp(ui, server) +#}