server <- function(input, output, session) {
rv <- reactiveValues()
observeEvent({
input$process},
{
if (!is.null(input$file1$datapath)) {
tryCatch({
rv$clicks <- SWAT::loadWebClicks(input$file1$datapath)
#licks <- as.data.frame(rv$clicks)
#stopApp(rv$clicks)
rv$clicks <- as.data.frame(rv$clicks)
rv$clicks <- SWAT::cleanData(rv$clicks, matchvector = termstomatch)
#stopApp(rv$clicks)
shiny::removeModal()
},
warning = function(cond){
shiny::showModal(shiny::modalDialog(title = "Incorrect Data Set",
"Please input a properly formatted data set"))
})
} else {
shiny::showModal(
shiny::modalDialog(title = "Missing Data Set",
"Please select a data set to upload!"))
}
})
observe({
if (!is.null(rv$clicks)) {
rv$edatable <- dplyr::summarise(rv$clicks,
`Number of Clicks` = n(),
`Unique Domains` = n_distinct(rv$clicks$AUTHORITY_URI),
`Period Begin Time` = as.character(lubridate::ymd_hms(min(rv$clicks$TIME_CLICKED))),
`Period End Time` = as.character(lubridate::ymd_hms(max(rv$clicks$TIME_CLICKED))))
}
})
observe({
if(!is.null(rv$clicks)) {
rv$top5domains <- head(sort(table(rv$clicks$AUTHORITY_URI), decreasing = T), n = 5)
# rv$top5locations <- head(sort(table(rv$clicks$GEOREGIONCODE), decreasing = T), n = 5)
}
})
observe({
if(!is.null(rv$clicks)) {
rv$top5locations <- head(sort(table(rv$clicks$GEOREGIONCODE), decreasing = T), n = 5)
}
})
observeEvent({input$communitybutton},
{
validate(
need(!is.null(rv$clicks), label = "A dataset"))
rv$iterated.results <- dplyr::data_frame("Filter_Level" = seq(from = min.filter, to = max.filter, by = filter.step),
"Number_of_Communities" =seq(from = min.filter, to = max.filter, by = filter.step),
"Modularity" = seq(from = min.filter, to = max.filter, by = filter.step),
"Number_of_Domains" = seq(from = min.filter, to = max.filter, by = filter.step))
rv$adjacencymatrix <- SWAT:::buildAdjacencyMatrix(rv$clicks)
rv$copurchase.matrix <- t(rv$adjacencymatrix) %*% rv$adjacencymatrix
rv$filteredcommunities <- vector(mode = "list", length = 10L)
for (i in seq(1,length(filters))) {
rv$copurchase.matrix1 <- SWAT:::filterCopurchaseMatrix(rv$copurchase.matrix, n = 3, filterlevel = filters[i])
rv$filteredCommunities <- SWAT:::getCommunities(rv$copurchase.matrix1)
rv$iterated.results$Modularity[i] <- rv$filteredCommunities %>% igraph::modularity()
rv$iterated.results$Number_of_Communities[i] <- rv$filteredCommunities %>% igraph::sizes() %>% nrow()
rv$iterated.results$Number_of_Domains[i] <- rv$filteredCommunities %>% igraph::sizes() %>% sum()
rv$filteredcommunities[[i]] <- rv$filteredCommunities #note the capitalization difference...this assigns the communities object to the list generated previously
}
#stopApp(rv$filteredcommunities)
})
observe({
req(rv$filteredcommunities)
rv$filteredCommunitiesforplots <- rv$filteredcommunities[[input$commfilter]]
rv$domainsincommunities <- as.data.frame(sort(sizes(rv$filteredCommunitiesforplots), decreasing = T))
updateSliderInput(session = session,
"commstodisplay",
min = 1,
max = length(rv$filteredCommunitiesforplots),
step = 1,
value = 1)
rv$filteredCommunitiesfortables <- rv$filteredcommunities[[input$commfilter]]
rv$filteredCommunitiesfortables1 <- rv$filteredCommunitiesfortables[1:length(rv$filteredCommunitiesfortables)]
rv$filteredCommunitiesfortables2 <- rv$filteredCommunitiesfortables1[order(sapply(rv$filteredCommunitiesfortables1,length),decreasing=T)]
}, priority = 1)
observeEvent({input$seeTable},{
req(rv$filteredcommunities)
#stopApp(rv$commtables)
# rv$filteredCommunitiesfortables <- rv$filteredcommunities[[input$commfilter]]
tryCatch({
rv$commtable <- as.data.frame(table(rv$clicks[rv$clicks$AUTHORITY_URI %in% as.vector(rv$filteredCommunitiesfortables2[[input$commstodisplay]]),"AUTHORITY_URI"]))
colnames(rv$commtable) <- c("Domains","Clicks")
rv$commtables <- rv$commtable[order(rv$commtable$Clicks, decreasing = T),]
},
error = function(err) {
rv$filteredCommunitiesfortables1 <- rv$filteredCommunitiesfortables[order(sapply(rv$filteredCommunitiesfortables,length),decreasing=T)]
rv$commtables <- as.data.frame(table(rv$clicks[rv$clicks$AUTHORITY_URI %in% as.vector(rv$filteredCommunitiesfortables[[1]]),"AUTHORITY_URI"]),col.names = c("Domain", "Clicks"))
rv$commtables <- sort(rv$commtables$Clicks, decreasing = T)
})
})
output$table <- shiny::renderDataTable({
rv$clicks
})
output$barchart <- renderPlot({
req(input$file1)
observe({
rv$clicks <- as.data.frame(rv$clicks)
})
if (input$plotcolumn %in% c("VENDORNAME_OPERATINGSYSTEM", "TYPE_HARDWAREPLATFORM","referrer")) {
observe({
rv$selecteddata <- rv$clicks[rv$clicks[,input$plotcolumn] %in% (names(which(table(rv$clicks[,input$plotcolumn]) > input$filterlevel))),
c("referrer",
"VENDORNAME_OPERATINGSYSTEM",
"TYPE_HARDWAREPLATFORM",
"DURATION_FROMCLICKTOCREATION",
"TIME_CLICKED")]
})
#rv$selecteddata <- rv$clicks[,c("referrer","VENDORNAME_OPERATINGSYSTEM","DURATION_FROMCLICKTOCREATION","TIME_CLICKED")]
#stopApp(rv$selecteddata)
shiny::req(rv$selecteddata$referrer, cancelOutput = T)
p <- ggplot2::ggplot(data = rv$selecteddata, aes_string(x = input$plotcolumn))
p <- p + ggplot2::geom_bar(aes_string(fill = input$fillcolumn),
position = input$chartstyle,
show.legend = T) +
ggplot2::ylab("Count")
p <- p + ggthemes::theme_base()
print(p)
}
if (input$plotcolumn %in% c("DURATION_FROMCLICKTOCREATION", "TIME_CLICKED")) {
#updateSliderInput(session, "agefilter", max = round(max(rv$selecteddata$DURATION_FROMCLICKTOCREATION),digits = 0), step = 24, min = 1)
observe({rv$selecteddata1 <- rv$clicks[rv$clicks[,input$fillcolumn] %in% (names(which(table(rv$clicks[,input$fillcolumn]) > input$filterlevel))),
c("referrer",
"VENDORNAME_OPERATINGSYSTEM",
"TYPE_HARDWAREPLATFORM",
"DURATION_FROMCLICKTOCREATION",
"TIME_CLICKED")]
#rv$selecteddata <- rv$selecteddata1[rv$selecteddata1[, input$plotcolumn] < input$agefilter, ]
})
if (input$plotcolumn == "DURATION_FROMCLICKTOCREATION") {
observe({
#rv$selecteddata2 <- rv$selecteddata1
suppressWarnings({
rv$selecteddata2 <- rv$selecteddata1[rv$selecteddata1[,input$plotcolumn] < input$agefilter*24, ]
})
})
#stopApp(rv$selecteddata$DURATION_FROMCLICKTOCREATION)
}
else {
rv$selecteddata2 <- rv$selecteddata1
}
shiny::req(rv$selecteddata2$referrer, cancelOutput = T)
p <- ggplot2::ggplot(data = rv$selecteddata2, aes_string(x = input$plotcolumn))
p <- p + ggplot2::geom_density(aes_string(group = input$fillcolumn, color = input$fillcolumn))
p <- p + ggthemes::theme_base()
print(p)
}
})
output$exploratorydata <- shiny::renderTable({
rv$edatable
})
output$top5webdomains <- shiny::renderTable({
rv$top5domains
})
output$top5locations <- shiny::renderTable({
rv$top5locations
})
output$modularity <- renderPlot({
if (!is.null(rv$iterated.results)) {
#stopApp(rv$iteratedresults)
c <- ggplot2::ggplot(data = rv$iterated.results) + ggplot2::geom_line(aes_string(x = "Filter_Level", y = "Modularity"), size = 1.3) +
ggplot2::ggtitle("Community Modularity Score as Filter Changes") +
ggplot2::scale_x_continuous(breaks = filters, labels = filters) +
ggthemes::theme_economist_white(base_size = 14)
print(c)
}
})
output$instructions <- renderText({
readLines("./www/frontpage.html")
})
output$numcommunities <- renderPlot({
if(!is.null(rv$iterated.results)) {
#stopApp(rv$iterated.results)
d <- ggplot2::ggplot(data = rv$iterated.results) + ggplot2::geom_line(aes_string(x = "Filter_Level", y = "Number_of_Domains"), size = 1.3) +
ggplot2::ggtitle("Number of Web Domains Remaining as filter changes") +
ggplot2::scale_x_continuous(breaks = filters, labels = filters) +
ggthemes::theme_economist_white(base_size = 14)
print(d)
}
})
output$domainsincommunities <- renderPlot({
e <- ggplot2::ggplot(data = rv$domainsincommunities, aes_string(x = 1:length(rv$domainsincommunities$Freq), y = "Freq")) +
ggplot2::geom_line(size = 1.3) +
ggplot2::geom_point(size = 4) +
#ggplot2::scale_x_continuous(labels = seq(from = 1, to = max(rv$domainsincommunities), by = 1),
# breaks = seq(from = 1, to = max(rv$domainsincommunities), by = 1)) +
ggplot2::xlab("Community Number") +
ggplot2::ylab("Number of Domains assigned to that Community")+
ggthemes::theme_economist_white(base_size = 14)
print(e)
})
output$commtables <- shiny::renderDataTable({
if(!is.null(rv$iterated.results)) {
rv$commtables
}
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.