Skip to content

Commit 4e4d6a2

Browse files
ebeyebey
committed
Merge branch 'production'
Conflicts: ui.R
2 parents 358845a + 1a02814 commit 4e4d6a2

4 files changed

Lines changed: 68 additions & 72 deletions

File tree

‎server.R‎

Lines changed: 50 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
#' ---
55
#' statnetWeb
66
#' ===========
7-
#' server.R
7+
#' server.R, v0.3.1
88
#' ===========
99

1010
#' **Before reading this document:** The Shiny app "statnetWeb" is not contained in a
@@ -85,28 +85,6 @@ options(digits=3)
8585
shinyServer(
8686
function(input, output, session){
8787

88-
89-
#' To keep a list of all attributes uploaded by the user:
90-
#' can't use global variables because they are common to all
91-
#' sessions using the app and will get overwritten, instead
92-
#' created per session variables inside shinyServer
93-
#'
94-
#'
95-
#+ eval=FALSE
96-
assign('v_attrNamesToAdd', list(1),
97-
pos="package:base")
98-
assign('v_attrValsToAdd', list(),
99-
pos="package:base")
100-
assign('e_attrNamesToAdd', list(1),
101-
pos="package:base" )
102-
assign('e_attrValsToAdd', list(),
103-
pos="package:base")
104-
assign('ev_attrNamesToAdd', list(1),
105-
pos="package:base" )
106-
assign('ev_attrValsToAdd', list(),
107-
pos="package:base")
108-
assign('input_termslist', list(),
109-
pos="package:base")
11088

11189
#' Reactive Expressions
11290
#' ---------------------------------
@@ -124,6 +102,16 @@ assign('input_termslist', list(),
124102

125103
values <- reactiveValues()
126104

105+
106+
# To keep a list of all attributes uploaded by the user:
107+
values$v_attrNamesToAdd <- list(1)
108+
values$v_attrValsToAdd <- list()
109+
values$e_attrNamesToAdd <- list(1)
110+
values$e_attrValsToAdd <- list()
111+
values$ev_attrNamesToAdd <- list(1)
112+
values$ev_attrValsToAdd <- list()
113+
values$input_termslist <- list()
114+
127115
#move to Data panel when user clicks Get Started button
128116
observe({
129117
if(input$startButton == 0) {return()}
@@ -213,7 +201,9 @@ nwinit <- reactive({
213201
})
214202

215203
}
216-
try({nw_var <- network(read.table(paste(filepath)),
204+
try({
205+
newmx <- load(paste(filepath))
206+
nw_var <- network(get(newmx),
217207
directed=input$dir, loops=input$loops,
218208
multiple=input$multiple, bipartite=input$bipartite,
219209
matrix.type=input$matrixtype,
@@ -302,15 +292,12 @@ observe({
302292
edf <- rbind(edf,i)
303293
evdf <- rbind(evdf,i)
304294
}
305-
assign("v_attrValsToAdd", vdf, pos="package:base")
306-
assign("e_attrValsToAdd", edf, pos="package:base")
307-
assign("ev_attrValsToAdd", evdf, pos="package:base")
308-
assign('v_attrNamesToAdd', list(1),
309-
pos="package:base" )
310-
assign('e_attrNamesToAdd', list(1),
311-
pos="package:base" )
312-
assign('ev_attrNamesToAdd', list(1),
313-
pos="package:base" )
295+
values$v_attrValsToAdd <- vdf
296+
values$e_attrValsToAdd <- edf
297+
values$ev_attrValsToAdd <- evdf
298+
values$v_attrNamesToAdd <- list(1)
299+
values$e_attrNamesToAdd <- list(1)
300+
values$ev_attrNamesToAdd <- list(1)
314301

315302
values$vertexnames <- network.vertex.names(nwinit())
316303
}
@@ -380,17 +367,15 @@ observe({
380367
newname <- names(newattrs)
381368
}
382369

383-
namesofar <- get("v_attrNamesToAdd", pos="package:base")
384-
valsofar <- get("v_attrValsToAdd", pos="package:base")
370+
namesofar <- values$v_attrNamesToAdd
371+
valsofar <- values$v_attrValsToAdd
385372
for(k in 1:length(newname)){
386373
namesofar <- cbind(namesofar, newname[[k]])
387374
valsofar <- cbind(valsofar, newattrs[[k]])
388375
}
389376

390-
assign('v_attrNamesToAdd', namesofar,
391-
pos="package:base")
392-
assign('v_attrValsToAdd', valsofar,
393-
pos="package:base")
377+
values$v_attrNamesToAdd <- namesofar
378+
values$v_attrValsToAdd <- valsofar
394379
}
395380
})
396381
})
@@ -412,16 +397,14 @@ observe({
412397
newname <- names(newattrs)
413398
}
414399

415-
namesofar <- get("e_attrNamesToAdd", pos="package:base")
416-
valsofar <- get("e_attrValsToAdd", pos="package:base")
400+
namesofar <- values$e_attrNamesToAdd
401+
valsofar <- values$e_attrValsToAdd
417402
for(k in 1:length(newname)){
418403
namesofar <- cbind(namesofar, newname[[k]])
419404
valsofar <- cbind(valsofar, newattrs[[k]])
420405
}
421-
assign('e_attrNamesToAdd', namesofar,
422-
pos="package:base")
423-
assign('e_attrValsToAdd', valsofar,
424-
pos="package:base")
406+
values$e_attrNamesToAdd <- namesofar
407+
values$e_attrValsToAdd <- valsofar
425408
}
426409
})
427410
})
@@ -442,17 +425,15 @@ observe({
442425
newattrs <- get(objname)
443426
newname <- names(newattrs)
444427
}
445-
namesofar <- get("ev_attrNamesToAdd", pos="package:base")
446-
valsofar <- get("ev_attrValsToAdd", pos="package:base")
428+
namesofar <- values$ev_attrNamesToAdd
429+
valsofar <- values$ev_attrValsToAdd
447430
j <- length(valsofar)
448431
for(k in 1:length(newname)){
449432
namesofar <- cbind(namesofar, newname[[k]])
450433
valsofar[[j+k]] <- newattrs[[k]]
451434
}
452-
assign('ev_attrNamesToAdd', namesofar,
453-
pos="package:base")
454-
assign('ev_attrValsToAdd', valsofar,
455-
pos="package:base")
435+
values$ev_attrNamesToAdd <- namesofar
436+
values$ev_attrValsToAdd <- valsofar
456437
}
457438
})
458439
})
@@ -484,12 +465,12 @@ nwmid <- reactive({
484465
}
485466
}
486467

487-
v_attrNamesToAdd <- get('v_attrNamesToAdd',pos='package:base')
488-
v_attrValsToAdd <- get('v_attrValsToAdd', pos='package:base')
489-
e_attrNamesToAdd <- get('e_attrNamesToAdd',pos='package:base')
490-
e_attrValsToAdd <- get('e_attrValsToAdd', pos='package:base')
491-
ev_attrNamesToAdd <- get('ev_attrNamesToAdd',pos='package:base')
492-
ev_attrValsToAdd <- get('ev_attrValsToAdd', pos='package:base')
468+
v_attrNamesToAdd <- values$v_attrNamesToAdd
469+
v_attrValsToAdd <- values$v_attrValsToAdd
470+
e_attrNamesToAdd <- values$e_attrNamesToAdd
471+
e_attrValsToAdd <- values$e_attrValsToAdd
472+
ev_attrNamesToAdd <- values$ev_attrNamesToAdd
473+
ev_attrValsToAdd <- values$ev_attrValsToAdd
493474

494475

495476
if(input$newattrButton > 0){
@@ -532,7 +513,7 @@ nw <- reactive({
532513

533514
#deleting attributes is no longer available
534515

535-
assign('input_termslist', list(), pos='package:base')
516+
values$input_termslist <- list()
536517
updateTextInput(session, inputId='terms', value='edges')
537518

538519
nw_var
@@ -681,21 +662,22 @@ legendfill <- reactive({
681662
#+ eval=FALSE
682663

683664
#add terms to list as user enters them
665+
#function in alert.js will click the addtermButton when user
666+
#presses Enter from within the terms textbox
684667
observe({
685668
if(input$addtermButton==0) {return()}
686669
isolate({
687-
valsofar <- get('input_termslist',pos='package:base')
670+
valsofar <- values$input_termslist
688671
newval <- input$terms
689-
assign('input_termslist', rbind(valsofar, newval),
690-
pos='package:base')
672+
values$input_termslist <- rbind(valsofar, newval)
691673
updateTextInput(session, inputId='terms', value='')
692674
})
693675
})
694676

695677
observe({
696678
if(input$resetformulaButton==0) {return()}
697679
isolate({
698-
assign('input_termslist', list(), pos='package:base')
680+
values$input_termslist <- list()
699681
updateTextInput(session, inputId='terms', value='')
700682
})
701683
})
@@ -704,7 +686,7 @@ ergm.terms <- reactive({
704686
nw()
705687
input$resetformulaButton
706688
input$addtermButton
707-
interms <- get('input_termslist', pos='package:base')
689+
interms <- values$input_termslist
708690
if(length(interms)==0) {return('NA')}
709691
paste(interms, collapse = '+')
710692
})
@@ -1249,9 +1231,13 @@ bernoullisamples <- reactive({
12491231
#DEGREE DISTRIBUTION
12501232

12511233
output$dynamiccolor_dd <- renderUI({
1234+
menu <- menuattr()
1235+
if(input$cmode == "freeman" & is.directed(nw())){
1236+
menu <- c()
1237+
}
12521238
selectInput('colorby_dd',
12531239
label = 'Color bars according to:',
1254-
c('None', menuattr()),
1240+
c('None', menu),
12551241
selected = 'None',
12561242
selectize = FALSE)
12571243
})

‎ui.R‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
#' ---
55
#' statnetWeb
66
#' ============
7-
#' ui.R
7+
#' ui.R, v0.3.1
88
#' ============
99

1010
#' **Before reading this document:** The Shiny app "statnetWeb" is not contained in a
@@ -62,9 +62,7 @@ library(shinyAce)
6262
#'
6363
#+ eval=FALSE
6464
shinyUI(
65-
navbarPage(title=div(a(span('statnetWeb ', style='font-family:Courier'),
66-
href = 'https://github.com/statnet/statnetWeb',
67-
target = '_blank')),
65+
navbarPage(title=NULL,
6866
id= 'navbar', windowTitle = 'statnetWeb', collapsable=TRUE,
6967

7068
#' Within each panel of the navbar, the content can be arranged by nesting rows and
@@ -80,10 +78,11 @@ shinyUI(
8078
#' This page might move to the last tab to be combined with the Help Page.
8179
#'
8280
#+ eval=FALSE
83-
tabPanel(title='About v0.3.0', value='tab1',
81+
tabPanel(title=span('statnetWeb', id="sWtitle"),
82+
value='tab1',
8483
fluidRow(
8584
column(8,
86-
br(),
85+
h5("About statnetWeb v0.3.1"),
8786
p("Welcome to our prototype web interactive interface for the", strong("ergm"),
8887
"package.", strong("ergm"), "is part of the statnet network analysis software --",
8988
"a suite of packages written in R -- and this app also includes some of the functionality",
@@ -638,15 +637,15 @@ url = {http://statnetproject.org}
638637
br(),
639638
downloadButton('nwplotdownload', label = "Download Plot")),
640639
conditionalPanel(condition='input.plottabs == "Degree Distribution"',
641-
uiOutput('dynamiccolor_dd'),
642-
span(bsAlert(inputId = 'colorwarning_dd'), style='font-size: 0.82em;'),
643640
selectInput('cmode',
644641
label = 'Type of degree (for directed graphs):',
645642
choices= c('total' = 'freeman',
646643
'indegree',
647644
'outdegree'),
648645
selected = 'freeman',
649646
selectize=FALSE),
647+
uiOutput('dynamiccolor_dd'),
648+
span(bsAlert(inputId = 'colorwarning_dd'), style='font-size: 0.82em;'),
650649
bsButtonGroup(inputId='densplotgroup',
651650
label='Y-axis units:',
652651
toggle='radio', value='count',

‎www/alert.js‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -104,6 +104,12 @@ $(document).ready(function(){
104104

105105
});
106106

107+
$("#terms").keyup(function(event){
108+
if(event.which == 13){
109+
$("#addtermButton").click();
110+
}
111+
});
112+
107113
$("#mcmchelper").click(function(){
108114
$("#mcmchelpbox").toggle(500);
109115
});

‎www/style.css‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,9 @@
11

2+
#sWtitle {
3+
font-family:Courier;
4+
font-size:14pt;
5+
}
6+
27
div.tool {
38
display:inline;
49
}

0 commit comments

Comments
 (0)