Skip to content

Commit 571842e

Browse files
author
Kenneth Daily
authored
Merge pull request #2 from Sage-Bionetworks/develop
merge develop
2 parents e7ebd41 + 4f0a8ed commit 571842e

File tree

5 files changed

+144
-116
lines changed

5 files changed

+144
-116
lines changed

‎inst/downloads.Rmd‎

Lines changed: 36 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -107,38 +107,50 @@ queryData <- res %>%
107107
### Web access usage statistics from `r min(monthBreaksDf$beginTime)` to `r max(monthBreaksDf$endTime)`.
108108

109109
```{r users}
110-
# Get users at project level
111-
aclUserList <- aclToUserList(paste0("syn", projectId))
112-
aclUserList$teamId <- factor(aclUserList$teamId,
113-
levels=aclTeamOrder,
114-
ordered=TRUE)
115-
116-
aclUserList <- aclUserList %>%
117-
group_by(userId) %>%
118-
arrange(teamId) %>%
119-
slice(1) %>%
120-
ungroup()
121-
122-
# # Get sage employees
123-
# sageUserList <- getTeamMemberDF(273957)
124-
# userList <- rbind(userList, sageUserList)
125-
110+
if (useTeamGrouping) {
111+
112+
# Get users at project level
113+
aclUserList <- aclToUserList(paste0("syn", projectId))
114+
aclUserList$teamId <- factor(aclUserList$teamId,
115+
levels=aclTeamOrder,
116+
ordered=TRUE)
117+
118+
aclUserList <- aclUserList %>%
119+
group_by(userId) %>%
120+
arrange(teamId) %>%
121+
slice(1) %>%
122+
ungroup()
123+
}
126124
```
127125

128126
```{r summaryuseraccess}
129127
# Get user profile info for users in data download records
130-
allUsersList <- ldply(unique(queryData$userid),
131-
function(x) {
132-
foo <- synGetUserProfile(x);
133-
data.frame(userId=as.character(x),
134-
userName=foo@userName)})
128+
accessUsers <- synRestGET(sprintf("/userGroupHeaders/batch?ids=%s",
129+
paste(unique(queryData$userId),
130+
collapse=",")))
131+
132+
allUsersList <- ldply(accessUsers$children, as.data.frame) %>%
133+
mutate(userId=ownerId) %>%
134+
select(userId, userName)
135+
136+
if (useTeamGrouping) {
137+
allUsers <- left_join(allUsersList, aclUserList)
138+
} else{
139+
allUsers <- allUsersList
140+
allUsers$teamId <- "None"
141+
}
135142
136-
allUsers <- left_join(allUsersList, aclUserList)
137143
levels(allUsers$teamId) <- c(levels(allUsers$teamId), "None")
138144
allUsers$teamId[is.na(allUsers$teamId)] <- "None"
139145
140146
allUsers$group <- "Other"
141-
teamInfo <- ddply(allUsers %>% filter(teamId != "None") %>% select(teamId) %>% unique(),
147+
allUsers$teamName <- "None"
148+
149+
teamInfo <- ddply(allUsers %>%
150+
filter(teamId != "None",
151+
!startsWith(as.character(allUsers$teamId),
152+
"syn")) %>%
153+
select(teamId) %>% unique(),
142154
.(teamId),
143155
function(x) {
144156
tmp <- synRestGET(sprintf("/team/%s", x$teamId));
@@ -227,8 +239,8 @@ useraccessCount <- queryData %>%
227239
userId=reorder(userId, n, order=TRUE))
228240
```
229241

242+
```{r plotperdayperuser, fig.width=20, fig.height=6, include=FALSE, eval=FALSE}
230243
#### Accesses per day per user
231-
```{r plotperdayperuser, fig.width=20, fig.height=6, include=TRUE, eval=TRUE}
232244
233245
if (useTeamGrouping) {
234246
plotdata <- queryData %>%

‎inst/lib.R‎

Lines changed: 21 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -18,20 +18,31 @@ getTeamMemberDF <- function(teamId) {
1818
userList
1919
}
2020

21-
aclToUserList <- function(id) {
22-
acl <- synGetEntityACL(id)
21+
aclToMemberList <- function(acl) {
22+
aclMemberList <- ldply(acl@resourceAccess@content,
23+
function(x) data.frame(principalId=as.character(x@principalId),
24+
teamId=acl@id))
2325

24-
aclUserList <- ldply(acl@resourceAccess@content,
25-
function(x) data.frame(principalId=as.character(x@principalId),
26-
teamId="syn2862345"))
26+
userGroupHeaders <- synRestGET(sprintf("/userGroupHeaders/batch?ids=%s",
27+
paste(aclMemberList$principalId,
28+
collapse=",")))
2729

30+
ldply(userGroupHeaders$children, as.data.frame)
2831

29-
userList <- ldply(aclUserList$principalId, getTeamMemberDF)
32+
}
33+
34+
aclToUserList <- function(synId) {
35+
acl <- synGetEntityACL(synId)
3036

31-
userList2 <- aclUserList %>%
32-
filter(!(principalId %in% userList$userId)) %>%
33-
dplyr::rename(userId=principalId)
37+
aclMemberList <- aclToMemberList(acl)
38+
aclMemberList$teamId <- synId
39+
40+
userList <- ldply(aclMemberList$ownerId, getTeamMemberDF)
3441

35-
rbind(userList, userList2)
42+
userList2 <- aclMemberList %>%
43+
filter(isIndividual) %>%
44+
dplyr::rename(userId=ownerId)
45+
46+
rbind(userList2[, c("userId", "teamId")], userList)
3647

3748
}

‎inst/shiny-apps/UsageStats/app.R‎

Lines changed: 37 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -19,15 +19,25 @@ synapseLogin()
1919
checkForProject <- function(projectId) {
2020
length(synQuery(sprintf('select id from project where projectId=="syn%s" LIMIT 1', projectId))) == 1
2121
}
22-
renderMyDocument <- function(reportType, projectId, nMonths, aclTeamOrder, outputFile) {
22+
renderMyDocument <- function(reportType, projectId, nMonths, aclTeamOrder, useTeamGrouping, outputFile) {
2323
res <- rmarkdown::render(input=paste0("../../", reportType, ".Rmd"),
2424
output_file=outputFile,
25-
params = list(projectId=projectId, nMonths=nMonths, aclTeamOrder=aclTeamOrder))
25+
params = list(projectId=projectId, nMonths=nMonths,
26+
aclTeamOrder=aclTeamOrder,
27+
useTeamGrouping=useTeamGrouping))
2628
}
2729

2830
# Define UI for application that draws a histogram
2931
ui <- shinyUI(fluidPage(
3032

33+
tags$head(
34+
tags$style(HTML("
35+
.shiny-output-error-validation {
36+
color: red;
37+
}
38+
"))
39+
),
40+
3141
# Application title
3242
titlePanel("Synapse Project Usage"),
3343

@@ -40,6 +50,7 @@ ui <- shinyUI(fluidPage(
4050
uiOutput('teamList'),
4151
selectInput('reportType', "Report Type:", choices=c("webAccess", "downloads"),
4252
selected="downloads"),
53+
checkboxInput('useTeamGrouping', 'Group by teams', value=FALSE),
4354
sliderInput("months", "Months", min=1, max=12, value=2, step=1),
4455
actionButton('report', "Make Report")
4556
),
@@ -58,6 +69,7 @@ ui <- shinyUI(fluidPage(
5869
p("Then, click the 'Make Report' button, A 'Download' button will appear when the report has been generated."),
5970
br(),
6071
p("A PDF of this report can be generated in most browsers by printing the HTML to a PDF file."),
72+
hr(),
6173
uiOutput("results")
6274
)
6375
)
@@ -69,13 +81,21 @@ server <- shinyServer(function(input, output) {
6981
myVals <- reactiveValues()
7082

7183
teamACL <- eventReactive(input$lookup, {
72-
acl <- aclToUserList(paste0("syn", input$projectId))
84+
validate(
85+
need(try(checkForProject(isolate(input$projectId))),
86+
"That project doesn't exist. Please try again.")
87+
)
88+
89+
acl <- synGetEntityACL(paste0("syn", input$projectId))
90+
aclToMemberList(acl) %>%
91+
filter(userName != "PUBLIC", !isIndividual)
7392
})
7493

7594
output$teamList <- renderUI({
7695
withProgress(message = 'Looking up team...', value = 0, {
7796
teamList <- teamACL()
78-
teamIds <- unique(as.character(teamList$teamId))
97+
teamIds <- c(paste0("syn", input$projectId),
98+
unique(as.character(teamList$ownerId)))
7999
})
80100
selectInput("teamOrder", "Team Order", choices=teamIds,
81101
selected=NULL, width='100%', multiple = TRUE, selectize = TRUE)
@@ -84,18 +104,26 @@ server <- shinyServer(function(input, output) {
84104
res <- eventReactive(input$report, {
85105
print("Making Report")
86106
withProgress(message = 'Making report', value = 0, {
87-
88-
validate(
107+
108+
validate(
89109
need(try(checkForProject(input$projectId)),
90110
"That project doesn't exist. Please try again.")
91-
)
92-
111+
)
112+
113+
if (input$useTeamGrouping) {
114+
validate(
115+
need(try(input$teamOrder != ""),
116+
"Please select a Team ordering before generating a report.")
117+
)
118+
}
119+
93120
myVals[['reportName']] <- 'myreport.html'
94121

95122
renderMyDocument(reportType=input$reportType,
96123
projectId = input$projectId,
97124
nMonths=input$months,
98125
aclTeamOrder = input$teamOrder,
126+
useTeamGrouping=input$useTeamGrouping,
99127
#outputFile=paste0(as.numeric(as.POSIXct(Sys.Date())), "_", reportType, ".html"),
100128
outputFile='myreport.html')
101129
})
@@ -117,7 +145,7 @@ server <- shinyServer(function(input, output) {
117145

118146
output$results <- renderUI({
119147
report <- res()
120-
downloadButton('download')
148+
list(h3("Results"), downloadButton('download'))
121149
})
122150
})
123151

‎inst/webAccess.Rmd‎

Lines changed: 50 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,10 @@ output:
33
html_document:
44
keep_md: yes
55
params:
6-
projectId: !r NA
7-
nMonths: 2
8-
useTeamGrouping: TRUE
9-
aclTeamOrder: !r NA
6+
projectId: !r c('2289125')
7+
nMonths: 5
8+
useTeamGrouping: FALSE
9+
aclTeamOrder: !r c('syn2289125')
1010
---
1111

1212
```{r include=FALSE, eval=FALSE, echo=FALSE}
@@ -108,49 +108,63 @@ queryData <- res %>%
108108
### Web access usage statistics from `r min(monthBreaksDf$beginTime)` to `r max(monthBreaksDf$endTime)`.
109109

110110
```{r users}
111-
# Get users at project level
112-
aclUserList <- aclToUserList(paste0("syn", projectId))
113-
aclUserList$teamId <- factor(aclUserList$teamId,
114-
levels=aclTeamOrder,
115-
ordered=TRUE)
116-
117-
aclUserList <- aclUserList %>%
118-
group_by(userId) %>%
119-
arrange(teamId) %>%
120-
slice(1) %>%
121-
ungroup()
122-
123-
# # Get sage employees
124-
# sageUserList <- getTeamMemberDF(273957)
125-
# userList <- rbind(userList, sageUserList)
126-
111+
if (useTeamGrouping) {
112+
# Get users at project level
113+
aclUserList <- aclToUserList(paste0("syn", projectId))
114+
aclUserList$teamId <- factor(aclUserList$teamId,
115+
levels=aclTeamOrder,
116+
ordered=TRUE)
117+
118+
aclUserList <- aclUserList %>%
119+
group_by(userId) %>%
120+
arrange(teamId) %>%
121+
slice(1) %>%
122+
ungroup()
123+
}
127124
```
128125

129126
```{r summaryuseraccess}
130127
# Get user profile info for users in data download records
131-
allUsersList <- ldply(unique(queryData$userid),
132-
function(x) {
133-
foo <- synGetUserProfile(x);
134-
data.frame(userId=as.character(x),
135-
userName=foo@userName)})
128+
accessUsers <- synRestGET(sprintf("/userGroupHeaders/batch?ids=%s",
129+
paste(unique(queryData$userId),
130+
collapse=",")))
131+
132+
allUsersList <- ldply(accessUsers$children, as.data.frame) %>%
133+
mutate(userId=ownerId) %>%
134+
select(userId, userName)
135+
136+
if (useTeamGrouping) {
137+
allUsers <- left_join(allUsersList, aclUserList)
138+
} else{
139+
allUsers <- allUsersList
140+
allUsers$teamId <- "None"
141+
}
136142
137-
allUsers <- left_join(allUsersList, aclUserList)
138143
levels(allUsers$teamId) <- c(levels(allUsers$teamId), "None")
139144
allUsers$teamId[is.na(allUsers$teamId)] <- "None"
140145
141146
allUsers$group <- "Other"
142-
teamInfo <- ddply(allUsers %>% filter(teamId != "None") %>% select(teamId) %>% unique(),
143-
.(teamId),
144-
function(x) {
145-
tmp <- synRestGET(sprintf("/team/%s", x$teamId));
146-
data.frame(teamId=x$teamId, teamName=tmp$name)
147-
}
148-
)
147+
allUsers$teamName <- "None"
149148
150-
151-
allUsers <- left_join(allUsers, teamInfo, by="teamId")
149+
if (useTeamGrouping) {
150+
teamInfo <- ddply(allUsers %>%
151+
filter(teamId != "None",
152+
!startsWith(as.character(allUsers$teamId),
153+
"syn")) %>%
154+
select(teamId) %>% unique(),
155+
.(teamId),
156+
function(x) {
157+
tmp <- synRestGET(sprintf("/team/%s", x$teamId));
158+
data.frame(teamId=x$teamId, teamName=tmp$name)
159+
}
160+
)
161+
162+
allUsers <- left_join(allUsers, teamInfo, by="teamId")
163+
}
152164
levels(allUsers$teamName) <- c(levels(allUsers$teamName), "None")
153165
allUsers$teamName[is.na(allUsers$teamName)] <- "None"
166+
167+
154168
```
155169

156170
```{r userJoin}
@@ -228,8 +242,8 @@ useraccessCount <- queryData %>%
228242
userId=reorder(userId, n, order=TRUE))
229243
```
230244

245+
```{r plotperdayperuser, fig.width=20, fig.height=6, include=FALSE, eval=FALSE}
231246
#### Accesses per day per user
232-
```{r plotperdayperuser, fig.width=20, fig.height=6, include=TRUE, eval=TRUE}
233247
234248
if (useTeamGrouping) {
235249
plotdata <- queryData %>%

‎lib.R‎

Lines changed: 0 additions & 37 deletions
This file was deleted.

0 commit comments

Comments
 (0)