Commit fb6ccf5f authored by jlopez's avatar jlopez
Browse files

update

parent 9ca86923
MenuGauche = sidebarMenu(id="sidebarmenu",
menuItem("Home", tabName="Home", icon=icon("home", lib="font-awesome"), newtab=FALSE),
menuItem("Input Pipeline", tabName="inputs", icon=icon("pencil", lib="font-awesome"), newtab=FALSE),
menuItem("Input Pipeline 2", tabName="input2", icon=icon("", lib="font-awesome"), newtab=FALSE),
tags$br(),
menuItem("Powered by mbb", href="http://mbb.univ-montp2.fr/MBB/index.php", newtab=TRUE, icon=icon("book", lib="font-awesome"), selected=NULL)
)
......
......@@ -8,11 +8,13 @@ library(stringr)
library(shinyFiles)
library(tools)
source("./pages/pages_def_inputs.R", local=T)
source("./pages/pages_def_input2.R", local=T)
source("./R/menugauche.R", local=T)
style <- tags$style(HTML(readLines("www/added_styles.css")))
UI <- dashboardPage(
skin="purple",
skin="green",
dashboardHeader(title="Pipeline in R", titleWidth=230),
dashboardSidebar(width=230, MenuGauche),
dashboardBody(
......@@ -20,11 +22,15 @@ UI <- dashboardPage(
tags$head(tags$link(rel="stylesheet", type="text/css", href="bootstrap.min.readable.css")),
tags$head(style),
tabItems(
tabItem(tabName = "inputs", tabinputs),
tabItem(tabName = "input2", tabinput2)
)
)
)
server <- function( input, output, session) {
source("./server/opt_inputs.R", local=T)
source("./server/opt_input2.R", local=T)
}
......
tabinputs = fluidPage(
textInput("textInput1", label = "Text input 1 :", value = "", width = "50%"),
textInput("textInput2", label = "Text input 2 :", value = "", width = "300px"),
sliderInput("sliderInput1", label = "Slider input 1 :", min = 0, max = 100, step = 1, width = "50%", value = 50),
sliderInput("sliderInput1", label = "Slider input 2 :", min = 10, max = 20, step = 0.1, width = "50%", value = c(11.8,19.6)),
selectInput("selectInput1",label = "Select input 1 :", choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = "dqsdqsd"), selected = "2", width = "30%"),
radioButtons("radioButtons1",label = "Radio buttons 1 :", choices = list("Choice A" = "A", "Choice B" = "B", "Choice C" = "C"), selected = "C", width = "50%"),
checkboxInput("checkboxInput1", label = "Single Checkbox input 1 :", value = TRUE),
p("Just simple text for description or help"),
checkboxGroupInput("checkboxGroupInput1",label = "Group checkbox input 1 :", choices = list("Choice A" = "A", "Choice B" = "B", "Choice C" = "C"), selected = "C", width = "50%"),
actionButton("runP", "Run", icon("save"), class="btn btn-primary")
)
#' Event when use runP button
observeEvent(input$runP, {
})
......@@ -2,5 +2,127 @@ App:
project: "/home/jimmy/jimmy/projets/sag/app/pipeline"
general:
title: "Pipeline in R"
skin: "purple"
skin: "green"
menu_width: 230
pages:
-
icon: "pencil"
menu: "Input Pipeline"
name: "inputs"
content:
-
id: "textInput1"
type: "textInput"
width: "50%"
label: "Text input 1 :"
value: ""
-
id: "textInput2"
type: "textInput"
width: "300px"
label: "Text input 2 :"
value: ""
-
id: "sliderInput1"
type: "sliderInput"
min: 0
max: 100
value: [50]
step: 1
width: "50%"
label: "Slider input 1 :"
-
id: "sliderInput1"
type: "sliderInput"
min: 10
max: 20
step: 0.1
value: [11.8, 19.6]
width: "50%"
label: "Slider input 2 :"
-
type: "selectInput"
id: "selectInput1"
label: "Select input 1 :"
width: "30%"
selected: 2
choices:
-
label: "Choice 1"
value: 1
-
label: "Choice 2"
value: 2
-
label: "Choice 3"
value: "dqsdqsd"
-
type: "radioButtons"
id: "radioButtons1"
label: "Radio buttons 1 :"
width: "50%"
selected: "C"
choices:
-
label: "Choice A"
value: "A"
-
label: "Choice B"
value: "B"
-
label: "Choice C"
value: "C"
-
type: "checkboxInput"
id: "checkboxInput1"
label: "Single Checkbox input 1 :"
width: "50%"
value: TRUE
-
type: "p"
value: "Just simple text for description or help"
-
type: "checkboxGroupInput"
id: "checkboxGroupInput1"
label: "Group checkbox input 1 :"
width: "50%"
selected: "C"
choices:
-
label: "Choice A"
value: "A"
-
label: "Choice B"
value: "B"
-
label: "Choice C"
value: "C"
-
class: "btn btn-primary"
icon: "save"
id: "runP"
label: "Run"
type: "actionButton"
-
name: "input2"
con: "file"
menu: "Input Pipeline 2"
content: []
......@@ -14,6 +14,177 @@ generate_added_styles <- function () {
#============================================================
generate_pages_server <- function() {
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
path_page = APP$project+"/pages/pages_def_"+tolower(name)+".R"
file.create(path_page)
res <- 'tab'+ name + ' = fluidPage(\n'
content <- APP$pages[[x]]$content
if(length(content) > 0) {
for(y in 1:length(content)) {
cnt <- content[[y]]
if(cnt$type == "actionButton") {
if(cnt$icon == "") {
res <- res + '\tactionButton("' + cnt$id + '", "'+ cnt$label +'", class="'+ cnt$class +'")'
} else {
res <- res + '\tactionButton("' + cnt$id + '", "'+ cnt$label +'", icon("'+ cnt$icon +'"), class="'+ cnt$class +'")'
}
} else if(cnt$type == "textInput") {
res <- res + '\ttextInput("'+ cnt$id +'", label = "'+ cnt$label +'", value = "'+ cnt$value +'", width = "'+ cnt$width +'")'
} else if(cnt$type == "sliderInput") {
if(length(cnt$value) == 1) {
res <- res + '\tsliderInput("'+ cnt$id +'", label = "'+ cnt$label +'", min = '+ cnt$min +', max = '+ cnt$max +', step = '+ cnt$step +', width = "'+ cnt$width +'", value = '+ cnt$value +')'
} else {
res <- res + '\tsliderInput("'+ cnt$id +'", label = "'+ cnt$label +'", min = '+ cnt$min +', max = '+ cnt$max +', step = '+ cnt$step +', width = "'+ cnt$width +'", value = c('+ cnt$value[1] + ',' + cnt$value[2] + '))'
}
} else if(cnt$type == "p") {
res <- res + '\tp("'+cnt$value+'")'
} else if(cnt$type == "selectInput") {
res <- res + '\tselectInput("'+ cnt$id +'",label = "'+ cnt$label +'", choices = list('
if(length(cnt$choices) > 0) {
for(ch in 1:length(cnt$choices)){
choices = cnt$choices[[ch]]
value = choices$value
if(is.character(choices$value)) {
value = '"' + choices$value + '"'
}
if(ch < length(cnt$choices)) {
res <- res + '"' + choices$label + '"' + ' = ' + value + ', '
} else {
res <- res + '"' + choices$label + '"' + ' = ' + value + '), '
}
}
}
res <- res + ' selected = "'+cnt$selected+'"' + ', width = "'+ cnt$width +'")'
} else if(cnt$type == "radioButtons") {
res <- res + '\tradioButtons("'+ cnt$id +'",label = "'+ cnt$label +'", choices = list('
if(length(cnt$choices) > 0) {
for(ch in 1:length(cnt$choices)){
choices = cnt$choices[[ch]]
value = choices$value
if(is.character(choices$value)) {
value = '"' + choices$value + '"'
}
if(ch < length(cnt$choices)) {
res <- res + '"' + choices$label + '"' + ' = ' + value + ', '
} else {
res <- res + '"' + choices$label + '"' + ' = ' + value + '), '
}
}
}
res <- res + ' selected = "'+cnt$selected+'"' + ', width = "'+ cnt$width +'")'
} else if(cnt$type == "checkboxInput") {
res <- res + '\tcheckboxInput("'+ cnt$id +'", label = "'+ cnt$label +'", value = ' + cnt$value + ')'
} else if(cnt$type == "checkboxGroupInput") {
res <- res + '\tcheckboxGroupInput("'+ cnt$id +'",label = "'+ cnt$label +'", choices = list('
if(length(cnt$choices) > 0) {
for(ch in 1:length(cnt$choices)){
choices = cnt$choices[[ch]]
value = choices$value
if(is.character(choices$value)) {
value = '"' + choices$value + '"'
}
if(ch < length(cnt$choices)) {
res <- res + '"' + choices$label + '"' + ' = ' + value + ', '
} else {
res <- res + '"' + choices$label + '"' + ' = ' + value + '), '
}
}
}
res <- res + ' selected = "'+cnt$selected+'"' + ', width = "'+ cnt$width +'")'
}
if(y < length(content)) {
res <- res + ",\n"
} else {
res <- res + "\n"
}
}
}
res <- res + ')\n'
write(res, file=path_page)
path_opt = APP$project+"/server/opt_"+tolower(name)+".R"
file.create(path_opt)
res <- ""
content <- APP$pages[[x]]$content
if(length(content) > 0) {
for(y in 1:length(content)) {
type <- content[[y]]$type
id <- content[[y]]$id
if(type == "actionButton") {
res <- res + '#\' Event when use '+ id +' button\n'
res <- res + 'observeEvent(input$'+id+', {'
res <- res + '\n\n'
res <- res + '})\n'
}
}
write(res, file=path_opt)
}
}
}
#============================================================
generate_menu <- function() {
path_file = APP$project + "/R/menugauche.R"
......@@ -24,7 +195,12 @@ generate_menu <- function() {
res <- res + 'MenuGauche = sidebarMenu(id="sidebarmenu",\n'
res <- res + ' menuItem("Home", tabName="Home", icon=icon("home", lib="font-awesome"), newtab=FALSE),\n'
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
icon <- APP$pages[[x]]$icon
menu <- APP$pages[[x]]$menu
res <- res + ' menuItem("'+menu+'", tabName="'+name+'", icon=icon("'+icon+'", lib="font-awesome"), newtab=FALSE),\n'
}
res <- res + ' tags$br(),\n'
......@@ -55,6 +231,8 @@ generate <- function() {
dir.create(APP$project + "/pages")
dir.create(APP$project + "/server")
generate_pages_server()
dir.create(APP$project + "/www")
generate_added_styles()
......@@ -73,50 +251,73 @@ generate_app <- function() {
res <- "#@author jimmy.lopez@univ-montp2.fr\n\n"
res <- res + "library(shiny)\n"
res <- res + "library(shinydashboard)\n"
res <- res + "library(shinyjs)\n"
res <- res + "library(yaml)\n"
res <- res + "library(stringr)\n"
res <- res + "library(shinyFiles)\n"
res <- res + "library(tools)\n"
res <- res + 'library(shiny)\n'
res <- res + 'library(shinydashboard)\n'
res <- res + 'library(shinyjs)\n'
res <- res + 'library(yaml)\n'
res <- res + 'library(stringr)\n'
res <- res + 'library(shinyFiles)\n'
res <- res + 'library(tools)\n'
res <- res + '\n'
res <- res + "\n"
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
res <- res + 'source("./pages/pages_def_'+tolower(name)+'.R", local=T)\n'
}
res <- res + "source(\"./R/menugauche.R\", local=T)\n"
res <- res + 'source("./R/menugauche.R", local=T)\n'
res <- res + "\n"
res <- res + '\n'
res <- res + "style <- tags$style(HTML(readLines(\"www/added_styles.css\")))\n"
res <- res + 'style <- tags$style(HTML(readLines("www/added_styles.css")))\n'
res <- res + "UI <- dashboardPage(\n"
res <- res + 'UI <- dashboardPage(\n'
res <- res + ' skin="' + main$skin + '",\n'
res <- res + ' dashboardHeader(title="'+ main$title + '", titleWidth=230),\n'
res <- res + " dashboardSidebar(width=230, MenuGauche),\n"
res <- res + " dashboardBody(\n"
res <- res + " shinyjs::useShinyjs(),\n"
res <- res + ' tags$head(tags$link(rel=\"stylesheet\", type=\"text/css\", href=\"bootstrap.min.readable.css\")),\n'
res <- res + ' dashboardHeader(title="'+ main$title + '", titleWidth='+main$menu_width+'),\n'
res <- res + ' dashboardSidebar(width='+main$menu_width+', MenuGauche),\n'
res <- res + ' dashboardBody(\n'
res <- res + ' shinyjs::useShinyjs(),\n'
res <- res + ' tags$head(tags$link(rel="stylesheet", type="text/css", href="bootstrap.min.readable.css")),\n'
#tags$head(tags$script(src="message-handler.js")),
res <- res + "tags$head(style),\n"
res <- res + " tabItems(\n"
res <- res + 'tags$head(style),\n'
res <- res + ' tabItems(\n'
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
res <- res + 'tabItem(tabName = "' + name + '", tab'+ name +')'
if(x < length(APP$pages)) {
res <- res + ",\n"
} else {
res <- res + "\n"
}
}
res <- res + ' )\n'
res <- res + ')\n'
res <- res + ')\n'
res <- res + " )\n"
res <- res + ")\n"
res <- res + ")\n"
res <- res + '\n'
res <- res + "\n"
res <- res + 'server <- function( input, output, session) {\n'
res <- res + "server <- function( input, output, session) {\n"
for(x in 1:length(APP$pages)) {
name <- APP$pages[[x]]$name
res <- res + 'source("./server/opt_'+tolower(name)+'.R", local=T)\n'
}
res <- res + "\n"
res <- res + '\n'
res <- res + "}\n"
res <- res + '}\n'
res <- res + "\n"
res <- res + '\n'
res <- res + "shinyApp(ui = UI, server = server)"
res <- res + 'shinyApp(ui = UI, server = server)'
write(res, path_project)
......@@ -126,3 +327,4 @@ generate_app <- function() {
generate()
......@@ -5,3 +5,6 @@
base::`+`(e1, e2)
}
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment