Skip to content

Commit

Permalink
Minor fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
massimoaria committed May 2, 2019
1 parent 9870630 commit 3c85acd
Show file tree
Hide file tree
Showing 5 changed files with 130 additions and 116 deletions.
228 changes: 118 additions & 110 deletions R/biblioNetwork.R
Original file line number Diff line number Diff line change
Expand Up @@ -64,119 +64,127 @@
#'
#' @export

biblioNetwork <- function(M, analysis = "coupling", network = "authors", sep = ";", shortlabel=TRUE){

crossprod <- Matrix::crossprod
NetMatrix=NA
if (analysis=="coupling"){
switch(network,
authors={
WA=cocMatrix(M, Field="AU", type = "sparse", sep)
WCR=cocMatrix(M, Field="CR", type = "sparse", sep)
CRA = crossprod(WCR, WA)
NetMatrix = crossprod(CRA, CRA)
},
references={
WCR=Matrix::t(cocMatrix(M, Field="CR", type = "sparse", sep))
NetMatrix = crossprod(WCR, WCR)
},
sources={
WSO=cocMatrix(M, Field="SO", type = "sparse", sep)
WCR=cocMatrix(M, Field="CR", type = "sparse", sep)
CRSO = crossprod(WCR, WSO)
NetMatrix = crossprod(CRSO, CRSO)
},
countries={
WCO=cocMatrix(M, Field="AU_CO", type = "sparse", sep)
WCR=cocMatrix(M, Field="CR", type = "sparse", sep)
CRCO = crossprod(WCR, WCO)
NetMatrix = crossprod(CRCO, CRCO)
biblioNetwork <-
function(M,
analysis = "coupling",
network = "authors",
sep = ";",
shortlabel = TRUE) {
crossprod <- Matrix::crossprod
NetMatrix = NA

if (analysis == "coupling") {
switch(
network,
authors = {
WA = cocMatrix(M, Field = "AU", type = "sparse", sep)
WCR = cocMatrix(M, Field = "CR", type = "sparse", sep)
CRA = crossprod(WCR, WA)
NetMatrix = crossprod(CRA, CRA)
},
references = {
WCR = Matrix::t(cocMatrix(M, Field = "CR", type = "sparse", sep))
NetMatrix = crossprod(WCR, WCR)
},
sources = {
WSO = cocMatrix(M, Field = "SO", type = "sparse", sep)
WCR = cocMatrix(M, Field = "CR", type = "sparse", sep)
CRSO = crossprod(WCR, WSO)
NetMatrix = crossprod(CRSO, CRSO)
},
countries = {
WCO = cocMatrix(M, Field = "AU_CO", type = "sparse", sep)
WCR = cocMatrix(M, Field = "CR", type = "sparse", sep)
CRCO = crossprod(WCR, WCO)
NetMatrix = crossprod(CRCO, CRCO)
}
)
}
)}

if (analysis=="co-occurrences"){
switch(network,
authors={
WA=cocMatrix(M, Field="AU", type = "sparse", sep)
NetMatrix = crossprod(WA, WA)
},
keywords={
WK=cocMatrix(M, Field="ID", type = "sparse", sep)
NetMatrix = crossprod(WK,WK)
},
author_keywords={
WK=cocMatrix(M, Field="DE", type = "sparse", sep)
NetMatrix = crossprod(WK,WK)
},
titles={
WK=cocMatrix(M, Field="TI_TM", type = "sparse", sep)
NetMatrix = crossprod(WK,WK)
},
abstracts={
WK=cocMatrix(M, Field="AB_TM", type = "sparse", sep)
NetMatrix = crossprod(WK,WK)
},
sources={
WSO=cocMatrix(M, Field="SO", type = "sparse", sep)
NetMatrix = crossprod(WSO, WSO)
}
)}

if (analysis=="co-citation"){
switch(network,
authors={
WA=cocMatrix(M, Field="CR_AU", type = "sparse", sep)
NetMatrix = crossprod(WA, WA)
},
references={
WCR=cocMatrix(M, Field="CR", type = "sparse", sep)
NetMatrix = crossprod(WCR, WCR)
### reduce name length
# A=row.names(NetMatrix)
# ind=unlist(regexec("*V[0-9]", A))
# A[ind>-1]=substr(A[ind>-1],1,(ind[ind>-1]-1))
# ind=unlist(regexec("*DOI ", A))
# A[ind>-1]=substr(A[ind>-1],1,(ind[ind>-1]-1))
# row.names(NetMatrix)=A
# colnames(NetMatrix)=A
###
},
sources={
WSO=cocMatrix(M, Field="CR_SO", type = "sparse", sep)
NetMatrix = crossprod(WSO, WSO)
}
)}
if (analysis=="collaboration"){
switch(network,
authors={
WA=cocMatrix(M, Field="AU", type = "sparse", sep)
NetMatrix = crossprod(WA, WA)
},
universities={
WUN=cocMatrix(M, Field="AU_UN", type = "sparse", sep)
NetMatrix = crossprod(WUN, WUN)
},
countries={
WCO=cocMatrix(M, Field="AU_CO", type = "sparse", sep)
NetMatrix = crossprod(WCO, WCO)
})
}
# delete empty vertices
NetMatrix=NetMatrix[nchar(colnames(NetMatrix))!=0,nchar(colnames(NetMatrix))!=0]

# short label for scopus references
if (network=="references"){
ind=which(regexpr("[A-Za-z]",substr(colnames(NetMatrix),1,1))==1)
NetMatrix=NetMatrix[ind,ind]
if (isTRUE(shortlabel)){
LABEL<-labelShort(NetMatrix,db=tolower(M$DB[1]))
LABEL<-removeDuplicatedlabels(LABEL)
colnames(NetMatrix)=rownames(NetMatrix)=LABEL}

if (analysis == "co-occurrences") {
switch(
network,
authors = {
WA = cocMatrix(M, Field = "AU", type = "sparse", sep)
},
keywords = {
WA = cocMatrix(M, Field = "ID", type = "sparse", sep)
},
author_keywords = {
WA = cocMatrix(M, Field = "DE", type = "sparse", sep)
},
titles = {
WA = cocMatrix(M, Field = "TI_TM", type = "sparse", sep)
},
abstracts = {
WA = cocMatrix(M, Field = "AB_TM", type = "sparse", sep)
},
sources = {
WA = cocMatrix(M, Field = "SO", type = "sparse", sep)
}
)
NetMatrix = crossprod(WA, WA)

}



if (analysis == "co-citation") {
switch(
network,
authors = {
WA = cocMatrix(M, Field = "CR_AU", type = "sparse", sep)
},
references = {
WA = cocMatrix(M, Field = "CR", type = "sparse", sep)
},
sources = {
WA = cocMatrix(M, Field = "CR_SO", type = "sparse", sep)
}
)
NetMatrix = crossprod(WA, WA)

}

if (analysis == "collaboration") {
switch(
network,
authors = {
WA = cocMatrix(M, Field = "AU", type = "sparse", sep)

},
universities = {
WA = cocMatrix(M, Field = "AU_UN", type = "sparse", sep)

},
countries = {
WA = cocMatrix(M, Field = "AU_CO", type = "sparse", sep)
}
)
NetMatrix = crossprod(WA, WA)

}


# delete empty vertices
NetMatrix = NetMatrix[nchar(colnames(NetMatrix)) != 0, nchar(colnames(NetMatrix)) != 0]

# short label for scopus references
if (network == "references") {
ind = which(regexpr("[A-Za-z]", substr(colnames(NetMatrix), 1, 1)) == 1)
NetMatrix = NetMatrix[ind, ind]
if (isTRUE(shortlabel)) {
LABEL <- labelShort(NetMatrix, db = tolower(M$DB[1]))
LABEL <- removeDuplicatedlabels(LABEL)
colnames(NetMatrix) = rownames(NetMatrix) = LABEL
}

}
# if (analysis != "coupling") {
# attr(NetMatrix, "PY") <- attr(WA, "PY")
# }
return(NetMatrix)
}

return(NetMatrix)
}

### shortlabel
labelShort <- function(NET,db="isi"){
Expand Down
2 changes: 2 additions & 0 deletions R/cocMatrix.R
Original file line number Diff line number Diff line change
Expand Up @@ -144,6 +144,7 @@ if (type=="sparse" & !isTRUE(binary)){
}

WF=WF[,!is.na(uniqueField)]
#WF=attrPY(M,WF) # Median Year of each attribute

return(WF)
}
Expand All @@ -156,3 +157,4 @@ reduceRefs<- function(A){
A[ind>-1]=substr(A[ind>-1],1,(ind[ind>-1]-1))
return(A)
}

2 changes: 2 additions & 0 deletions R/networkPlot.R
Original file line number Diff line number Diff line change
Expand Up @@ -287,6 +287,8 @@ clusteringNetwork <- function(bsk.network,cluster){
}else{C='gray70'}
return(C)
})
E(bsk.network)$lty=1
E(bsk.network)$lty[E(bsk.network)$color=="gray70"]=5
### end

cl=list()
Expand Down
10 changes: 6 additions & 4 deletions inst/biblioshiny/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -2194,7 +2194,7 @@ server <- function(input, output, session) {

#par(bg="grey92", mar=c(0,0,0,0))
values$cocnet=networkPlot(values$NetWords, normalize=normalize,n = n, Title = values$Title, type = input$layout,
size.cex=TRUE, size=5 , remove.multiple=F, edgesize = input$edgesize, labelsize=input$labelsize,label.cex=label.cex,
size.cex=TRUE, size=5 , remove.multiple=F, edgesize = input$edgesize*3, labelsize=input$labelsize,label.cex=label.cex,
label.n=label.n,edges.min=input$edges.min,label.color = F, curved=curved,alpha=input$cocAlpha,
cluster=input$cocCluster)
}else{
Expand Down Expand Up @@ -2238,7 +2238,7 @@ server <- function(input, output, session) {
if (input$cocit.curved=="Yes"){curved=TRUE}else{curved=FALSE}

values$cocitnet=networkPlot(values$NetRefs, normalize=NULL, n = n, Title = values$Title, type = input$citlayout,
size.cex=TRUE, size=5 , remove.multiple=F, edgesize = input$citedgesize,
size.cex=TRUE, size=5 , remove.multiple=F, edgesize = input$citedgesize*3,
labelsize=input$citlabelsize,label.cex=label.cex, curved=curved,
label.n=label.n,edges.min=input$citedges.min,label.color = F,remove.isolates = FALSE,
alpha=input$cocitAlpha, cluster=input$cocitCluster)
Expand Down Expand Up @@ -2285,7 +2285,7 @@ server <- function(input, output, session) {
if (input$collayout=="worldmap"){type="auto"}

values$colnet=networkPlot(values$ColNetRefs, normalize=normalize, n = n, Title = values$Title, type = type,
size.cex=TRUE, size=5 , remove.multiple=F, edgesize = input$coledgesize,
size.cex=TRUE, size=5 , remove.multiple=F, edgesize = input$coledgesize*3,
labelsize=input$collabelsize,label.cex=label.cex, curved=curved,
label.n=label.n,edges.min=input$coledges.min,label.color = F,alpha=input$colAlpha,
remove.isolates = T, cluster=input$colCluster)
Expand Down Expand Up @@ -2391,7 +2391,9 @@ server <- function(input, output, session) {

vn$nodes$label=LABEL
vn$edges$num=1

vn$edges$dashes=FALSE
vn$edges$dashes[vn$edges$lty==2]=TRUE

## opacity
vn$nodes$color=adjustcolor(vn$nodes$color,alpha=min(c(opacity+0.2,1)))
vn$edges$color=adjustcolor(vn$edges$color,alpha=opacity)
Expand Down
4 changes: 2 additions & 2 deletions inst/biblioshiny/ui.R
Original file line number Diff line number Diff line change
Expand Up @@ -300,10 +300,10 @@ navbarMenu("Sources",
)
),
#### MOST RELEVANT CITED SOURCES ----
tabPanel("Most Cited Sources",
tabPanel("Most Local Cited Sources",
sidebarLayout(
sidebarPanel(width=3,
h3(em(strong("Most Cited Sources (from Reference Lists)"))),
h3(em(strong("Most Local Cited Sources (from Reference Lists)"))),
br(),
h4(em(strong("Graphical Parameters: "))),
" ",
Expand Down

0 comments on commit 3c85acd

Please sign in to comment.