Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
jlopez
sagJL
Commits
fb6ccf5f
Commit
fb6ccf5f
authored
Oct 15, 2018
by
jlopez
Browse files
update
parent
9ca86923
Changes
9
Hide whitespace changes
Inline
Side-by-side
app/pipeline/R/menugauche.R
View file @
fb6ccf5f
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
)
)
...
...
app/pipeline/app.R
View file @
fb6ccf5f
...
...
@@ -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
)
}
...
...
app/pipeline/pages/pages_def_input2.R
0 → 100644
View file @
fb6ccf5f
tabinput2
=
fluidPage
(
)
app/pipeline/pages/pages_def_inputs.R
0 → 100644
View file @
fb6ccf5f
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"
)
)
app/pipeline/server/opt_input2.R
0 → 100644
View file @
fb6ccf5f
app/pipeline/server/opt_inputs.R
0 → 100644
View file @
fb6ccf5f
#' Event when use runP button
observeEvent
(
input
$
runP
,
{
})
app/pipelineR.yml
View file @
fb6ccf5f
...
...
@@ -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
:
[]
main.R
View file @
fb6ccf5f
...
...
@@ -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
()
tools.R
View file @
fb6ccf5f
...
...
@@ -5,3 +5,6 @@
base
::
`+`
(
e1
,
e2
)
}
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment