#Load Libraries
library(RNeo4j)
## Warning: package 'RNeo4j' was built under R version 3.3.3
# library(sparklyr)
library(data.table)
# library(sparklyr)
library(dplyr)
## -------------------------------------------------------------------------
## data.table + dplyr code now lives in dtplyr.
## Please library(dtplyr)!
## -------------------------------------------------------------------------
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:data.table':
##
## between, first, last
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(foreach)
library(tidyr)
library(tibble)
library(stringr)
## Warning: package 'stringr' was built under R version 3.3.3
library(igraph)
##
## Attaching package: 'igraph'
## The following object is masked from 'package:stringr':
##
## %>%
## The following object is masked from 'package:tibble':
##
## as_data_frame
## The following objects are masked from 'package:tidyr':
##
## %>%, crossing
## The following objects are masked from 'package:dplyr':
##
## %>%, as_data_frame, groups, union
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
library(visNetwork)
##
## Attaching package: 'visNetwork'
## The following object is masked from 'package:igraph':
##
## %>%
library(leaflet)
##
## Attaching package: 'leaflet'
##
## The following object is masked from 'package:igraph':
##
## %>%
library(RCurl)
## Loading required package: bitops
##
## Attaching package: 'RCurl'
## The following object is masked from 'package:tidyr':
##
## complete
library(RJSONIO)
library(CartoDB)
library(rgdal)
## Warning: package 'rgdal' was built under R version 3.3.3
## Loading required package: sp
## rgdal: version: 1.2-5, (SVN revision 648)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 2.0.1, released 2015/09/15
## Path to GDAL shared files: C:/Users/GuruRakesh/Documents/R/win-library/3.3/rgdal/gdal
## Loaded PROJ.4 runtime: Rel. 4.9.2, 08 September 2015, [PJ_VERSION: 492]
## Path to PROJ.4 shared files: C:/Users/GuruRakesh/Documents/R/win-library/3.3/rgdal/proj
## Linking to sp version: 1.2-4
library(RJDBC)
## Warning: package 'RJDBC' was built under R version 3.3.3
## Loading required package: DBI
## Loading required package: rJava
##
## Attaching package: 'rJava'
## The following object is masked from 'package:RCurl':
##
## clone
library(rjson)
##
## Attaching package: 'rjson'
## The following objects are masked from 'package:RJSONIO':
##
## fromJSON, toJSON
library(shiny)
library(shinydashboard)
##
## Attaching package: 'shinydashboard'
## The following object is masked from 'package:graphics':
##
## box
library(shinyBS)
library(shinyjs)
##
## Attaching package: 'shinyjs'
## The following object is masked from 'package:shiny':
##
## runExample
## The following object is masked from 'package:rJava':
##
## show
## The following object is masked from 'package:DBI':
##
## show
## The following object is masked from 'package:sp':
##
## show
## The following object is masked from 'package:RCurl':
##
## reset
## The following objects are masked from 'package:methods':
##
## removeClass, show
library(shinyTree)
## Warning: package 'shinyTree' was built under R version 3.3.3
library(DT) #javascript
##
## Attaching package: 'DT'
## The following objects are masked from 'package:shiny':
##
## dataTableOutput, renderDataTable
## The following object is masked from 'package:igraph':
##
## %>%
library(zipcode)
data(zipcode)
library(XLConnect)
## Loading required package: XLConnectJars
## XLConnect 0.2-12 by Mirai Solutions GmbH [aut],
## Martin Studer [cre],
## The Apache Software Foundation [ctb, cph] (Apache POI, Apache Commons
## Codec),
## Stephen Colebourne [ctb, cph] (Joda-Time Java library),
## Graph Builder [ctb, cph] (Curvesapi Java library)
## http://www.mirai-solutions.com ,
## http://miraisolutions.wordpress.com
library(dygraphs) #Time Series Chart plugin
## Warning: package 'dygraphs' was built under R version 3.3.3
##
## Attaching package: 'dygraphs'
## The following object is masked from 'package:igraph':
##
## %>%
library(ggplot2)
library(plotly) #To Generate Barcharts
## Warning: package 'plotly' was built under R version 3.3.3
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following objects are masked from 'package:igraph':
##
## %>%, groups
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
options(java.parameters = "- Xmx1024m")
#connect to Spark
# spark_install(version = "2.0.0", hadoop_version = "2.7") #don't delete this ever - needed for shiny deployment
# sc <- spark_connect(master = "local", version = "2.0.0", hadoop_version = "2.7")
# us_zips <- readr::read_csv ("US Zip Codes from 2013 Government Data - Copy")
# us_zips <- copy_to(sc, zipcode, overwrite = TRUE)
# zipcodes_states <- copy_to(sc, zipcode, overwrite = TRUE)
#connect to database
graph ='' #startGraph("http://74.93.88.27:7071/db/data/", username="neo4j", password="Quad1admin")
#FUNCTIONS
#capitalize first letter
#generate statistics
get_network_stats <- function (my.graph){
deg <- igraph::degree(my.graph)
ec <- eigen_centrality (my.graph)
my.ecs <- tibble(node = rep(names(ec$vector), sapply(ec$vector, length)),
EC = unlist(ec$vector))
my.ecs$rank <- rank(-my.ecs$EC)
net_stats_full <- cbind ( deg, my.ecs)#, btwn)#,loss_conn, effic, rob_close,vul)
net_stats_full <- net_stats_full[,c(2,4,1,3)]
colnames(net_stats_full) <- c("Node", "Prestige", "Degree","Centrality")
gc()
return (net_stats_full)
}
riskTreefun <- function(){
li<-renderTree({
list(
Global_Risk = structure(sticon="globe",stselected=TRUE,
list(AMLOC="",PLTC="",FATCA="",CIAFACT="",
SENTIMENT="",PROXIMITY="",RISK_7="",RISK_8="",RISK_9="",RISK_10="")),
FI_Risk = structure(sticon="briefcase",
list( RISK_312A="",WST="",SENTIMENT="",UN="",IMF="",TRA="",RISK_7="",RISK_8="",RISK_9="",RISK_10="")
)
)
})
li<-paste(li)
print(li)
return('hi')
}
firstup <- function(x){
substr(x,1,1) <- toupper(substr(x,1,1))
x
}
#make icons for leaflet
partyIcon <- makeIcon(
iconUrl = "fa-user_red.png",
iconWidth = 38,
iconHeight = 38
)
#get party info
get_party_info <- function(my.party){
# my.party <- "149027"
# my.party <- "100400005"
# my.party <- "100400036"
# my.party <- "100400017"
# my.party <-"100585177" #shares many accounts
# my.party <- "100259005" #shares many accounts
# my.party <- "100676653"
# my.party <- "100653553"
# my.party <- "100176769"
# my.party <- c("100025971" ,"100025968")
my.lst <- paste(shQuote(my.party), collapse = "," )
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
n.party_id, n.name,
m.phone, m.email, m.street, m.city, m.state, m.zipcode, m.Latitude, m.Longitude")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
party_table <- unique(setDT(temp)[,lapply(.SD, na.omit), by = n.party_id])
party_table <- as.data.frame( lapply(party_table, as.character), stringsAsFactors = FALSE)
colnames(party_table) <- tolower(colnames(party_table))
# if (length(party_table$m.zipcode) == 1){
# my.zip <- tibble::as_data_frame(filter(us_zips, zip == party_table$m.zipcode))
# }else {
# my.zip <- tibble::as_data_frame(filter(us_zips, zip %in% party_table$m.zipcode))
# }
#
# if (nrow(my.zip) == 0){
# my.zip = sample_n(tibble::as_data_frame(us_zips),1)
# my.state <- filter(tibble::as_data_frame(us_zips), zip == my.zip$zip)
# }
# party_table$zipcode <- party_table$zip
# party_table <- cbind.data.frame(party_table, my.zip)
# party_table$n.party_id <- as.numeric(party_table$n.party_id)
party_table$m.zipcode <- as.numeric(party_table$m.zipcode)
party_table$m.latitude <- as.numeric(party_table$m.latitude)
party_table$m.longitude <- as.numeric(party_table$m.longitude)
names(party_table) <- gsub("m\\.","", names(party_table))
names(party_table) <- gsub("n\\.","", names(party_table))
names(party_table) <- gsub("_id","", names(party_table))
return (unique (party_table))
}
get_node_info <- function(my.choice, nodeType){
rel <- ifelse (nodeType == "email", "HAS_EMAIL", ifelse (nodeType == "acct_id", "HAS_ACCT",
ifelse(nodeType == "phone", "HAS_PHONE", ifelse(nodeType == "city", "HAS_CITY",
ifelse(nodeType == "zipcode", "HAS_ZIP", ifelse(nodeType == "state", "HAS_STATE", NA))))))
query <- paste0("MATCH p= (n:Party)-[r:",rel,"]->(m{",nodeType,":", "'",my.choice,"'","}) return distinct
n.party_id, n.name, n.acct_id, m.email, m.phone" )
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
my.parties <- NULL
for (i in 1:nrow(temp)){
my.party <- get_party_info(temp$n.party_id[i])
my.parties[[i]] <- my.party
}
my.parties <- data.table::rbindlist(my.parties, fill = TRUE)
return (my.parties)
}
#get node and node type
get_nodeTypes <- function (my.data){
nodeType <- NULL
group.nodes <- NULL
temp <- lapply(my.data, function (x) data.table(x))
groups <- NULL
for (i in 1:length(temp)){
my.group <- data.table(temp[[i]], names(temp)[i])
groups [[i]] <- my.group
}
groups <- unique(rbindlist(groups))
colnames(groups) <- c("id","nodeType")
gc()
return (groups)
}
make_edgelist <- function (edge.data){
edges <- NULL
edges <- data.frame(source = NA, target = NA)
for (i in 1:(ncol(edge.data)-1)) {
for (j in 1:(ncol(edge.data)-1)){
# my.edges <- data.table (edge.data[[i]],edge.data[[j+1]])
my.edges <- data.table (edge.data[[i]],edge.data[[j+1]])
edges <- rbind (edges, setNames(my.edges, names(edges)))
}
}
edges <- edges[!edges$source == edges$target,]
edges <- unique(edges)
return (na.omit(edges))
}
get_acquaintances <- function (my.node){
# my.node <- "100927827"
# query to find maximum number of accounts in a party:
#match (n:Party)<-[r:HAS_ACCT]->(m) WITH n, count(m) as rels WHERE rels > 4 RETURN n,rels LIMIT 5
my.lst <- paste(shQuote(my.node), collapse = "," )
query <- paste0("MATCH (n:Party) <-[r:HAS_ACCT*..5]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
n.party_id, m.acct_id, m.party_id, n.acct_id" )
accounts <- rbindlist (cypherToList(graph, query), fill = TRUE)
# my.lst <- paste(shQuote(my.node), collapse = "," )
# query <- paste0("MATCH (n:Party) <-[r:HAS_EMAIL*..5]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
# n.party_id, m.acct_id, m.party_id, n.acct_id" )
# accounts <- rbindlist (cypherToList(graph, query), fill = TRUE)
fetch_parties <- NULL
if (nrow(accounts) < 1){
fetch_parties <- my.node
}else{
fetch_parties <- unique(na.omit(c(accounts$n.party_id, accounts$m.party_id)))
}
return (fetch_parties)
}
make_single_graph <- function(my.node){
# my.node <- "100025976"
# my.node <- '149027'
# my.node <- my.party
# my.node <- "100927827"
my.lst <- paste(shQuote(get_acquaintances(my.node)), collapse = "," )
query <- paste0("MATCH (n:Party) <-[r:HAS_ACCT]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
n.party_id, m.acct_id, r.fin_agr_cd, r.acct_rel, r.acct_opn_dt" )
account_table <- rbindlist (cypherToList(graph, query), fill = TRUE)
if (nrow(account_table) > 0) names(account_table) <- gsub("r\\.","", names(account_table))
party_table <- unique(get_party_info(get_acquaintances(my.node)))
if (nrow(account_table) > 0){
drop <- c ("latitude","longitude","name")
colnames(account_table)[1:2] <- c("party","account")
my.nodetypes <- unique (dplyr::bind_rows (get_nodeTypes(account_table[,2]),
get_nodeTypes(select(party_table, -one_of(drop)))))
colnames(account_table)[1:2] <- c("source","target")
my.edges <- unique (dplyr::bind_rows (account_table[,1:2],make_edgelist(select(party_table, -one_of(drop)))))
my.graph <- igraph::graph.data.frame(my.edges)
my.graph <- set.vertex.attribute(my.graph, "nodeType", value = my.nodetypes$nodeType[match(igraph::V(my.graph)$name,my.nodetypes$id)])
my.graph <- set.vertex.attribute(my.graph, "fin_agr_cd", value = account_table$fin_agr_cd[match(igraph::V(my.graph)$name,account_table$target)])
my.graph <- set.vertex.attribute(my.graph, "acct_rel", value = account_table$acct_rel[match(igraph::V(my.graph)$name,account_table$target)])
my.graph <- set.vertex.attribute(my.graph, "acct_opn_dt", value = account_table$acct_opn_dt[match(igraph::V(my.graph)$name,account_table$target)])
} else {
drop <- c ("latitude","longitude","name")
my.nodetypes <- unique (get_nodeTypes(select(party_table, -one_of(drop))))
my.edges <- unique (make_edgelist(select(party_table, -one_of(drop))))
my.graph <- igraph::graph.data.frame(my.edges)
my.graph <- set.vertex.attribute(my.graph, "nodeType", value = my.nodetypes$nodeType[match(igraph::V(my.graph)$name,my.nodetypes$id)])
}
# plot(my.graph)
return(my.graph)
}
get_party_name <- function (my.party){
my.lst <- paste(shQuote(my.party), collapse = "," )
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
n.name")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
return(temp)
}
make_single_network <- function (my.node, selected_node){
# my.node <- c ("100025976", "100025979")
# my.node <- selected_node <- "100025979"
# my.node <- selected_node <- my.party
my.graph <- make_single_graph(my.node)
dummy <- visNetwork::toVisNetworkData(my.graph)
my.nodes <- dummy$nodes
my.edges <- dummy$edges
my.nodes$borderWidth <- 0
my.nodes$deg <- igraph::degree(my.graph, mode = "all")
# my.nodes$title <- ifelse (my.nodes$nodeType == "party",
# paste ("<b>", firstup(my.nodes$nodeType),": ", my.nodes$label, "</b>",
# "<br>","Name: ", get_party_name(my.nodes$id)$n.name,
# "<br>", "Connections: ", my.nodes$deg),
# paste ("<b>", firstup(my.nodes$nodeType),": ", my.nodes$label, "</b>",
# "<br>", "Connections: ", my.nodes$deg))
for (i in 1:nrow(my.nodes)){
if (!is.null(my.nodes$nodeType[i])){
if (my.nodes$nodeType[i] == "party"){
my.nodes$title[i] <- paste ("<b>", firstup(my.nodes$nodeType[i]),": ", my.nodes$label[i], "</b>",
"<br>","Name: ", get_party_name(my.nodes$id[i])$n.name,
"<br>", "Connections: ", my.nodes$deg[i])
} else if (my.nodes$nodeType[i] == "account"){
my.nodes$title[i] <- paste ("<b>", firstup(my.nodes$nodeType[i]),": ", my.nodes$label[i], "</b>",
"<br>","Fin Agr Cd: ", my.nodes$fin_agr_cd[i],
"<br>","Open Date: ", my.nodes$acct_opn_dt[i],
"<br>", "Connections: ", my.nodes$deg[i])
} else{
my.nodes$title[i] <- paste ("<b>", firstup(my.nodes$nodeType[i]),": ", my.nodes$label[i], "</b>",
"<br>", "Connections: ", my.nodes$deg[i])
}
}
}
my.nodes$group <- my.nodes$nodeType
for (i in 1:nrow(my.nodes)){
if (!is.null(my.nodes$group)){
if(my.nodes$nodeType[i] == "account"){
if (my.nodes$fin_agr_cd [i] == "DHLN"){
my.nodes$group[i] = my.nodes$fin_agr_cd [i]
}else if (my.nodes$fin_agr_cd [i] == "DPLN"){
my.nodes$group[i] = my.nodes$fin_agr_cd [i]
}else if (my.nodes$fin_agr_cd [i] == "DSLN"){
my.nodes$group[i] = my.nodes$fin_agr_cd [i]
}else if (my.nodes$fin_agr_cd [i] == "CARD"){
my.nodes$group[i] = my.nodes$fin_agr_cd [i]
}else if (my.nodes$fin_agr_cd [i] == "CHK"){
my.nodes$group[i] = my.nodes$fin_agr_cd [i]
}else if (my.nodes$fin_agr_cd [i] == "SAV"){
my.nodes$group[i] = my.nodes$fin_agr_cd [i]
}
}else{
my.nodes$group[i] = my.nodes$group[i]
}
}
}
# my.nodes$group <- firstup(my.nodes$group)
my.edges$smooth <- TRUE
my.edges$shadow <- TRUE
my.edges$color <- "grey"
my.edges$color.opacity = 0.3
my.net <- visNetwork(my.nodes, my.edges)%>%
visPhysics(solver = "forceAtlas2Based",
stabilization = TRUE,
forceAtlas2Based = list(gravitationalConstant = -70))%>%
visGroups(groupname = "party", shape = "icon",
icon = list(code = "f007", color = "firebrick", size = 150)) %>%
#Card accounts
visGroups(groupname = "CARD", shape = "icon",
icon = list(code = "f1f2", color = "cornflowerblue", size = 75)) %>%
visGroups(groupname = "SAV", shape = "icon",
icon = list(code = "f155", color = "cornflowerblue", size = 75)) %>%
visGroups(groupname = "DSLN", shape = "icon",
icon = list(code = "f19d", color = "cornflowerblue", size = 75)) %>%
visGroups(groupname = "CHK", shape = "icon",
icon = list(code = "f19c", color = "cornflowerblue", size = 75)) %>%
visGroups(groupname = "DHLN", shape = "icon",
icon = list(code = "f015", color = "cornflowerblue", size = 75)) %>%
visGroups(groupname = "DPLN", shape = "icon",
icon = list(code = "f007", color = "cornflowerblue", size = 75)) %>%
visGroups(groupname = "zipcode", shape = "icon",
icon = list(code = "f041", color = "green", size = 100)) %>%
visGroups(groupname = "phone", shape = "icon",
icon = list(code = "f095", color = "black", size = 100)) %>%
visGroups(groupname = "street", shape = "icon",
icon = list(code = "f277", color = "green", size = 100)) %>%
visGroups(groupname = "email", shape = "icon",
icon = list(code = "f0e0", color = "black", size = 100)) %>%
# visGroups(groupname = "ip", shape = "icon",
# icon = list(code = "f109", color = "black", size = 100)) %>%
visGroups(groupname = "state", shape = "icon",
icon = list(code = "f0ac", color = "green", size = 100)) %>%
visGroups(groupname = "city", shape = "icon",
icon = list(code = "f1ad", color = "green", size = 100)) %>%
# visGroups(groupname = "cc.logo", shape = "icon",
# icon = list(code = "f09d", color = "black", size = 100)) %>%
visOptions(highlightNearest =TRUE,
nodesIdSelection = list(enabled = TRUE, selected = selected_node),
selectedBy = "nodeType")%>%
visExport()%>%
# visFit(animation = list(duration = 1500, easingFunction
# = "easeInOutQuad"))%>%
visLegend(useGroups = FALSE, position = "right", ncol = 2,
addNodes = list (
list(label = "Party", shape = "icon", icon = list(code ="f007", size = 70, color = "firebrick")),
list(label = "Zipcode", shape = "icon", icon = list(code ="f041", size = 70, color = "green")),
list(label = "Phone", shape = "icon", icon = list(code ="f095", size = 70, color = "black")),
list(label = "Street", shape = "icon", icon = list(code ="f277", size = 70, color = "green")),
list(label = "Email", shape = "icon", icon = list(code ="f0e0", size = 70, color = "black")),
list(label = "State", shape = "icon", icon = list(code ="f0ac", size = 70, color = "green")),
list(label = "City", shape = "icon", icon = list(code ="f1ad", size = 70, color = "green")),
list(label = "CHK", shape = "icon", icon = list(code ="f19c", size = 70)),
list(label = "SAV", shape = "icon", icon = list(code ="f155", size = 70)),
list(label = "CARD", shape = "icon", icon = list(code ="f1f2", size = 70)),
list(label = "DHLN", shape = "icon", icon = list(code ="f015", size = 70)),
list(label = "DSLN", shape = "icon", icon = list(code ="f19d", size = 70)),
list(label = "DPLN", shape = "icon", icon = list(code ="f007", size = 70))
))%>%
visInteraction(navigationButtons = TRUE, hover = TRUE )%>%
visEvents(
hoverNode = "function(nodes){
Shiny.onInputChange('current_node_id',nodes)
;
;}"
,
doubleClick = "function(nodes){
Shiny.onInputChange('doubleClick',nodes.nodes[0]);
;}"
,
type = "once", select = "function() {
alert('first selection');}"
)%>%
addFontAwesome()
return (my.net)
}
get_communities_oneStep <- function (){
my_comms <- spark_read_csv(sc, "my_comms", "my_clusters_bi15.csv", overwrite=TRUE)
my_comms <- dplyr::rename(my_comms, community = label)
my_comms <- my_comms %>%
group_by(community)%>%
filter(n() > 8)
cls <- as.data.table(my_comms)
my.comms <- split(cls, f = cls$community)
party_comms <- NULL
account_comms <- NULL
party_comms <- foreach (i = 1:length(my.comms)) %dopar% {
# my.subgraph <- igraph::induced.subgraph(my.graph, my.comms[[i]]$id)
my.lst <- paste(shQuote(my.comms[[i]]$id), collapse = "," )
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct n.party_id ")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
party_comms[[i]] <- temp
}
account_comms <- foreach (i = 1:length(my.comms)) %dopar% {
# my.subgraph <- igraph::induced.subgraph(my.graph, my.comms[[i]]$id)
my.lst <- paste(shQuote(my.comms[[i]]$id), collapse = "," )
query <- paste0("MATCH (n:Party) -[r:HAS_ACCT]->(m) WHERE m.acct_id IN [", my.lst, "]", " return distinct n.party_id ")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
account_comms[[i]] <- temp
}
party_comms <- party_comms[sapply(party_comms, function (x) !nrow(x)==0 )]
account_comms <- account_comms[sapply(account_comms, function (x) !nrow(x)==0 )]
dummy <- NULL
dummy <- foreach (i = 1:length(party_comms)) %dopar% {
temp <- make_single_graph(party_comms[[i]]$n.party_id)
dummy[[i]] <- temp
}
dummy2 <- NULL
dummy2 <- foreach (i = 1:length(account_comms)) %dopar% {
temp <- make_single_graph(account_comms[[i]]$n.party_id)
dummy2[[i]] <- temp
}
# account_comms[[15]]$n.party_id
# make_single_graph(account_comms[[7]]$n.party_id)
comms <- append (dummy[!sapply(dummy, is.null)], dummy2[!sapply(dummy2, is.null)])
comm.stats <- NULL
each.comm.stats <- NULL
comm.stats <- foreach ( i = 1:length(comms)) %dopar% {
my.density <- igraph::graph.density(comms[[i]])
my.members <- igraph::vcount(comms[[i]])
my.avg.path <- igraph::mean_distance(comms[[i]])
my.trans <- igraph::transitivity(comms[[i]])
my.stats <- data.table::data.table(i, my.members, my.avg.path, my.density, my.trans)
colnames(my.stats) <- c("Community Number","Community Size", "Average Path Length", "Density","Transitivity")
comm.stats [[i]] <- my.stats
}
each.comm.stats <- rbindlist (comm.stats)
#individual nodes
comm.stats <- NULL
all.comm.stats <- NULL
comm.stats <- foreach ( i = 1:length(comms)) %dopar%{
#get degree
my.deg <- data.frame(igraph::degree(comms[[i]]))
#get centrality
cls <- igraph::closeness (comms[[i]])
my.closeness <- data.frame(node = rep(names(cls), sapply(cls, length)),
CC = unlist(cls))
#get prestige
ec <- igraph::eigen_centrality (comms[[i]])
my.ecs <- data.frame(node = rep(names(ec$vector), sapply(ec$vector, length)),
EC = unlist(ec$vector))
my.ecs$rank <- data.frame(rank(-my.ecs$EC))
#get Page Rank
pg <- igraph::page_rank(comms[[i]])
my.pg <- data.frame(node = rep(names(pg$vector), sapply(pg$vector, length)),
PR = unlist(pg$vector))
my.stats <- cbind(my.deg, my.closeness, my.ecs$rank, my.pg$PR)
my.stats <- my.stats[,c(2,4,1,3,5)]
colnames(my.stats) <- c ("Node", "Prestige", "Degree", "Closeness","Page Rank")
my.stats$Community <- rep(i, nrow(my.stats)); my.stats <- my.stats[,c(1,6,2,3,4,5)]
comm.stats [[i]] <- my.stats
}#end stats capture on communities
all.comm.stats <- rbindlist(comm.stats)
gc()
return(list(each.comm.stats, all.comm.stats))
}
#END FUNCTIONS
#MAIN
# my.comm.stats <- get_communities_oneStep()
# each_comm_stats <- my.comm.stats[[1]]; all_comm_stats <- my.comm.stats[[2]]
# each_comm_stats <- copy_to(sc, each_comm_stats, overwrite = TRUE)
# all_comm_stats <- copy_to(sc, all_comm_stats, overwrite = TRUE)
# tbl_cache(sc, "each_comm_stats")
# tbl_cache(sc, "all_comm_stats")
#SHINY TIME
my.single.graph <- NULL
my.party.tracker <<- NULL
add_me <- NULL
my.choice <<- NULL
#Transaction Information
# txns <<- NULL
#country transaction column names
ctry_txns <- list()
f_txns <- data.frame()
tot_txns <- data.frame()
# Map creation calling from constants
my.constants.CALLING_FROM<-list(HOME="HOME",FILTER="FILTER")
server <- function(input, output, session){
make_leaflet <- function(my.map.choice){
leaflet(data = my.map.choice)%>%
addTiles(group = "OpenStreetMap")%>%
addProviderTiles("Stamen.Toner", group = "Stamen.Toner")%>%
addProviderTiles("Stamen.Watercolor", group = "Stamen.Watercolor")%>%
addProviderTiles("CartoDB.Positron",group = "CartoDB.Positron")%>%
addMarkers (icon = partyIcon, ~longitude, ~latitude, popup = paste(my.map.choice$name,"<br>",
"<b>Party ID: ", my.map.choice$party,
"</b><br>", my.map.choice$city,", ", my.map.choice$state,
"<br>",my.map.choice$zip),
clusterOptions = markerClusterOptions(),
group = "Party") %>%
addLayersControl(baseGroups = c("Stamen.Toner","OpenStreetMap","Stamen.Watercolor","CartoDB.Positron"),
overlayGroups = c("Party"))%>%
fitBounds(~min(longitude+5), ~min(latitude), ~max(longitude), ~max(latitude+5))
# gc()
}
#Default country risk query
Ctry_RISK_QUERY <- paste("select ctry as COUNTRY_CD, "
, " DECODE(greatest(risk1,risk2,risk3,risk4,risk5,risk6,risk7,risk8,risk9,risk10),3,'H',2,'M',1,'L') as RISK_FLAG "
, " from (select country_cd as ctry, DECODE(cr.AMLOC,'H',3,'M',2,'L',1) as risk1, "
, " DECODE(cr.CIAFACT,'H',3,'M',2,'L',1) as risk2 "
, ", DECODE(cr.SENTIMENT,'H',3,'M',2,'L',1) as risk3, DECODE(cr.FATCA,'H',3,'M',2,'L',1) as risk4"
, ", DECODE(cr.PLTC,'H',3,'M',2,'L',1) as risk5, DECODE(cr.PROXIMITY,'H',3,'M',2,'L',1) as risk6"
, ", DECODE(cr.RISK_7,'H',3,'M',2,'L',1) as risk7, DECODE(cr.RISK_8,'H',3,'M',2,'L',1) as risk8"
, ", DECODE(cr.RISK_9,'H',3,'M',2,'L',1) as risk9, DECODE(cr.RISK_10,'H',3,'M',2,'L',1) as risk10"
, " from country_risk cr)")
#read country lat and lan
ctry_file <- "countries.json"
ctry_latlng <- fromJSON(file=ctry_file)
# Reading Geo json countries
# https://raw.githubusercontent.com/datasets/geo-boundaries-world-110m/master/countries.geojson
# countries <- readOGR("cartodb_query.geojson","OGRGeoJSON")
countries<-geojsonio::geojson_read("cartodb_query.geojson",
what = "sp")
# cartodb_account_name = "ramr2200"
# cartodb(cartodb_account_name,api.key = "416be296abbc601b1a4098b5ad64f0c7ee7fbfd6")
# cartodb.test()
# countries <- cartodb.collection("cartodb_query", geomAs="XY")
# print('----coy')
# print(countries)
#create leafletmap
makeLeafletMap <- function(){
print('---makeLeafletMap-start--')
lmap<-leaflet()%>%
addTiles(group = "OpenStreetMap")%>%
addProviderTiles("Stamen.Toner", group = "Stamen.Toner")%>%
addProviderTiles("Stamen.Watercolor", group = "Stamen.Watercolor")%>%
addProviderTiles("CartoDB.Positron",group = "CartoDB.Positron")
print('---makeLeafletMap-created--')
return(lmap)
}
#Declare global varibale for loading driver only once
Jdbc_Driver <- NULL
#creating connection
getDbConn <- function(){
print('---getting db connection-start--')
if(is.null(Jdbc_Driver)){
Jdbc_Driver = JDBC("oracle.jdbc.OracleDriver",
classPath="ojdbc6.jar")
}
con = dbConnect(Jdbc_Driver, "jdbc:oracle:thin:@40.143.89.230:1521:xe", "sysdbo", "orapd1pass")
print('---db connection-created--')
return(con)
}
create_multi_colqry <- function(colName,colValue){
col_cond<-''
for(ind in 1:8){
col_cond<- paste(col_cond,colName,ind,"='",colValue,"' OR ",sep = "")
}
col_cond<- paste(col_cond,colName,ind,"='",colValue,"'",sep = "")
return(col_cond)
}
create_multicol_inqry <- function(query,fi_risk_list,colName){
fi_cond<-' 1=0 '
for(fi in fi_risk_list){
fi_cond<-paste(fi_cond," OR ",fi,"='H' ")
}
cond<-'('
for(i in 1:8){
cond<-paste(cond,colName,i," IN ",query,fi_cond,") OR ",sep = "")
}
cond<-paste(cond,colName,9," IN ",query,fi_cond,")",sep = "")
cond<-paste(cond,')')
return(cond)
}
create_filter_cond <- function(fi_risk_list,sear_param_list)
{
print('---create_filter_cond-creation-start--')
fi_cond <- ''
if(length(sear_param_list)>0){
snames<-names(sear_param_list)
if("highrisk" %in% snames){
fi_cond <- paste(fi_cond," AND highrisk='",sear_param_list[["highrisk"]],"' ",sep = "")
}
if("hops" %in% snames){
fi_cond <- paste(fi_cond," AND hops='",sear_param_list[["hops"]],"' ",sep = "")
}
if("riskent" %in% snames){
fi_cond <- paste(fi_cond," AND riskent='",sear_param_list[["riskent"]],"' ",sep = "")
}
if("xborder" %in% snames){
fi_cond <- paste(fi_cond," AND xborder='",sear_param_list[["xborder"]],"' ",sep = "")
}
if("role" %in% snames){
role_cond <- create_multi_colqry('role',sear_param_list[["role"]])
fi_cond <- paste(fi_cond,"AND (",role_cond,")",sep = "")
}
if("ctry" %in% snames){
ctry_cond <- create_multi_colqry('ctry_',sear_param_list[["ctry"]])
fi_cond <- paste(fi_cond,"AND (",ctry_cond,")",sep = "")
}
if("combined" %in% snames){
print('----search--')
print(sear_param_list[["combined"]])
fi_cond <- paste(fi_cond," AND combined like '%",sear_param_list[["combined"]],"%' ",sep = "")
}
}
if(length(fi_risk_list)!=0){
rcond<-create_multicol_inqry("(select FI_CC from FI_RISK where ",fi_risk_list,"bank_id_")
fi_cond<-paste(fi_cond," AND ",rcond)
}
print('---create_filter_cond-created---')
return(fi_cond)
}
# Colors to markers
colors <- list( "#FF0000", "#00FF00", "#0000FF", "#FFFFFF", "#000000",
"#FFFF00", "#00FFFF", "#FF00FF" )
# Create country markers using country lat&lan and txns of of country
create_Markers<-function(lmap,ctry_txns,txns){
print('---create_Markers-creation-start--')
for(ind in 1:length(ctry_txns)){
cind=ctry_txns[[ind]]
lmap<-addCircleMarkers (lmap , lng = cind$lon,lat= cind$lat,
popup = popupcontent(cind$txns,txns,cind$lon,cind$lat),
clusterOptions = markerClusterOptions(),
layerId = "ctryMarkers",
group = "Party",color = 'blue',
fillColor = colors[ind%%8],
fillOpacity = 0.5,weight=1 )
# lmap%>%observeEvent({
# pmap<-leafletProxy("lmap")
# event <- input
# print(event)
# })
}
print('---create_Markers-created-in-map---')
return(lmap)
}
#make arrow icon for leaflet
arrowIcon <- makeIcon(
iconWidth = 25,
iconHeight = 25,
iconUrl = "fa-symbol_fore_close.png"
)
# Create bank Risk Markers
create_bank_markers<-function(lmap,fi_risk_ctrys,ctry_txns,txns){
print('---create_bank_markers-creation-in-map-start--')
ctryNames<-names(ctry_txns)
if(nrow(fi_risk_ctrys)!=0){
for(find in 1:nrow(fi_risk_ctrys)){
fi_ctry<-fi_risk_ctrys[find,1]
if(fi_ctry %in% ctryNames)
{
ctry<-ctry_txns[[fi_ctry]]
lmap <- addMarkers(map = lmap,lng =ctry$lon,lat=ctry$lat,
popup=popupcontent(ctry$txns,txns,ctry$lon,ctry$lat),
group = "Party",icon =arrowIcon)
}
}
}
print('---create_bank_markers-created-in-map---')
return(lmap)
}
get_txns <- function(con,fi_risk_list,sear_param_list){
print('---get_txns-getting transactions related to filters---')
filter_cond <- create_filter_cond(fi_risk_list,sear_param_list)
txn_qry <- "SELECT * FROM AML_WIRE_TRAN_REPORTING "
if(filter_cond!=''){
txn_qry <- paste(txn_qry," where 1=1 ",filter_cond)
}
print('---qry')
print(txn_qry)
print('---qry')
txns=dbGetQuery(con, txn_qry)
print('---get_txns-txns retrived---')
return(txns)
}
get_all_txns <- function(con){
print('---get_all_txns getting all transactions---')
txn_qry <- "SELECT * FROM AML_WIRE_TRAN_REPORTING "
txns=dbGetQuery(con, txn_qry)
print('---get_txns-txns retrived---')
return(txns)
}
# Suparting txns based on country
create_ctry_latlon_txns <- function(txns){
print('---create_ctry_latlon_txns- Suparting txns based on country---')
#Poly lines latitued and langtiude arrays
txn_lines_lon<-list()
txn_lines_lat<-list()
# Bank Ids List
bankid_list<-list()
for(tind in 1:nrow(txns)){
txn_lon<-list()
txn_lat<-list()
#Txn going stations
for(cind in 1:9){
# Add Ban ids to alist for finding fi risk for a bank
bankid<-paste("BANK_ID_", cind, sep="")
if(!is.na(txns[tind,bankid])&&!is.null(txns[tind,bankid])){
bankid_list[[txns[tind,bankid]]]<-txns[tind,bankid]
}
# suparate out transactions going trough country
ctry=txns[tind,paste("CTRY_", cind, sep="")]
if( ctry %in% names(ctry_txns) ){
ctry_txn_df=data.frame(
row<-tind,
col<-list(data.frame(
role=paste("ROLE", cind,sep = ""),
ctry=paste("CTRY_", cind,sep = ""),
amount="AMOUNT",
date="DATE",
transNo="COMBINED",
bankId=paste("BANK_ID_", cind, sep = ""),
oParty="OPARTY",
bParty="BPARTY",
trantype="TRANTYPE",
xborder="XBORDER",
riskent="RISKENT",
addr1=paste("ADDR_", cind,'_1', sep = ""),
addr2=paste("ADDR_", cind,'_2', sep = ""),
addr3=paste("ADDR_", cind,'_3', sep = ""),
addr4=paste("ADDR_", cind,'_4', sep = ""),
hops="HOPS",stringsAsFactors=FALSE)
)
)
ctry_txns[[ctry]]$txns<-c(list(ctry_txn_df),ctry_txns[[ctry]]$txns)
}else if(!is.na(ctry)&&!is.null(ctry)){
ctry_txn_df=data.frame(
row<-tind,
col<-list(data.frame(
role=paste("ROLE", cind,sep = ""),
ctry=paste("CTRY_", cind,sep = ""),
amount="AMOUNT",
date="DATE",
transNo="COMBINED",
bankId=paste("BANK_ID_", cind, sep = ""),
oParty="OPARTY",
bParty="BPARTY",
trantype="TRANTYPE",
xborder="XBORDER",
riskent="RISKENT",
addr1=paste("ADDR_", cind,'_1', sep = ""),
addr2=paste("ADDR_", cind,'_2', sep = ""),
addr3=paste("ADDR_", cind,'_3', sep = ""),
addr4=paste("ADDR_", cind,'_4', sep = ""),
hops="HOPS",stringsAsFactors=FALSE)
)
)
ctry_obj<-list(ctry_latlng[[ctry]][["lat"]],
ctry_latlng[[ctry]][["lon"]],
list(ctry_txn_df)
)
names(ctry_obj) <- c("lat", "lon","txns")
ctry_txns[[ctry]]<-ctry_obj
}
txn_lat <- c(as.numeric(ctry_latlng[[ctry]][["lat"]]),txn_lat)
txn_lon <- c(as.numeric(ctry_latlng[[ctry]][["lon"]]),txn_lon)
}
txn_lines_lon <- c(txn_lines_lon,list(txn_lon))
txn_lines_lat <- c(txn_lines_lat,list(txn_lat))
}
#Create single object for retrun
obj<-list(txn_lines_lon=txn_lines_lon,
txn_lines_lat=txn_lines_lat,
bankid_list=bankid_list,
ctry_txns=ctry_txns)
print('---create_ctry_latlon_txns- Suparted txns based on country---')
# print(obj)
return(obj)
}
# Finding Fi_Risk risk banks
get_firisk_banks<-function(con,fi_risk_list,bankid_list)
{
print('---get_firisk_banks- Finding Fi_Risk risk banks---')
fi_risk_ctrys<-data.frame()
if(length(fi_risk_list)>0 & length(bankid_list)>0){
fi_cond<-'1=0'
bankids<-""
offset<- 1
# bnames<-names(bankid_list)
# str(bankid_list)
for(id in (offset+1):length(bankid_list)){
bankid<-bankid_list[[id-offset]]
bankids<-paste(bankids,"'",bankid,"',",sep = "")
}
bankid<-as.character(bankid_list[[length(bankid_list)]])
bankids<-paste(bankids,"'",bankid,"'",sep = "")
for(fi in fi_risk_list){
fi_cond<-paste(fi_cond," OR ",fi,"='H' ")
}
firisk_qry<- paste("SELECT SUBSTR(FI_CC,-2), LISTAGG(FI_CC, ',') WITHIN GROUP (ORDER BY FI_CC) from FI_RISK fr where "
,"FI_CC in (",bankids
,") AND (",fi_cond, ") GROUP BY SUBSTR(FI_CC,-2)")
# print(firisk_qry)
fi_risk_ctrys=dbGetQuery(con, firisk_qry)
# print(fi_risk_ctrys)
}
print('---get_firisk_banks- Finding Fi_Risk risk banks done---')
return(fi_risk_ctrys)
}
# Create Polylines to map
create_polylines<-function(lmap,txn_lines_lon,txn_lines_lat){
print('---create_polylines- Create Polylines to map---')
# x<-c(20,65)
# y<-c(77,-18)
# i <- order(x, y); x <- x[i]; y <- y[i]
#
# fromPoint <- list (x = x[1], y = y[1])
# toPoint <- list (x = x[2], y = y[2])
#
# # get coordinates of arrowhead
# arrowhead <- get_arrowhead (fromPoint, toPoint)
# str(arrowhead[,"x"])
# lmap <- lmap%>%addPolylines(lng = y, lat = x,color = "green" ) # arrow line
for(indl in 1:length(txn_lines_lat)){
txn_lon<-txn_lines_lon[[indl]]
txn_lat<-txn_lines_lat[[indl]]
#Create txn polyline
lmap<-lmap%>%addPolylines( lng = unlist(txn_lon), lat = unlist(txn_lat),color = "green",group = "Party_lines" )
for(ind in 1:(length(txn_lat)-1)){
if((txn_lat[[ind]]==txn_lat[[ind+1]]) || (txn_lon[[ind]]==txn_lon[[ind+1]])){
next
}
# algoritham for creating txn polyline arrow head
# Reference: http://gis.stackexchange.com/questions/171904/how-to-display-simple-arrow-on-the-map-in-r-using-leaflet
x<-c(txn_lat[[ind]],txn_lat[[ind+1]])
y<-c(txn_lon[[ind]],txn_lon[[ind+1]])
i <- order(x, y); x <- x[i]; y <- y[i]
fromPoint <- list (x = x[1], y = y[1])
toPoint <- list (x = x[2], y = y[2])
# get coordinates of arrowhead
arrowhead <- get_arrowhead (fromPoint, toPoint)
# Create arrow to polyline
lmap<-lmap%>%addPolylines( lng = arrowhead[,"y"], lat = arrowhead[,"x"],color = "blue", group = "Party_lines" )
}
}
print('---create_polylines- Created Polylines to map---')
return(lmap)
}
#Creating leaflet layers
make_gsp_leaflet <- function(lmap,ctry_risk_list,fi_risk_list,sear_param_list,CALLING_FROM){
print('---make_gsp_leaflet- Creating leaflet layers---start')
#get connection
con=getDbConn();
#Country Risk
subqry<-''
outqry<-''
qry<-NULL
clen=length(ctry_risk_list)
if(clen!=0){
for(cr in 1:clen){
subqry<-paste(subqry," , DECODE(",ctry_risk_list[[cr]],",'H',3,'M',2,'L',1) as risk",cr,sep = "")
outqry<-paste(outqry,"risk",cr,",",sep = "")
}
subqry<-paste("select country_cd as ctry",subqry)
outqry<-substr(outqry,0,nchar(outqry)-1)
outqry<-paste("select ctry as COUNTRY_CD,DECODE(greatest( ",outqry,"),3,'H',2,'M',1,'L') as RISK_FLAG")
qry<-paste(outqry,"from ( ",subqry," from country_risk cr)")
}
if(is.null(qry)){
qry<-Ctry_RISK_QUERY
}
print(qry)
ctryRiskData = dbGetQuery(con, qry);
riskData <- list( "H" = list(), "M" = list() , "L" = list())
for(rind in 1:nrow(ctryRiskData)){
RISK_FLAG <- ctryRiskData[rind,"RISK_FLAG"]
COUNTRY_CD <- ctryRiskData[rind,"COUNTRY_CD"]
if(RISK_FLAG %in% names(riskData)){
riskData[[RISK_FLAG]]<-c(riskData[[RISK_FLAG]],COUNTRY_CD)
}
}
#Country risk factor values
ctryRiskDF=dbGetQuery(con, 'select * from country_risk');
ctryRiskInds<-list()
for(crind in 1:nrow(ctryRiskDF)){
ctryRiskInds[[ctryRiskDF[crind,'COUNTRY_CD']]]<-crind
}
lowCount <- length(riskData[['L']])
medCount <- length(riskData[['M']])
highCount <- length(riskData[['H']])
lowRiskColor <- '#00FF00'
highRiskColor <- '#FF0000'
mediumRiskColor <- '#FF6600'
if (highCount > lowCount && highCount > medCount) {
mediumRiskColor <- '#FFA500';
lowRiskColor <- '#00FF00';
} else if (medCount > lowCount && medCount > highCount) {
lowRiskColor <- '#00FF00';
highRiskColor <- '#FF0000';
} else {
highRiskColor <- '#FF0000';
mediumRiskColor <- '#FFA500';
}
lowRiskCountries <- riskData[['L']]
mediumRiskCountries <- riskData[['M']]
highRiskCountries <- riskData[['H']]
#Converting countries factor to vector
ctry_ve= as.character(levels(countries$iso2)[as.integer(countries$iso2)])
geocol<-c()
ctry_risk_pops<-c()
for(gind in 1:length(ctry_ve)){
ctry<-ctry_ve[[gind]]
gcol<- NA
for(lctry in lowRiskCountries) {
if(ctry %in% lctry){
# print('L')
gcol<-1
# gcol<-lowRiskColor
}
}
for(mctry in mediumRiskCountries ){
if(ctry %in% mctry){
# print('M')
gcol<-2
# gcol<-mediumRiskColor
}
}
for(hctry in highRiskCountries){
if(ctry %in% hctry){
# print('H')
gcol<-3
# gcol<-highRiskColor
}
}
geocol <- c(geocol,gcol)
ctry_pop<-ctry_colo(ctryRiskInds,ctryRiskDF,ctry )
ctry_risk_pops<-c(ctry_risk_pops,ctry_pop)
}
countries$geocol <-geocol
countries$ctry_risk_pops<-ctry_risk_pops
factpal <- colorFactor(palette =c(lowRiskColor,mediumRiskColor,highRiskColor),
domain =countries$category, na.color = 'black')
lmap<-lmap%>%addPolygons(data = countries, smoothFactor = 0.2,
fillColor = ~factpal(countries$geocol), weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.6,group = "ctry_risk",popup = countries$ctry_risk_pops)
#check the call coming from home page or any other
# if home page retrun all txns
if(my.constants.CALLING_FROM$HOME %in% CALLING_FROM ){
# get all txns
txns<-get_all_txns(con = con)
}else{
# Get Transaction Data By Filters
txns<-get_txns(con = con,fi_risk_list,sear_param_list)
}
#set no.of txns to display
updateTextInput(session=getDefaultReactiveDomain(), 'noofwires',value = nrow(txns))
print('--NoofTxns:')
print(nrow(txns))
f_txns<<-txns
if(!is.null(txns)&&is.data.frame(txns)&&nrow(txns)!=0){
#ctryRiskCss <- createCtryLayerRiskCss(riskData);
# Get wise Country Txns, polylines lat&lon and
# list of all banks involed in all txns
obj=create_ctry_latlon_txns(txns)
#Poly lines latitued and langtiude arrays
txn_lines_lon<-obj[["txn_lines_lon"]]
txn_lines_lat<-obj[["txn_lines_lat"]]
# Bank Ids List
bankid_list<-obj[["bankid_list"]]
ctry_txns<-obj[["ctry_txns"]]
fi_risk_ctrys<-get_firisk_banks(con,fi_risk_list,bankid_list)
dbDisconnect(con)
# qpal <- colorQuantile("Blues", countries$gdp_md_est, n = 7)
# lmap<-lmap%>%addLayersControl(baseGroups = c("CartoDB.Positron","Stamen.Toner","OpenStreetMap","Stamen.Watercolor"),
# overlayGroups = c("Party"))
# draw polyline
# lmap <- lmap%>%addPolylines(lng = y, lat = x,color = "green" ) # arrow line
# lmap <- lmap%>%addPolylines(lng=arrowhead[,"y"], lat = arrowhead[,"x"],color = "green" ) # arrow head
# for(indl in 1:length(txn_lines_lat)){
# txn_lon<-txn_lines_lon[[indl]]
# txn_lat<-txn_lines_lat[[indl]]
# lmap<-lmap%>%addPolylines( lng = unlist(txn_lon), lat = unlist(txn_lat),color = "green" )
# # for(ind in 1: length(txn_lat)){
# # txn_lat[ind]
# # lmap<-lmap%>%addPolylines( lng = unlist(txn_lon), lat = unlist(txn_lat),color = "green" )
# # }
# }
# print(txn_lines_lat)
# addPolylines(map = lmap, arrow_data[,"x"], lat = arrow_data[,"y"] )
# str(ve)
# print(lowRiskCountries)
# print('---')
# print(mediumRiskCountries)
# print('---')
# print(highRiskCountries)
# countries$category <- factor(sample.int(5L, nrow(countries), TRUE))
#
# factpal <- colorFactor(topo.colors(5), countries$category)
#
lmap<-create_bank_markers(lmap,fi_risk_ctrys,ctry_txns,txns)
lmap<-create_Markers(lmap,ctry_txns,txns)
lmap<-create_polylines(lmap = lmap,txn_lines_lon,txn_lines_lat )
# lmap <- lmap%>%addPolylines(lng=arrowhead[,"y"], lat = arrowhead[,"x"],color = "green" ) # arrow head
# lmap%>%addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
# color = makeCol(riskData,countries$adm0_a3,lowRiskColor,mediumRiskColor,highRiskColor))
#fitBounds(~min(longitude+5), ~min(latitude), ~max(longitude), ~max(latitude+5))
# gc()
# for(indl in 1:length(txn_lines_lat)){
# # str(indl)
# lmap<-lmap%>%addPolylines( lng = unlist(txn_lines_lon[[indl]]), lat = unlist(txn_lines_lat[[indl]]) )
# }
}#Txns If end
print('---make_gsp_leaflet- Created leaflet layers---end')
return(lmap)
}
ctry_colo <-function(ctryRiskInds,ctryRiskDF,ctry_cd){
# print('--ctry_cd--')
# str(ctry_cd)
# print('--ctry_cd--')
pcont<-NA
if(ctry_cd %in% names(ctryRiskInds)){
ind=ctryRiskInds[[ctry_cd]]
pcont<-paste( "Country : <span>",ctry_cd,"</span><table class='table' style='font-size:10px;'><tr><th>Description</th><th>Risk Level</th></tr>"
, "<tr><td>AMLOC</td><td>"
, ctryRiskDF[ind,'AMLOC']
, "</td></tr>"
, "<tr><td>CIAFACT</td><td>"
, ctryRiskDF[ind,'CIAFACT']
, "</td></tr>"
, "<tr><td>FATCA</td><td>"
, ctryRiskDF[ind,'FATCA']
, "</td></tr>"
, "<tr><td>PLTC</td><td>"
, ctryRiskDF[ind,'PLTC']
, "</td></tr>"
, "<tr><td>PROXIMITY</td><td>"
, ctryRiskDF[ind,'PROXIMITY']
, "</td></tr>"
, "<tr><td>SENTIMENT</td><td>"
, ctryRiskDF[ind,'SENTIMENT']
, "</td></tr>"
, "<tr><td>RISK 7</td><td>"
, ctryRiskDF[ind,'RISK_7']
, "</td></tr>"
, "<tr><td>RISK 8</td><td>"
, ctryRiskDF[ind,'RISK_8']
, "</td></tr>"
, "<tr><td>RISK 9</td><td>"
, ctryRiskDF[ind,'RISK_9']
, "</td></tr>"
, "<tr><td>RISK 10</td><td>"
, ctryRiskDF[ind,'RISK_10']
, "</td></tr>" , "</table>")
}
return(pcont)
}
get_ctry_color<-function(ctry,lowRiskCountries,mediumRiskCountries,highRiskCountries){
gcol<NULL
for(lctry in lowRiskCountries) {
if(ctry %in% lctry){
# print('L')
gcol<-lowRiskColor
}
}
for(mctry in mediumRiskCountries ){
if(ctry %in% mctry){
# print('M')
gcol<-mediumRiskColor
}
}
for(hctry in highRiskCountries){
if(ctry %in% hctry){
# print('H')
gcol<-highRiskColor
}
}
return(gcol)
}
get_arrowhead <- function (fromPoint, toPoint){
# dx,dy = arrow line vector
dx <- toPoint$x - fromPoint$x;
dy <- toPoint$y - fromPoint$y;
# normalize
length <- sqrt(dx * dx + dy * dy);
unitDx <- dx / length;
unitDy <- dy / length;
# increase this to get a larger arrow head
arrowHeadBoxSize = 2;
arrowPoint1 <- list(x = (toPoint$x - unitDx * arrowHeadBoxSize - unitDy * arrowHeadBoxSize),
y = (toPoint$y - unitDy * arrowHeadBoxSize + unitDx * arrowHeadBoxSize));
arrowPoint2 <- list(x = (toPoint$x - unitDx * arrowHeadBoxSize + unitDy * arrowHeadBoxSize),
y = (toPoint$y - unitDy * arrowHeadBoxSize - unitDx * arrowHeadBoxSize));
return( mapply(c, arrowPoint1, toPoint, arrowPoint2) )
}
makeCol<-function(riskData,ctry,lowRiskColor,mediumRiskColor,highRiskColor){
lowRiskCountries <- riskData[['L']]
mediumRiskCountries <- riskData[['M']]
highRiskCountries <- riskData[['H']]
print(lowRiskCountries)
print(ctry)
if(ctry %in% lowRiskCountries[[lrind]]){
return (lowRiskColor)
}
if(ctry %in% mediumRiskCountries[[mrind]]){
return (mediumRiskColor)
}
if(ctry %in% highRiskCountries[[hrind]]){
return (highRiskColor)
}
# for(lrind in 1:length(lowRiskCountries)){
# if(ctry==lowRiskCountries[[lrind]]){
# return (lowRiskColor)
# }
# }
#
# for(mrind in 1:length(mediumRiskCountries)){
# if(ctry==mediumRiskCountries[[mrind]]){
# return (mediumRiskColor)
# }
# }
#
# for(hrind in 1:length(highRiskCountries)){
# if(ctry==highRiskCountries[[hrind]]){
# return (highRiskColor)
# }
# }
}
createCtryLayerRiskCss <- function(riskData){
lowCount <- length(riskData[['L']])
medCount <- length(riskData[['M']])
highCount <- length(riskData[['H']])
lowRiskColor <- '#00FF00'
highRiskColor <- '#FF0000'
mediumRiskColor <- '#FF6600'
if (highCount > lowCount && highCount > medCount) {
mediumRiskColor <- '#FFA500';
lowRiskColor <- '#00FF00';
} else if (medCount > lowCount && medCount > highCount) {
lowRiskColor <- '#00FF00';
highRiskColor <- '#FF0000';
} else {
highRiskColor <- '#FF0000';
mediumRiskColor <- '#FFA500';
}
lowRiskCountries <- riskData[['L']]
mediumRiskCountries <- riskData[['M']]
highRiskCountries <- riskData[['H']]
css = paste("#world_borders::labels {",
"text-name: [name];",
"text-face-name: 'DejaVu Sans Book';",
"text-size: 10;",
"text-label-position-tolerance: 10;",
"text-fill: #000;",
"text-halo-fill: #FFF;",
"text-halo-radius: 0.5;",
"text-dy: -10;",
"text-allow-overlap: false;",
"text-placement: point;",
"text-placement-type: simple;" ,
"}","\n",
"#world_borders{",
"polygon-opacity: 0.6;",
"line-color: #FFF;",
"line-width: 0.5;",
"line-opacity: 1;",
"}"
,"\n",
"#world_borders::labels[zoom<2]{",
"text-size: 7;",
"}")
paste(css ,"#world_borders ")
paste(css,"{polygon-fill:", lowRiskColor,"}","\n")
paste(css,"#world_borders ")
for(mrind in 1:length(mediumRiskCountries)){
paste(css, ",[ iso2 = '" , mediumRiskCountries[[mrind]] , "']")
}
paste(css,"{polygon-fill:", mediumRiskColor,"}","\n")
paste(css,"#world_borders ")
for(hrind in 1:length(highRiskCountries)){
paste(css, ",[ iso2 = '" , highRiskCountries[[hrind]] , "']")
}
paste(css,"{polygon-fill:", highRiskColor,"}","\n")
}
popuptblbody<-function(txn,txns) {
# print('--------start----------')
# print(txn$role)
# print('--------End----------')
# print(txn$col.role)
tblbody<- paste("<tr><td>" , txns[txn$row,txn$role] , "</td><td>"
, txns[txn$row,txn$ctry]
, "</td><td>" , txns[txn$row,txn$amount] , "</td><td>"
, txns[txn$row,txn$date] , "</td><td>" , txns[txn$row,txn$transNo]
, "</td><td>" , txns[txn$row,txn$riskent] , "</td><td>"
, paste(txns[txn$row,txn$addr1],txns[txn$row,txn$addr2],txns[txn$row,txn$addr3],txns[txn$row,txn$addr4])
, "</td><td>" , txns[txn$row,txn$bankId]
, "</td><td>" , txns[txn$row,txn$oParty] , "</td><td>"
, txns[txn$row,txn$bParty] , "</td><td>" , txns[txn$row,txn$trantype]
, "</td><td>" , txns[txn$row,txn$xborder] , "</td><td>"
, txns[txn$row,txn$hops] , "</td></tr>")
return (tblbody)
}
#it is global variable.
#it can be access and modify with in the app.
marker_popups<<-list()
##Create popup content
popupcontent<-function(ct_txns,txns,lon,lat)
{
#print(txns)
tpopup = "<table class='table table-striped' style='font-size:10px;'>
<tr><th>Role</th><th>Country</th><th>Amount</th><th>Date</th>
<th>Transaction Number</th><th>Risk Entity</th><th>Address</th><th>Bank Id</th>
<th>Ordering Party</th><th>Beneficiary Party</th><th>Transaction Type</th><th>Cross Border Flag</th><th>HOPS</th></tr>"
# print('-----------Ctn Start-------------------------')
# str(ct_txns)
# print('------------------------------------')
for(tind in (ct_txns)){
#str(ct_txns[[tind]])
# print('------Start------------------------------')
# str(tind)
# print('------End------------------------------')
tpopup=paste(tpopup,popuptblbody(tind,txns))
}
# print('-----------Ctn End-------------------------')
tpopup=paste(tpopup,"</table><button type='button' class='btn btn-primary'>Download</button>")
popup<-list("lon"=lon,"lat"=lat,"popup"=tpopup)
marker_popups<<-c(marker_popups,list(popup))
return(tpopup)
}
output$networkMap <- renderLeaflet({
my.map.choice <- NULL
if (nchar(input$select_account)>=9){
my.choice <- input$select_account
# my.choice <- "1000001279523910"
try (my.map.choice <- get_node_info(my.choice, "acct_id"), TRUE)
}else if(nchar(input$select_state)>=2){
my.choice <- input$select_state
try (my.map.choice <- get_node_info(my.choice,"state"), TRUE)
}else if(nchar(input$select_zip)>= 5){
my.choice <- input$select_zip
try (my.map.choice <- get_node_info(my.choice, "zipcode"),TRUE)
}else if(nchar(input$select_party)>=6){
# my.choice <- '100025971'
my.choice <- as.character (input$select_party)
try (my.map.choice <- get_party_info(my.choice), TRUE)
} else if(nchar(input$select_email)>= 9){
my.choice <- input$select_email
try(my.map.choice <- get_node_info(my.choice, "email"), TRUE)
}else if(nchar(input$select_phone)>=10){
my.choice <- input$select_phone
try (my.map.choice <- get_node_info(my.choice, "phone"), TRUE)
}else if(nchar(input$select_city)>=3){
my.choice <- input$select_city
try (my.map.choice <- get_node_info(my.choice, "city"), TRUE)
}else if(nchar(input$select_state)>=2){
my.choice <- input$select_state
try (my.map.choice <- get_node_info(my.choice, "state"), TRUE)
}
if(!is.null(my.map.choice)){
if (class(my.map.choice)[1] == "try-error"){
my.map.choice = NULL
}
}
validate(
need (my.map.choice, "Please enter a valid selection")
)
my.party.tracker <<- my.map.choice
make_leaflet (my.map.choice)
})
output$networkMap1 <- renderLeaflet({
my.map.choice <- NULL
# if (nchar(input$select_account)>=9){
# my.choice <- input$select_account
# # my.choice <- "1000001279523910"
# try (my.map.choice <- get_node_info(my.choice, "acct_id"), TRUE)
# }else if(nchar(input$select_state)>=2){
# my.choice <- input$select_state
# try (my.map.choice <- get_node_info(my.choice,"state"), TRUE)
# }else if(nchar(input$select_zip)>= 5){
# my.choice <- input$select_zip
# try (my.map.choice <- get_node_info(my.choice, "zipcode"),TRUE)
# }else if(nchar(input$select_party)>=6){
# # my.choice <- '100025971'
# my.choice <- as.character (input$select_party)
# try (my.map.choice <- get_party_info(my.choice), TRUE)
# } else if(nchar(input$select_email)>= 9){
# my.choice <- input$select_email
# try(my.map.choice <- get_node_info(my.choice, "email"), TRUE)
# }else if(nchar(input$select_phone)>=10){
# my.choice <- input$select_phone
# try (my.map.choice <- get_node_info(my.choice, "phone"), TRUE)
# }else if(nchar(input$select_city)>=3){
# my.choice <- input$select_city
# try (my.map.choice <- get_node_info(my.choice, "city"), TRUE)
# }else if(nchar(input$select_state)>=2){
# my.choice <- input$select_state
# try (my.map.choice <- get_node_info(my.choice, "state"), TRUE)
# }
#
# if(!is.null(my.map.choice)){
# if (class(my.map.choice)[1] == "try-error"){
# my.map.choice = NULL
# }
# }
#
# validate(
# need (my.map.choice, "Please enter a valid selection")
# )
# my.party.tracker <<- my.map.choice
print('Create map from home start')
#make_leaflet (my.map.choice)
lmap<-makeLeafletMap()
fi_risk<-list("RISK_312A","WST","SENTIMENT","UN","IMF","TRA","RISK_7","RISK_8","RISK_9","RISK_10")
# Map creation calling from home
is_home<-TRUE
#Add Layers to map
lmap<-make_gsp_leaflet(lmap,list(),fi_risk,list(),my.constants.CALLING_FROM$HOME)
#Intial hide the polylines
lmap<-lmap%>%hideGroup(group = "Party_lines")
lmap<-lmap%>%addLayersControl(baseGroups = c("CartoDB.Positron","Stamen.Toner","OpenStreetMap","Stamen.Watercolor"),
overlayGroups = c("Party,Party_lines,ctry_risk"))
})
output$filterData <- renderTree({
list(
Global_Risk = structure(sticon="globe",stselected=TRUE,
list(AMLOC="",PLTC="",FATCA="",CIAFACT="",
SENTIMENT="",PROXIMITY="",RISK_7="",RISK_8="",RISK_9="",RISK_10="")),
FI_Risk = structure(sticon="briefcase",
list( RISK_312A="",WST="",SENTIMENT="",UN="",IMF="",TRA="",RISK_7="",RISK_8="",RISK_9="",RISK_10="")
)
)
})
# Hover is ON or OFF status
hover <- reactiveValues(hstat = 'OFF')
observeEvent(input$hover,{
proxy <-leafletProxy(mapId = "networkMap1")
print(ve$vstat)
if(hover$hstat %in% "OFF"){
hover$hstat<- 'ON'
}else{
hover$hstat<- 'OFF'
}
})
# Observe marker mouse over event
observeEvent(input$networkMap1_marker_mouseover,{
marker<-input$networkMap1_marker_mouseover
# print(marker)
# print(marker_popups)
if(hover$hstat %in% "ON"){
for(p in marker_popups){
#print(p)
if(p$lon %in% marker$lng && p$lat %in% marker$lat){
leafletProxy("networkMap1")%>%clearPopups()%>%addPopups(p$lon, p$lat, p$popup)
}
}
}
})
# Vector is ON or OFF status
ve <- reactiveValues(vstat = 'OFF')
observeEvent(input$vector,{
proxy <-leafletProxy(mapId = "networkMap1")
print(ve$vstat)
if(ve$vstat %in% "OFF"){
ve$vstat<- 'ON'
proxy%>%showGroup(group = "Party_lines")
}else{
ve$vstat<- 'OFF'
proxy%>%hideGroup(group = "Party_lines")
}
})
# Click on search button in filters
observeEvent(input$search,{
print('serach--start')
sear_params<-list();
if(nchar(input$ctry)>0){
sear_params[["ctry"]] <- input$ctry
}
if(nchar(input$role)>0){
sear_params[["role"]] <- input$role
}
if(nchar(input$txnno)>0)
{
sear_params[["combined"]] <- input$txnno
}
if(nchar(input$xborder)>0)
{
sear_params[["xborder"]] <- input$xborder
}
if(nchar(input$hops)>0)
{
sear_params[["hops"]] <- input$hops
}
if(nchar(input$highRisk)>0)
{
sear_params[["highRisk"]] <- input$highRisk
}
if(nchar(input$riskent)>0)
{
sear_params[["riskent"]] <- input$riskent
}
Filter_data<- (get_selected(input$filterData))
fi_risk<-list()
ctry_risk<-list()
for(f_data in Filter_data){
attr_val<-''
if(!identical((attributes(f_data)$ancestry),character(0))){
attr_val<-(attributes(f_data)$ancestry)
}
print(attr_val)
if(attr_val %in% "FI_Risk"){
fi_risk<-c(fi_risk,f_data)
}else if("Global_Risk" %in% attr_val ){
ctry_risk<-c(ctry_risk,f_data)
}
}
# print(fi_risk)
proxy <-leafletProxy(mapId = "networkMap1")
# proxy%>%removeMarker(layerId = "ctryMarkers")
proxy%>%clearGroup(group = "Party")
proxy%>%clearGroup(group = "Party_lines")
proxy%>%clearGroup(group = "ctry_risk")
# # Map creation calling from filter
# calling_from<-
# proxy%>%addGeoJSON(countries)
make_gsp_leaflet(proxy,ctry_risk_list = ctry_risk,fi_risk_list = fi_risk,sear_param_list =sear_params,my.constants.CALLING_FROM$FILTER )
# Assain filtered txns to reactive variable
# Then txn_data reactive is automatically called
r_txns$txns<-f_txns
# Assain reactive calling from value as Filter
# Used for diffrentiate txn_data reactive calling from initial/Filteration
r_txns$calling_from=my.constants.CALLING_FROM$FILTER
# print(ve$vstat)
if(ve$vstat %in% "ON"){
proxy%>%showGroup(group = "Party_lines")
}else{
proxy%>%hideGroup(group = "Party_lines")
}
print('serach--end')
# toggleModal(session = getDefaultReactiveDomain(), "filters_modal_window", toggle = "toggle")
})
#SHOW NETWORKS
output$party_popup <- renderVisNetwork({
if (!is.null(input$networkMap_marker_click)){
print (input$networkMap_marker_click$lat)
my.lat <- input$networkMap_marker_click$lat
my.lon <- input$networkMap_marker_click$lng
temp <- select (my.party.tracker, latitude, party) %>%collect()
my.choice <- temp$party[match (my.lat, temp$latitude)]
# my.single.graph <- make_single_graph(my.choice)
make_single_network(my.choice, my.choice)
}
})
output$party_output_geo <- renderVisNetwork({
print ("in geo")
if (!is.null(input$networkMap_marker_click)){
print (input$networkMap_marker_click$lat)
my.lat <- input$networkMap_marker_click$lat
my.lon <- input$networkMap_marker_click$lng
temp <- select (my.party.tracker, latitude, party) %>%collect()
if (nrow(temp) == 1){
my.choice <<- temp$party[match (my.lat, temp$latitude)]
} else if(nrow(temp) <= 10){
my.choice <<- temp$party
}else {
my.choice <<- temp$party[1:10]
}
if (nchar(input$add_party)>=9){
# if ((!is.null(input$doubleClick))){
# add_me <- input$doubleClick
add_me <- input$add_party
# add_me <- "100000035"
# my.choice <- "100000041"
my.lst <- paste(shQuote(add_me), collapse = "," )
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct n.party_id ")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
if (nrow(temp) > 0){
# my.single.graph <- make_single_graph(my.choice) + make_single_graph(add_me)
update <- c(add_me, my.choice)
print (update)
my.choice <<- update
print ("finale")
make_single_network(update, add_me)
}else {
# my.single.graph <- make_single_graph(my.choice)
make_single_network(my.choice, my.choice)
}
}else {
# my.single.graph <- make_single_graph(my.choice)
make_single_network(my.choice, my.choice)
}
}
})
output$party_output_network <- renderVisNetwork({
print ("in party")
if(nchar(input$select_party_network)>=9){
my.single.graph <- NULL
my.choice <- as.character (input$select_party_network)
# my.choice <<- "149027"
# add_me <- "149028"
# add_me <- "149029"
# add_me <- "100000035"
# my.choice <- "100000041"
print (my.choice)
if (nchar(input$add_party)>=9){
# add_me <- input$doubleClick
add_me <- input$add_party
# add_me <- "100000035"
print ("inner")
my.lst <- paste(shQuote(add_me), collapse = "," )
print (my.lst)
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct n.party_id ")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
print (temp)
if (nrow(temp) > 0){
update <- c(add_me, my.choice)
print (update)
my.choice <<- update
print ("finale")
make_single_network(update, add_me)
}else {
# my.single.graph <- make_single_graph(my.choice)
make_single_network(my.choice, my.choice)
}
}else {
# my.single.graph <- make_single_graph(my.choice)
make_single_network(my.choice, my.choice)
}
}
})
#COMMUNITY MAP
output$party_popup_commMap <- renderVisNetwork({
if (!is.null(input$select_comm)){
my.choice <- input$select_comm
my.comm <- filter (all_comm_stats, Community == my.choice)%>% select(Node) %>%collect()
my.lst <- paste(shQuote(my.comm$Node), collapse = "," )
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct n.party_id ")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
# my.single.graph <- make_single_graph(temp$n.party_id)
make_single_network(temp$n.party_id)
}
})
output$commMap <- renderLeaflet({
if (nchar(input$select_comm) > 0 ){
my.choice <- (input$select_comm)
my.comm <- filter (all_comm_stats, Community == my.choice)%>% select(Node) %>%collect()
my.lst <- paste(shQuote(my.comm$Node), collapse = "," )
query <- paste0("MATCH (n:Party) -[r]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct n.party_id ")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
my.comm.net <- get_party_info(temp$n.party_id)
make_leaflet(my.comm.net)
}
})
output$community_stats <-renderDataTable({
datatable(
filter (each_comm_stats, Community_Number == input$select_comm)%>%collect()
,
options = list(#columnDefs = list(list(visible=FALSE, targets=c())),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
), filter = "top",
extensions = 'Buttons', rownames = FALSE
)
})
output$node_community_stats <-renderDataTable({
datatable(
filter (all_comm_stats, Community == input$select_comm)%>%collect(),
options = list(#columnDefs = list(list(visible=FALSE, targets=c())),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,pageLength = 3,
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
),selection = "multiple", filter = "top",
extensions = 'Buttons', rownames = FALSE
)
})
#TABLES
output$party_connections <-renderDataTable({
datatable(
if (!is.null(input$current_node_id)){
temp <- make_single_graph(my.choice)
data.frame (igraph::degree(temp))
# target
},
options = list(#columnDefs = list(list(visible=FALSE, targets=c())),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,pageLength = 5,lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
),
extensions = 'Buttons', rownames = FALSE
)
})
output$party_info <-renderDataTable({
datatable(
if (!is.null(my.choice)){
# print (input$current_node)
drop = c("latitude","longitude")
select (get_party_info(get_acquaintances(my.choice)),-one_of(drop))
}
,
options = list(#columnDefs = list(list(visible=FALSE, targets=c())),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,pageLength = 5,lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
), filter = "top",
extensions = 'Buttons', rownames = FALSE
)
})
party_accounts_input <- function(){
if (!is.null(my.choice)){
# query <- "MATCH p=(n)-[r:HAS_ACCT]->(m) RETURN distinct
# n.party_id, m.acct_id"
# my.choice <- "100653553"
my.lst <- paste(shQuote(get_acquaintances(my.choice)), collapse = "," )
query <- paste0("MATCH (n:Party) -[r:HAS_ACCT]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
n.party_id, m.acct_id,
r.fin_agr_cd, r.acct_rel, r.acct_opn_dt")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
if (nrow (temp) >0){
party_table <- unique(setDT(temp)[,lapply(.SD, na.omit), by = n.party_id])
colnames(party_table) <- c ("Party ID", "Account Number", "Fin Agr Cd","Acct Rel","Date Opened")
party_table
}
}
}
output$party_accounts <-renderDataTable({
datatable(
party_accounts_input(),
options = list(
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,pageLength = 5,lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
), filter = "top",
extensions = 'Buttons', rownames = FALSE
)
})
local_statistics_input <- function() {
if (!is.null(my.choice)){
get_network_stats(make_single_graph(get_acquaintances(my.choice)))
}
}
output$party_stats <-renderDataTable({
datatable(
local_statistics_input(),
options = list(#columnDefs = list(list(visible=FALSE, targets=c())),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,pageLength = 5,
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
), filter = "top",
extensions = 'Buttons', rownames = FALSE
)
})
trans_info_input <- function(){
if (!is.null(my.choice)){
my.lst <- paste(shQuote(get_acquaintances(my.choice)), collapse = "," )
query <- paste0("MATCH (n:Party) -[r:HAS_ACCT]->(m) WHERE n.party_id IN [", my.lst, "]", " return distinct
n.party_id, m.acct_id")
temp <- rbindlist (cypherToList(graph, query), fill = TRUE)
if (nrow(temp) > 0 ){
my.lst <- paste(shQuote(temp$m.acct_id), collapse = "," )
query <- paste0("MATCH (n:Account)<-[r]->(m) WHERE n.acct_id IN [", my.lst, "]", " return distinct
m.party_id,n.acct_id,
r.txn_typ, r.txn_dt,
m.txn_amt")
temp2 <- rbindlist (cypherToList(graph, query), fill = TRUE)
acct_table <- unique(setDT(temp2)[,lapply(.SD, na.omit), by = n.acct_id])
# acct_table$Date <- as.Date(acct_table$Date, "%Y")
colnames(acct_table)[1:2] <- c ("Account Number", "Party ID")
# colnames(acct_table) <- c ("Account Number", "Party ID", "Fin Agr Cd","Transaction Type", "Date", "Amount")
acct_table
}
}
}
output$party_trans <-renderDataTable({
datatable(
# unique(party_accounts[apply(party_accounts, 1, function(r) any (r == input$current_node_id)),])
trans_info_input(),
options = list(#columnDefs = list(list(visible=FALSE, targets=c())),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}"),
searchHighlight = TRUE,pageLength = 5,lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
dom = 'Bfrltip', buttons = c('copy', 'excel', 'pdf', 'print', 'colvis')
), filter = "top",
extensions = 'Buttons', rownames = FALSE
)
})
shinyjs::disable("sar_geo")
shinyjs::disable("sar_party")
observe({
# if (!is.null(input$current_node_id)){
# shinyjs::enable("sar_party")
# }
if (!is.null(input$networkMap_marker_click)){
#print(htmlOutput("party_window"))
#showModal(ui = htmlOutput("party_window"), session = getDefaultReactiveDomain())
toggleModal(session = getDefaultReactiveDomain(), "party_window", toggle = "toggle")
shinyjs::enable("sar_geo")
}
if(!is.null(input$commMap_marker_click) ){
toggleModal(session = getDefaultReactiveDomain(), "party_window_comm", toggle = "toggle")
shinyjs::enable("sar_geo")
}
})
# SAR download handlers
output$sar_geo <- downloadHandler(
# filename = function (){paste0(input$current_node_id,'.xlsx')},
filename = function (){paste0(my.party.tracker$party[1],'.zip')},
content = function(file){
wb <- XLConnect::loadWorkbook(file = paste0(my.party.tracker$party[1],'.xlsx'), create = TRUE)
XLConnect::createSheet(wb, name = "Party Information")
XLConnect::writeWorksheet(wb, as.data.frame (my.party.tracker)) #
XLConnect::saveWorkbook(wb)
# createSheet(wb, name = "Party to Accounts")
# writeWorksheet(wb, select(my_data, party, Account, name, SSN, FIN_AGR_CD, ACCT_REL, ACCT_OPN_DT )%>%
# filter(party == my.map.choice$party[1]), sheet = "Party to Accounts")
# saveWorkbook(wb)
# createSheet(wb, name = "Transactions")
# writeWorksheet(wb,filter(my_data, party == my.map.choice$party[1] | Account == my.map.choice$party[1] | email == my.map.choice$party[1] |
# city == my.map.choice$party[1] | zip == my.map.choice$party[1] | street == my.map.choice$party[1] |
# phone == my.map.choice$party[1] | state == my.map.choice$party[1]), sheet = "Transactions")
# saveWorkbook(wb)
# createSheet(wb, name = "Network Statistics")
# writeWorksheet(wb, get_network_stats(make_single_graph(my.map.choice$party[1]))[match(my.map.choice$party[1],get_network_stats(make_single_graph(my.map.choice$party[1]))$Node),], sheet = "Network Statistics") #
# saveWorkbook(wb)
# createSheet(wb, name = "Network Connections")
# writeWorksheet(wb, get_nodes_in_network(my.map.choice$party[1])[1], sheet = "Network Connections") #
# saveWorkbook(wb)
# appendWorksheet(wb, get_nodes_in_network(my.map.choice$party[1])[2], sheet = "Network Connections") #
# saveWorkbook(wb)
visSave(single_network(make_single_graph(my.party.tracker$party[1]), my.party.tracker$party[1] , NULL, FALSE),
file = paste0(my.map.choice$party[1],'.html'))
zip(zipfile=paste0(my.party.tracker$party[1],'.zip'), files=Sys.glob(paste0(my.party.tracker$party[1],'.*')))
file.copy(paste0(my.party.tracker$party[1],'.zip'), file)
if (length(Sys.glob(paste0(my.party.tracker$party[1],'.*')))>0){
file.remove(Sys.glob(paste0(my.party.tracker$party[1],'.*')))
}
}
)
# output$tsChart <- renderPlot({
# x <- as.numeric(strsplit('2,4,5,3,1,6,9', split = ",")[[1]])
# print(x)
# ts.obj <- ts(x)
# lowess.obj <- lowess(ts.obj, f = 10)
# plot.ts(x, main = "Sample Time Series", xlab = "Time")
# # points(x)
# # lines(lowess.obj$y, col = "red")
# # legend("top", legend = "Loess Smoother", col = "red", lty = 1)
# })
r_txns<-reactiveValues(txns=data.frame(),calling_from=my.constants.CALLING_FROM$HOME)
txn_data <- reactive({
print(' #### Reactive')
print(nrow(r_txns$txns))
# Declare empty time series data frame with X&Y coordnate values NAN
# if no data found need to retrun empty data frame like, Otherwise throughs error
times_df<-data.frame(NaN,row.names = NaN)
rtxns<-data.frame()
if( r_txns$calling_from %in% my.constants.CALLING_FROM$HOME
&& nrow(f_txns)>0 )
{
rtxns<-f_txns
}
else if(r_txns$calling_from %in% my.constants.CALLING_FROM$FILTER
&& nrow(r_txns$txns)>0 )
{
rtxns<-r_txns$txns
}
else
{
return(times_df)
}
txn_dates<-list()
for(tind in 1:nrow(rtxns))
{
COMBINED<-rtxns[tind,'COMBINED']
COMBINED<-substr(COMBINED, 0, 8)
if(COMBINED %in% names(txn_dates))
{
amount<-txn_dates[[COMBINED]]
t_amount<-rtxns[tind,'AMOUNT']
if(!is.null(t_amount)&&!is.na(t_amount)){
amount<- amount+(rtxns[tind,'AMOUNT'])
txn_dates[[COMBINED]]<-amount
}
}else{
txn_dates[[COMBINED]]<-c(rtxns[tind,'AMOUNT'])
}
}
amounts_y<-c()
dates_x<-c()
for(txnd in names(txn_dates) )
{
dates_x<-c(dates_x,txnd)
print(txn_dates[[txnd]])
amounts_y<-c(amounts_y,txn_dates[[txnd]])
}
times_df<-data.frame(amounts_y,row.names=as.Date(dates_x,'%Y%m%d'))
return(times_df)
})
observeEvent(input$tsdygraph_date_window,{
startDate <- input$tsdygraph_date_window[[1]]
endDate <- input$tsdygraph_date_window[[2]]
# print(value1)
# print(value2)
Filter_data<- (get_selected(input$filterData))
fi_risk<-list()
ctry_risk<-list()
for(f_data in Filter_data){
attr_val<-''
if(!identical((attributes(f_data)$ancestry),character(0))){
attr_val<-(attributes(f_data)$ancestry)
}
print(attr_val)
if(attr_val %in% "FI_Risk"){
fi_risk<-c(fi_risk,f_data)
}else if("Global_Risk" %in% attr_val ){
ctry_risk<-c(ctry_risk,f_data)
}
}
syear<-as.numeric(format(as.Date(startDate),format='%Y'))
eyear<-as.numeric(format(as.Date(endDate),format='%Y'))
print(syear)
print(eyear)
txns<-data.frame()
for(ind in 1:nrow(f_txns)){
COMBINED<-f_txns[ind,'COMBINED']
ryear<-as.numeric(substr(COMBINED,0,4))
print(ryear)
if(syear<=ryear && eyear>=ryear){
print(TRUE)
txns<-rbind(txns,f_txns[ind,])
}else{
print(FALSE)
}
}
print(nrow(txns))
if(!is.null(txns)&&is.data.frame(txns)&&nrow(txns)!=0){
# Get wise Country Txns, polylines lat&lon and
# list of all banks involed in all txns
obj=create_ctry_latlon_txns(txns)
#Poly lines latitued and langtiude arrays
txn_lines_lon<-obj[["txn_lines_lon"]]
txn_lines_lat<-obj[["txn_lines_lat"]]
# Bank Ids List
bankid_list<-obj[["bankid_list"]]
ctry_txns<-obj[["ctry_txns"]]
#get connection
con=getDbConn();
fi_risk_ctrys<-get_firisk_banks(con,fi_risk,bankid_list)
dbDisconnect(con)
proxy <-leafletProxy(mapId = "networkMap1")
proxy%>%clearGroup(group = "Party")
proxy%>%clearGroup(group = "Party_lines")
# proxy%>%clearGroup(group = "ctry_risk")
proxy<-create_bank_markers(proxy,fi_risk_ctrys,ctry_txns,txns)
proxy<-create_Markers(proxy,ctry_txns,txns)
proxy<-create_polylines(lmap = proxy,txn_lines_lon,txn_lines_lat )
}
})
output$tsdygraph<-renderDygraph({
# make_ts_chart(f_txns)
print(' #### renderDygraph')
update_ts_chart()
})
zdy<-function(dates){
print("xmin")
}
update_ts_chart<-function()
{
print(' #### update_ts_chart')
ts<-txn_data()
d<-dygraph(ts,main = "Predicted Amounts/Month",xlab = 'Transaction On',ylab = 'Total Amount')%>%
dyRangeSelector()%>%dyOptions(retainDateWindow = TRUE)
# %>%dyCallbacks(zoomCallback=JS("function(xmin, xmax, options) {
# console.log(xmin);
# }"))
}
## Create a Time series Chart ##
make_ts_chart<-function(txns){
txn_dates<-list()
for(tind in 1:nrow(txns))
{
COMBINED<-txns[tind,'COMBINED']
COMBINED<-substr(COMBINED, 0, 8)
if(COMBINED %in% names(txn_dates))
{
amount<-txn_dates[[COMBINED]]
t_amount<-txns[tind,'AMOUNT']
if(!is.null(t_amount)&&!is.na(t_amount)){
amount<- amount+(txns[tind,'AMOUNT'])
txn_dates[[COMBINED]]<-amount
}
}else{
txn_dates[[COMBINED]]<-c(txns[tind,'AMOUNT'])
}
}
amounts_y<-c()
dates_x<-c()
for(txnd in names(txn_dates) )
{
dates_x<-c(dates_x,txnd)
print(txn_dates[[txnd]])
amounts_y<-c(amounts_y,txn_dates[[txnd]])
}
times_df<-data.frame(amounts_y,row.names=as.Date(dates_x,'%Y%m%d'))
dygraph(times_df, main = "Predicted Amounts/Month",xlab = 'Transaction On',ylab = 'Total Amount')%>%dyRangeSelector()%>%dyOptions(retainDateWindow = TRUE)
}
output$tsdygraph1<-renderDygraph({
# dygraph(list(lwr=as.Date(c('2017-01-20','2017-02-23','2017-03-12','2017-04-05','2017-06-29')),
# fit=c(20,39,38,29,38)), main = "Predicted Deaths/Month")
#print(nhtemp)
str(nhtemp)
jun<-c(10,29,39,12,28)
apr<-c(20,49,35,22,58)
may<-c(44,32,69,42,23)
aug<-c(16,49,33,52,48)
oct<-c(50,39,59,42,22)
sep<-c(20,19,32,62,38)
# rs1<-c(as.Date('2016-01-07'),as.Date('2016-01-08'))
rs<-c(as.Date('2016-01-07'),as.Date('2016-01-09'),as.Date('2016-01-10'),
as.Date('2016-01-11'),as.Date('2016-01-23'),as.Date('2016-01-25'),
as.Date('2016-02-07'),as.Date('2016-02-19'),as.Date('2016-03-08'),
as.Date('2016-04-21'),as.Date('2016-04-23'),as.Date('2016-04-24'),
as.Date('2016-04-25'),as.Date('2016-04-26'),as.Date('2016-04-27'),
as.Date('2016-05-03'),as.Date('2016-05-21'),as.Date('2016-05-26'),
as.Date('2016-06-25'),as.Date('2016-06-27'),as.Date('2016-06-28'),
as.Date('2016-07-07'),as.Date('2016-07-21'),as.Date('2016-07-29'),
as.Date('2016-08-20'),as.Date('2016-08-23'),as.Date('2016-08-27'),
as.Date('2016-09-02'),as.Date('2016-09-15'),as.Date('2016-09-20'),
as.Date('2016-09-21'),as.Date('2016-09-25'),as.Date('2016-09-26'))
datadf<-data.frame(c(20,38,25,38,49,59,49,89,55,75,26,
20,38,25,38,49,59,49,89,55,75,26,
20,38,25,38,49,59,49,89,55,75,26),
row.names=rs)
# print(datadf)
dygraph(datadf, main = "Predicted Deaths/Month")%>%dyRangeSelector()
})
barchart_txns <- reactive({
print(' #### Reactive')
print(nrow(r_txns$txns))
# Declare empty time series data frame with X&Y coordnate values NAN
# if no data found need to retrun empty data frame like, Otherwise throughs error
times_df<-data.frame(NaN,row.names = NaN)
rtxns<-data.frame()
if( r_txns$calling_from %in% my.constants.CALLING_FROM$HOME
&& nrow(f_txns)>0 )
{
rtxns<-f_txns
}
else if(r_txns$calling_from %in% my.constants.CALLING_FROM$FILTER
&& nrow(r_txns$txns)>0 )
{
rtxns<-r_txns$txns
}
else
{
return(times_df)
}
txn_dates<-list()
txn_comb<-c()
for(tind in 1:nrow(rtxns))
{
COMBINED_STR<-rtxns[tind,'COMBINED']
COMBINED<-substr(COMBINED_STR, 0, 6)
print(COMBINED)
if(COMBINED %in% names(txn_dates))
{
amount<-txn_dates[[COMBINED]]
t_amount<-rtxns[tind,'AMOUNT']
if(!is.null(t_amount)&&!is.na(t_amount)){
amount<- as.numeric(amount)+as.numeric(rtxns[tind,'AMOUNT'])
txn_dates[[COMBINED]]<-as.numeric(amount)
}
}else{
txn_dates[[COMBINED]]<-c(rtxns[tind,'AMOUNT'])
txn_comb[[COMBINED]]<-substr(COMBINED_STR, 0, 8)
}
}
amounts_y<-c()
dates_x<-c()
for(txnd in names(txn_dates) )
{
dates_x<-c(dates_x,txnd)
print(txn_dates[[txnd]])
amounts_y<-c(amounts_y,txn_dates[[txnd]])
}
txn_comb_dt<-as.Date(txn_comb,'%Y%m%d')
print('convertion dates')
# times_df<-data.frame(amount=as.numeric(amounts_y),dates=as.Date(dates_x,'%Y%m%d'))
times_df<-data.frame(amount=as.numeric(amounts_y),dates=dates_x)
times_df$months <- month.abb[as.numeric(format(txn_comb_dt, format = "%m"))]
times_df$years <- as.numeric(format(txn_comb_dt, format = "%Y"))
return(times_df)
})
output$barchart<-renderPlot({
mydates<-barchart_txns()
print('barchart')
print(mydates)
# mydates$months <- month.abb[as.numeric(format(mydates[,2], format = "%m"))]
# months <- c()
# years <- c()
# for(dt in mydates$dates){
# months<-c(months,substr(dt,5,6))
# years<-c(years,substr(dt,0,4))
# }
# mydates$months <- month.abb[months]
# mydates$years <- years
# print(mydates)
# mydates$years <- as.numeric(format(mydates[,2], format = "%Y"))
# print(mydates)
# mydates$Months <- factor(mydates$Months, levels = paste(month.abb, c(rep(12, 12), 13)))
ggplot(mydates, aes(x = years,y=amount,fill=months,label=amount)) + geom_bar(stat = "identity") + geom_line(aes(group=1)) + scale_x_continuous(breaks =seq(min(mydates$years),max(mydates$years),1) )+ geom_text(size = 3, position = position_stack(vjust = 0.5))
})
plotlychart_txns <- reactive({
print(' #### plotlychart_txns ###')
# Declare empty time series data frame with X&Y coordnate values NAN
# if no data found need to retrun empty data frame like, Otherwise throughs error
times_df<-data.frame(NaN,row.names = NaN)
rtxns<-data.frame()
if( r_txns$calling_from %in% my.constants.CALLING_FROM$HOME
&& nrow(f_txns)>0 )
{
rtxns<-f_txns
}
else if(r_txns$calling_from %in% my.constants.CALLING_FROM$FILTER
&& nrow(r_txns$txns)>0 )
{
rtxns<-r_txns$txns
}
else
{
return(times_df)
}
txn_dates<-list()
txn_comb<-c()
for(tind in 1:nrow(rtxns))
{
COMBINED_STR<-rtxns[tind,'COMBINED']
COMBINED<-substr(COMBINED_STR, 0, 8)
print(COMBINED)
if(COMBINED %in% names(txn_dates))
{
amount<-txn_dates[[COMBINED]]
t_amount<-rtxns[tind,'AMOUNT']
if(!is.null(t_amount)&&!is.na(t_amount)){
amount<- as.numeric(amount)+as.numeric(rtxns[tind,'AMOUNT'])
txn_dates[[COMBINED]]<-as.numeric(amount)
}
}else{
txn_dates[[COMBINED]]<-c(rtxns[tind,'AMOUNT'])
# txn_comb[[COMBINED]]<-substr(COMBINED_STR, 0, 8)
}
}
amounts_y<-c()
dates_x<-c()
for(txnd in names(txn_dates) )
{
dates_x<-c(dates_x,txnd)
print(txn_dates[[txnd]])
amounts_y<-c(amounts_y,txn_dates[[txnd]])
}
txn_comb_dt<-as.Date(dates_x,'%Y%m%d')
print('convertion dates')
# times_df<-data.frame(amount=as.numeric(amounts_y),dates=as.Date(dates_x,'%Y%m%d'))
times_df<-data.frame(amount=as.numeric(amounts_y),dates=txn_comb_dt)
# times_df$months <- month.abb[as.numeric(format(txn_comb_dt, format = "%m"))]
# times_df$years <- as.numeric(format(txn_comb_dt, format = "%Y"))
return(times_df)
})
reactive({
event.data <- event_data(event = "plotly_event",source = "source")
print(event.data)
})
#Render plotly bar chart
output$plotlybarchart<-renderPlotly({
# x <-as.Date( c('1995-02-03', '1996-02-03', '1997-02-03', '1998-02-03', '1999-02-03', '2000-02-03', '2001-02-03', '2002-02-03', '2003-02-03',
# '2004-02-03', '2005-02-03', '2006-02-03', '2007-02-03', '2008-02-03', '2009-02-03', '2010-02-03', '2011-02-03', '2012-02-03'))
# roW <- c(219, 146, 112, 127, 124, 180, 236, 207, 236, 263, 350, 430, 474, 526, 488, 537, 500, 439)
# China <- c(16, 13, 10, 11, 28, 37, 43, 55, 56, 88, 105, 156, 270, 299, 340, 403, 549, 499)
# data <- data.frame(x, roW, China)
data<-plotlychart_txns()
# plotlychart_reactive()
plot_ly(data, x = ~dates,source = "source", y = ~amount, type = 'bar', name = 'Rest of the World',
marker = list(color = 'rgb(55, 83, 109)')) %>%
# add_lines(data = data, x = ~dates, y = ~amount, mode = "lines", line = list(width = 1))%>%
# add_trace(y = ~China, name = 'China', marker = list(color = 'rgb(26, 118, 255)')) %>%
layout(dragmode = "drag",title = 'US Export of Plastic Scrap',
xaxis = list(
title = "",
tickfont = list(
size = 14,
color = 'rgb(107, 107, 107)'),
rangeslider = list(type = "date",title="Range")),
yaxis = list(
title = 'USD (millions)',
titlefont = list(
size = 16,
color = 'rgb(107, 107, 107)'),
tickfont = list(
size = 14,
color = 'rgb(107, 107, 107)')),
legend = list(x = 0, y = 1, bgcolor = 'rgba(255, 255, 255, 0)', bordercolor = 'rgba(255, 255, 255, 0)'))
})
output$hover <- renderPrint({
print("Hover events appear here (unhover to clear")
d <- event_data("plotly_hover",source = "source")
if (is.null(d)) "Hover events appear here (unhover to clear)" else d
})
output$click <- renderPrint({
print("plotly_click")
d <- event_data("plotly_click" ,source = "source")
if (is.null(d)) "Click events appear here (double-click to clear)" else d
})
output$brush <- renderPrint({
print("plotly_selected")
d <- event_data("plotly_selected",source = "source")
if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else{
print(d)
print("plotly_selected")
}
})
output$zoom <- renderPrint({
print("plotly_relayout")
d <- event_data("plotly_relayout",source = "source")
if (is.null(d)) "Relayout (i.e., zoom) events appear here" else d
})
## UI Elements rendering ##
output$roles<-renderUI({
print('---making role select box---start')
#get connection
con=getDbConn()
roles<-dbGetQuery(conn = con," select distinct ROLE from AML_BANK_ROLE ")
selectInput(inputId = "role",label = NULL,c(ROLE="",roles$ROLE),selected = "")
})
output$hop<-renderUI({
con=getDbConn()
hops<-dbGetQuery(conn = con," select distinct HOPS from AML_WIRE_TRAN_REPORTING ")
selectInput(inputId ="hops",label = NULL,c(HOPS="",hops$HOPS), selected="")
})
output$riskenties<-renderUI({
con=getDbConn()
riskenties<-dbGetQuery(conn = con," select distinct RISKENT from AML_WIRE_TRAN_REPORTING ")
selectInput(inputId ="riskent",label = NULL,c(RISKENT="",riskenties$RISKENT), selected="")
})
}
ui <- dashboardPage (skin = "blue",
dashboardHeader(title = "Party Network GEO"),
dashboardSidebar(disable = FALSE,
# width = 175,
sidebarMenu(
menuItem("Geo Network", tabName = "geo", icon = icon("globe")),
menuItem("GeoSpatial Network", tabName = "GeoSpatial", icon = icon("globe")),
menuItem("Party Network", tabName = "party", icon = icon ("connectdevelop")),
menuItem("Community Detection", tabName = "community", icon = icon ("group")),
menuItem("Anomaly Detection", tabName = "anomaly", icon = icon("flash")),
menuItem("Time Series Analysis", tabName = "time_series", icon = icon("line-chart")),
menuItem("SAR", tabName = "sar", icon = icon("flag")),
# # menuItem("Network", tabName = "network",icon = icon("dashboard"))
sidebarSearchForm(textId = "searchText", buttonId = "searchButton", label = "Search...")
)),
dashboardBody(
shinyjs::useShinyjs(),
tags$head(
tags$style(HTML('
/* logo */
.skin-blue .main-header .logo {
background-color: #000080;
}
/* logo when hovered */
.skin-blue .main-header .logo:hover {
background-color: #87ceeb;
}
/* navbar (rest of the header) */
.skin-blue .main-header .navbar {
background-color: #6495ed;
}
/* main sidebar */
.skin-blue .main-sidebar {
background-color: #FFFFFF;
}
/* active selected tab in the sidebarmenu */
.skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
background-color: #FFFFFF;
}
/* other links in the sidebarmenu */
.skin-blue .main-sidebar .sidebar .sidebar-menu a{
background-color: #6495ed;
color: #000000;
}
/* other links in the sidebarmenu when hovered */
.skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
background-color: #87ceeb;
}
/* toggle button when hovered */
.skin-blue .main-header .navbar .sidebar-toggle:hover{
background-color: #87ceeb;
}
')),
# tags$style(HTML('#view_party_network{background-color:orange}')),
# tags$style(type='text/css', "#view_party_network { margin-bottom: 00px;}"),
# tags$style(HTML('#view_community_network{background-color:orange}')),
# tags$style(type='text/css', "#view_community_network { margin-bottom: 30px;}"),
tags$style(HTML('#resetParty{background-color:orange}')),
tags$style(type='text/css', "#resetParty { margin-bottom: 0px;}"),
tags$style(HTML('#sar_geo{background-color:gold}')),
tags$style(type='text/css', "#sar_geo { margin-bottom: 3px;}"),
tags$style(HTML('#sar_party{background-color:gold}')),
tags$style(type='text/css', "#sar_party { margin-bottom: 3px;}"),
tags$style(type='text/css',
"
.leaflet-popup-content{
width:100% !important;
height: 300px;
overflow-y: scroll;
}
.leaflet-popup-content-wrapper{
padding:10px 30px;
}
div.vis-network div.vis-navigation div.vis-button:hover {
box-shadow: none !important;
}
div.vis-network div.vis-navigation div.vis-button:active {
box-shadow: none;
}
div.vis-network div.vis-navigation div.vis-button.vis-down{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-down:before{
font-family: FontAwesome;
font-style: normal;
content: '\\f0ab';
font-size:30px;
color: rgb(65, 118, 167);
}
div.vis-network div.vis-navigation div.vis-button.vis-left{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-left:before{
font-family: FontAwesome;
font-style: normal;
content: '\\f0a8';
font-size:30px;
color: rgb(65, 118, 167);
}
div.vis-network div.vis-navigation div.vis-button.vis-right{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-right:before{
font-family: FontAwesome;
font-style: normal;
font-size:30px;
content: '\\f0a9';
color: rgb(65, 118, 167);
}
div.vis-network div.vis-navigation div.vis-button.vis-up{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-up:before{
font-family: FontAwesome;
font-style: normal;
font-size:30px;
content: '\\f0aa';
color: rgb(65, 118, 167);
}
div.vis-network div.vis-navigation div.vis-button.vis-zoomExtends{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-zoomExtends:before{
font-family: FontAwesome;
font-style: normal;
content: '\\f0b2';
font-size:30px;
color: rgb(65, 118, 167);
}
div.vis-network div.vis-navigation div.vis-button.vis-zoomIn{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-zoomIn:before{
font-family: FontAwesome;
font-style: normal;
content: '\\f055';
font-size:30px;
color: rgb(65, 118, 167);
}
div.vis-network div.vis-navigation div.vis-button.vis-zoomOut{
background-image:none;
}
div.vis-network div.vis-navigation div.vis-button.vis-zoomOut:before{
font-family: FontAwesome;
font-style: normal;
content: '\\f056';
font-size:30px;
color: rgb(65, 118, 167);
}
")
),
tabItems(
# tabItem(
# tabName = "community",
# div (style = "display:inline-block; width:250px",
# selectInput("select_comm", label = h4("Select by Community ID"),
# choices = c("", 1:nrow(each_comm_stats)), selected = NULL, multiple = FALSE, selectize = TRUE)),
# leafletOutput("commMap", height = "500px", width = "100%"),
# box(
# title = "Community Level Statistics", collapsible = TRUE,status = "info", solidHeader = TRUE,
# dataTableOutput("community_stats")
# ),
#
# box(
# title = "Community Membership", collapsible = TRUE,status = "primary", solidHeader = TRUE, collapsed = FALSE,
# dataTableOutput("node_community_stats")
# ),
# actionButton("view_community_network","View Network for Selected Community"),
# bsModal("party_window_comm", "Selected Community","view_community_network",visNetworkOutput("party_popup_commMap"), size = "large"),
# # downloadButton("downloadPlot","Download"))
# bsPopover("communityMap", "Selected Community", trigger = "click", content = paste("View Community Network"))
# ),
tabItem(
tabName = "party",
fluidRow(
column(
width = 2,
div (style = "display:inline-block; width:100px",
textInput("select_party_network", label = NULL,
placeholder = "Party ID", value = '')),
# actionButton("resetParty","Reset Party Network"),
div (style = "display:inline-block; width:100px",
textInput("add_party", label = NULL,
placeholder = "Add Party", value = '')),
# actionButton("resetParty","Reset Party Network"),
downloadButton("sar_party","SAR"),
div (style = "width:200px; ",
checkboxInput("stats", label = "Local Statistics")),
div (style = " width:200px; ",
checkboxInput("trans_info", label = "Transactions")),
div (style = " width:200px; ",
checkboxInput("accounts", label = "Party to Accounts")),
div (style = "width:200px; ",
checkboxInput("party_info", label = "Party Information", value = FALSE))
),
# div (style = "display:inline-block; width:200px; float:right",
# checkboxInput("connections", label = "Party Connections")),
# p("Reset Investigation by double-clicking the initial Party ID"),
# visNetworkOutput("party_output_geo", height = "750px", width = "100%")
# fluidPage(
column(
width = 9,
conditionalPanel(
condition = "input.select_party_network == '' ",
# box(
visNetworkOutput("party_output_geo", width = "100%", height = 500)#,
# width = 9
# )
),
conditionalPanel(
condition = "input.select_party_network != '' ",
# box(
visNetworkOutput("party_output_network", width = "100%", height = 500)#,
# width = 9
# )
)
)
),
# conditionalPanel(
# condition = "input.connections == true",
# box(title = "Party Connections", collapsible = TRUE,status = "primary",
# dataTableOutput("party_connections")
# )
# ),
conditionalPanel(
condition = "input.accounts == true",
box(title = "Party to Accounts", collapsible = TRUE, status = "warning",
dataTableOutput("party_accounts")
)
),
conditionalPanel(
condition = "input.party_info == true",
box (title = "Party Information", collapsible = TRUE, status = "danger",
dataTableOutput("party_info")
)
),
conditionalPanel(
condition = "input.trans_info == true",
box(title = "Transactions", collapsible = TRUE, status = "warning",
dataTableOutput("party_trans")
)
),
conditionalPanel(
condition = "input.stats == true",
box (title = "Local Statistics", status = "primary", collapsible = TRUE,
dataTableOutput("party_stats")
)
)
),
tabItem(
tabName = "geo",
downloadButton("sar_geo","SAR"),
div (style = "display:inline-block; width:150px",
textInput("select_party", label = NULL,#label = h4("Party ID"),
placeholder = "Party ID")),
div (style = "display:inline-block; width:200px",
textInput("select_account", label = NULL, # label = h4("Account Number"),
placeholder = "Enter Account Number")),
div (style = "display:inline-block; width:300px",
textInput("select_email", label = NULL, #label = h4("Email Address"),
placeholder = "Enter email address")),
div (style = "display:inline-block; width:200px",
textInput("select_phone", label = NULL, #label = h4("Phone Number"),
placeholder = "Enter phone number")),
div (style = "display:inline-block; width:200px",
textInput("select_state", label = NULL, #label = h4("State/Territory"),
placeholder = "Enter State")),
div (style = "display:inline-block; width:250px",
textInput("select_city", label = NULL, #label = h4("Select by City (within State)"),
placeholder = "Enter City")),
div (style = "display:inline-block; width:150px",
textInput("select_zip", label = NULL, #label = h4("Zipcode"),
placeholder = "Enter zipcode")),
leafletOutput("networkMap", height = "850px", width = "100%"),
div (style = "display:inline-block; width:150px; float:right",
actionButton("view_party_network","View Network for Selected Party")),
bsModal("party_window", "Selected Party","view_party_network",visNetworkOutput("party_popup"), size = "large"),
bsPopover("networkMap", "Selected Party", trigger = "click", content = paste("View Party Network"))
),
tabItem(
tabName = "GeoSpatial",
downloadButton("geosp_sar_geo","SAR"),
# div (style = "display:inline-block; width:150px",
# textInput("geosp_select_party", label = NULL,#label = h4("Party ID"),
# placeholder = "Party ID")),
# div (style = "display:inline-block; width:200px",
# textInput("geosp_select_account", label = NULL, # label = h4("Account Number"),
# placeholder = "Enter Account Number")),
# div (style = "display:inline-block; width:300px",
# textInput("geosp_select_email", label = NULL, #label = h4("Email Address"),
# placeholder = "Enter email address")),
# div (style = "display:inline-block; width:200px",
# textInput("geosp_select_phone", label = NULL, #label = h4("Phone Number"),
# placeholder = "Enter phone number")),
# div (style = "display:inline-block; width:200px",
# textInput("geosp_select_state", label = NULL, #label = h4("State/Territory"),
# placeholder = "Enter State")),
# div (style = "display:inline-block; width:250px",
# textInput("geosp_select_city", label = NULL, #label = h4("Select by City (within State)"),
# placeholder = "Enter City")),
# div (style = "display:inline-block; width:150px",
# textInput("geosp_select_zip", label = NULL, #label = h4("Zipcode"),
# placeholder = "Enter zipcode")),
div (style = "display:inline-block;",
# actionButton("filter_popup", icon=icon(name ="filter",class = "fa fa-filter"),label = "Filters"),
actionButton("hover", icon=icon(name ="hover",class = "fa fa-hand-o-up"),label = "Hover"),
actionButton("vector", value ="vectorOn" ,icon=icon(name ="vector",class = "fa fa-random"),label = "Vector"),
div(style = "display:inline-block;font-weight:bold;",label_value('No.Of Wires:'),
disabled(textInput(inputId ="noofwires",value = 0,width = "80px",label = NULL))),
div(style="display:inline-block; width:100px;", textInput(inputId ="ctry",label = NULL,
placeholder = "Country")),
div(style="display:inline-block; width:150px;", textInput(inputId ="txnno",label = NULL,
placeholder = "Transaction No" )),
div(style="display:inline-block; width:100px;", selectInput(inputId ="xborder",label = NULL,
choices = c(XBorder='',Yes='Y',No='N'))),
div(style="display:inline-block; width:100px;", selectInput(inputId ="highRisk",label = NULL,
choices = c(HighRisk='','High','Medium','Low') )),
div(style="display:inline-block; width:100px;", uiOutput(outputId ="hop")),
div(style="display:inline-block; width:100px;", uiOutput(outputId ="roles")),
div(style="display:inline-block; width:100px;", uiOutput(outputId ="riskenties" )),
# bsPopover("fipopoverbtn",title = NULL, content=shinyTree("filterData",checkbox = TRUE),
# placement = "bottom", trigger = "click",
# options = NULL),
# bsCollapsePanel("Panel_2", "This panel has a generic plot. ",
# "and a 'success' style.", style = "success"),
# actionButton("fipopoverbtn1", icon=icon(name ="filter",class = "fa fa-filter"),label = "Risk"),
div(style="display:inline-block; width:150px;",shinyTree("filterData",checkbox = TRUE,dragAndDrop = TRUE)),
div(style="display:inline-block; width:70px;",
actionButton(inputId = "search",label ="Search",style ="background-color: #6495ed;color:#FFFFFF;",
icon = icon(name="sear", class = "fa fa-search") ))
),
div(
# column(
# width = 3,shinyTree("filterData",checkbox = TRUE)),
# column(width =12,
# )
),
leafletOutput("networkMap1", height = "550px", width = "100%"),
#plotOutput('tsChart'),
# textOutput("frmDate"),
dygraphOutput("tsdygraph"),
# plotOutput("barchart"),
# plotlyOutput("plotlybarchart"),
# verbatimTextOutput("hover"),
# verbatimTextOutput("click"),
# verbatimTextOutput("brush"),
# verbatimTextOutput("zoom"),
bsModal(id = "filters_modal_window", title = "Filters",trigger = "filter_popup",
# fluidRow(
# column(
# width = 3,shinyTree("filterData",checkbox = TRUE)),
# column(width =9,
# column(width = 4, textInput(inputId ="ctry",label = "Country",
# placeholder = "Txn search by Country")),
# # column(width = 4, textInput(inputId ="role",label = "Role",
# # placeholder = "Role")),
# column(width = 4, uiOutput(outputId ="roles")),
# column(width = 4, textInput(inputId ="txnno",label = "Trans No",
# placeholder = "Transaction No" )),
# column(width = 4, selectInput(inputId ="xborder",label = "X-Border",
# choices = c(select='',Yes='Y',No='N'))),
# column(width = 4, uiOutput(outputId ="hop")),
# column(width = 4, selectInput(inputId ="highRisk",label = "High Risk",
# choices = c(select='','High','Medium','Low') )),
# column(width = 4, uiOutput(outputId ="riskenties" )),
# column(width = 12,actionButton(inputId = "search",label ="Search",
# icon = icon(name="sear", class = "fa fa-search") ))
# )
# ),
size = "large")
# bsPopover(id = "filter_popup",title ="Filters", trigger = "click",
# content = paste0("Text"),options = shinyTree("tree"))
# div (style = "display:inline-block; width:150px; float:right",
# actionButton("geosp_view_party_network","View Network for Selected Party")),
# bsModal("geosp_party_window", "Selected Party","view_party_network",visNetworkOutput("party_popup"), size = "small"),
#bsPopover("geosp_networkMap", "Selected Party", trigger = "click", content = paste("View Party Network"))
)
)#END TAB ITEMS
)
)#END UI
shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents