Skip to content

Commit

Permalink
use functions to avoid repeating codes
Browse files Browse the repository at this point in the history
  • Loading branch information
@pzhaonet
pzhaonet committed Jan 31, 2019
1 parent 1ec6a59 commit df08cbc
Showing 1 changed file with 92 additions and 156 deletions.
248 changes: 92 additions & 156 deletions R/shiny.R
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
#' A shiny app for creating a rosr project
#'
#' @return a shinyapp which can be displayed in a web browser.
#' @import shiny
#' @export
#' @examples
#' \dontrun{
Expand All @@ -19,38 +20,38 @@ rosr_ui <- function(){
fluidPage(
wellPanel(
fluidRow(
column(2, checkboxGroupInput('demo', 'Demo',
column(2, checkboxGroupInput('demo', 'demo',
choices = sub_projects()[1:8],
selected = sub_projects()[1:8]),
actionLink("demo_all","Select All")),
column(2, checkboxGroupInput('manuscript', 'Manuscript Templates',
column(2, checkboxGroupInput('manuscript', 'manuscript',
choices = templates()$templates[templates()$sub_project == 'manuscript'],
selected = 'copernicus_article'),
actionLink("manuscript_all","Select All")),
column(2, checkboxGroupInput('poster', 'Poster Templates',
column(2, checkboxGroupInput('poster', 'poster',
choices = templates()$templates[templates()$sub_project == 'poster'],
selected = 'drposter'),
actionLink("poster_all","Select All")),
column(2, checkboxGroupInput('slide', 'Slides Templates',
column(2, checkboxGroupInput('slide', 'slide',
choices = templates()$templates[templates()$sub_project == 'slide'],
selected = 'xaringan'),
actionLink("slide_all","Select All")),
column(2, checkboxGroupInput('book', 'Book Templates',
column(2, checkboxGroupInput('book', 'book',
choices = templates()$templates[templates()$sub_project == 'book'],
selected = 'demo'),
actionLink("book_all","Select All")),
column(2, checkboxGroupInput('website', 'Website Templates',
column(2, checkboxGroupInput('website', 'website',
choices = templates()$templates[templates()$sub_project == 'website'],
selected = 'yihui/hugo-lithium'),
actionLink("website_all","Select All"),
br(),
br(),
textInput('text-website', label = 'Or another template:', value = ''))
textInput('text_website', label = 'Or another template:', value = '', placeholder = 'chipsenkbeil/grid-side'))
),
fluidRow(
column(12, align="right",
actionButton('select_all', 'Select all'),
actionButton('select_suggested', 'Select suggested')
actionButton('select_all', 'Select all'),
actionButton('select_suggested', 'Select suggested')
)
)
)
Expand Down Expand Up @@ -80,181 +81,116 @@ rosr_ui <- function(){
rosr_server <- function(input, output, session) {
template_df <- templates()
install_packages()
sub_project <- sub_projects()[9:13]
sub_project_label <- sub_project
template_selected <- c('copernicus_article', 'drposter', 'xaringan', 'demo', 'yihui/hugo-lithium')

observeEvent(input$create, {
# Create a Progress object
progress <- shiny::Progress$new()
# Make sure it closes when we exit this reactive, even if there's an error
on.exit(progress$close())
progress$set(message = "Creating...", detail = 'demo...', value = 0)
pr <- sum(sapply(c('demo', sub_project), function(x) length(input[[x]])))

# create demos
create_rosr(project = input$proj, dest_dir = input$path,
if_render = input$if_render == 'Yep',
sub_project = input$demo, overwrite = TRUE)
if(length(input$manuscript != 0))
for(i in input$manuscript)
create_rmd(to = file.path(input$path, 'manuscript'),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')
if(length(input$poster != 0))
for(i in input$poster)
create_rmd(to = file.path(input$path, 'poster'),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')
if(length(input$slide != 0))
for(i in input$slide)
create_rmd(to = file.path(input$path, 'slide'),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')

# create manuscript, slide, poster
for (j in 2:4){
if(length(input[[sub_project[j - 1]]] != 0))
for(i in input[[sub_project[j - 1]]]){
progress$inc(1/pr, detail = paste0(sub_project[j - 1], ' ', i, '...'))
create_rmd(to = file.path(input$path, sub_project[j - 1]),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')
}
}

# create book
if(length(input$book != 0))
for(i in input$book)
for(i in input$book) {
progress$inc(1/pr, detail = paste0('book ', i, '...'))
create_book(to = file.path(input$path, 'book'),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')
}

# create website
if(length(input$website != 0))
for(i in input$website)
for(i in input$website){
progress$inc(1/pr, detail = paste0('website ', i, '...'))
create_website(to = file.path(input$path, 'website'),
theme = i)
if(input$text-website != '')
}
if(input$text_website != ''){
progress$inc(1/pr, detail = paste0('website ', input$text_website, '...'))
create_website(to = file.path(input$path, 'website'),
theme = input$text-website,
if_render = input$if_render == 'Yep')
}
)

observe({
if(input$demo_all == 0) return(NULL)
else if (input$demo_all%%2 == 0) {
updateCheckboxGroupInput(session,'demo', 'Demo', choices = sub_projects()[1:8], selected = sub_projects()[1:8])
} else {
updateCheckboxGroupInput(session,'demo', 'Demo', choices = sub_projects()[1:8])
}
})

observe({
if(input$manuscript_all == 0) return(NULL)
else if (input$manuscript_all%%2 == 0) {
updateCheckboxGroupInput(session,'manuscript', 'Manuscript Templates',
choices = templates()$templates[templates()$sub_project == 'manuscript'],
selected = templates()$templates[templates()$sub_project == 'manuscript'])
} else {
updateCheckboxGroupInput(session, 'manuscript', 'Manuscript Templates',
choices = templates()$templates[templates()$sub_project == 'manuscript'])
theme = input$text_website)
}
})

observe({
if(input$slide_all == 0) return(NULL)
else if (input$slide_all%%2 == 0) {
updateCheckboxGroupInput(session,'slide', 'Slide Templates',
choices = templates()$templates[templates()$sub_project == 'slide'],
selected = templates()$templates[templates()$sub_project == 'slide'])
} else {
updateCheckboxGroupInput(session, 'slide', 'Slide Templates',
choices = templates()$templates[templates()$sub_project == 'slide'])
}
})
progress$inc(1/pr, detail = 'Done!')
}
)

observe({
if(input$poster_all == 0) return(NULL)
else if (input$poster_all%%2 == 0) {
updateCheckboxGroupInput(session,'poster', 'Poster Templates',
choices = templates()$templates[templates()$sub_project == 'poster'],
selected = templates()$templates[templates()$sub_project == 'poster'])
# function as a shor version of updateCheckboxGroupInput()
select_all <- function(sub_project = 'manuscript', all = FALSE){
sub_project_lab <- sub_project
if(sub_project == 'demo'){
mychoices <- sub_projects()[1:8]
} else {
updateCheckboxGroupInput(session, 'poster', 'poster Templates',
choices = templates()$templates[templates()$sub_project == 'poster'])
mychoices <- template_of_sub_project(sub_project = sub_project)
}
})

observe({
if(input$book_all == 0) return(NULL)
else if (input$book_all%%2 == 0) {
updateCheckboxGroupInput(session,'book', 'Book Templates',
choices = templates()$templates[templates()$sub_project == 'book'],
selected = templates()$templates[templates()$sub_project == 'book'])
} else {
updateCheckboxGroupInput(session, 'book', 'Book Templates',
choices = templates()$templates[templates()$sub_project == 'book'])
if(all) {
myselected <- mychoices
} else{
myselected <- NULL
}
})
return(
updateCheckboxGroupInput(session, sub_project, sub_project_lab,
choices = mychoices,
selected = myselected)
)
}

observe({
if(input$website_all == 0) return(NULL)
else if (input$website_all%%2 == 0) {
updateCheckboxGroupInput(session,'website', 'Website Templates',
choices = templates()$templates[templates()$sub_project == 'website'],
selected = templates()$templates[templates()$sub_project == 'website'])
} else {
updateCheckboxGroupInput(session, 'website', 'Website Templates',
choices = templates()$templates[templates()$sub_project == 'website'])
}
})
# function controlling the update rule of the check boxes
observe_select_all <- function(sub_project = 'manuscript'){
input_id <- paste0(sub_project, '_all')
if(input[[input_id]] == 0) return(NULL)
if(input[[input_id]]%%2 == 0) return(select_all(sub_project = sub_project, all = TRUE))
return(select_all(sub_project = sub_project, all = FALSE))
}

# update the check boxex
observe({observe_select_all(sub_project = 'demo')})
observe({observe_select_all(sub_project = 'manuscript')})
observe({observe_select_all(sub_project = 'slide')})
observe({observe_select_all(sub_project = 'poster')})
observe({observe_select_all(sub_project = 'book')})
observe({observe_select_all(sub_project = 'website')})
observe({
if(input$select_all == 0) return(NULL)
else if (input$select_all%%2 == 0) {
updateCheckboxGroupInput(session,'demo', 'Demo', choices = sub_projects()[1:8])
updateCheckboxGroupInput(session,'manuscript', 'Manuscript Templates',
choices = templates()$templates[templates()$sub_project == 'manuscript'])
updateCheckboxGroupInput(session,'slide', 'Slide Templates',
choices = templates()$templates[templates()$sub_project == 'slide'])
updateCheckboxGroupInput(session,'poster', 'Poster Templates',
choices = templates()$templates[templates()$sub_project == 'poster'])
updateCheckboxGroupInput(session,'book', 'Book Templates',
choices = templates()$templates[templates()$sub_project == 'book'])
updateCheckboxGroupInput(session, 'website', 'Website Templates',
choices = templates()$templates[templates()$sub_project == 'website'])
lapply(c('demo', sub_project), function(x) select_all(x, all = FALSE))
} else {
updateCheckboxGroupInput(session,'demo', 'Demo', choices = sub_projects()[1:8], selected = sub_projects()[1:8])
updateCheckboxGroupInput(session,'manuscript', 'Manuscript Templates',
choices = templates()$templates[templates()$sub_project == 'manuscript'],
selected = templates()$templates[templates()$sub_project == 'manuscript'])
updateCheckboxGroupInput(session,'slide', 'Slide Templates',
choices = templates()$templates[templates()$sub_project == 'slide'],
selected = templates()$templates[templates()$sub_project == 'slide'])
updateCheckboxGroupInput(session,'poster', 'Poster Templates',
choices = templates()$templates[templates()$sub_project == 'poster'],
selected = templates()$templates[templates()$sub_project == 'poster'])
updateCheckboxGroupInput(session,'book', 'Book Templates',
choices = templates()$templates[templates()$sub_project == 'book'],
selected = templates()$templates[templates()$sub_project == 'book'])
updateCheckboxGroupInput(session,'website', 'Website Templates',
choices = templates()$templates[templates()$sub_project == 'website'],
selected = templates()$templates[templates()$sub_project == 'website'])
lapply(c('demo', sub_project), function(x) select_all(x, all = TRUE))
}
})

observe({
if(input$select_suggested == 0) return(NULL)
else if (input$select_suggested%%2 == 0) {
updateCheckboxGroupInput(session,'demo', 'Demo', choices = sub_projects()[1:8])
updateCheckboxGroupInput(session,'manuscript', 'Manuscript Templates',
choices = templates()$templates[templates()$sub_project == 'manuscript'])
updateCheckboxGroupInput(session,'slide', 'Slide Templates',
choices = templates()$templates[templates()$sub_project == 'slide'])
updateCheckboxGroupInput(session,'poster', 'Poster Templates',
choices = templates()$templates[templates()$sub_project == 'poster'])
updateCheckboxGroupInput(session,'book', 'Book Templates',
choices = templates()$templates[templates()$sub_project == 'book'])
updateCheckboxGroupInput(session, 'website', 'Website Templates',
choices = templates()$templates[templates()$sub_project == 'website'])
} else {
updateCheckboxGroupInput(session,'demo', 'Demo',
choices = sub_projects()[1:8],
selected = sub_projects()[1:8])
updateCheckboxGroupInput(session,'manuscript', 'Manuscript Templates',
choices = templates()$templates[templates()$sub_project == 'manuscript'],
selected = 'copernicus_article')
updateCheckboxGroupInput(session,'poster', 'Poster Templates',
choices = templates()$templates[templates()$sub_project == 'poster'],
selected = 'drposter')
updateCheckboxGroupInput(session,'slide', 'Slides Templates',
choices = templates()$templates[templates()$sub_project == 'slide'],
selected = 'xaringan')
updateCheckboxGroupInput(session,'book', 'Book Templates',
choices = templates()$templates[templates()$sub_project == 'book'],
selected = 'demo')
updateCheckboxGroupInput(session,'website', 'Website Templates',
choices = templates()$templates[templates()$sub_project == 'website'],
selected = 'yihui/hugo-lithium')
}
select_all('demo', all = TRUE)
for(k in 1:5)
updateCheckboxGroupInput(session, sub_project[k], sub_project_label[k],
choices = template_of_sub_project(sub_project = sub_project[k]),
selected = template_selected[k])
# }
})
}

template_of_sub_project <- function(sub_project){
templates()$templates[templates()$sub_project == sub_project]
}

0 comments on commit df08cbc

Please sign in to comment.