Merge pull request #287 from massimoaria/develop

Develop to CRAN

Author: massimoaria

.gitignore

@@ -6,11 +6,14 @@
 .txt
 .bib
 .Ruserdata
+.DS_Store
 VOSviewer.jar
 network.net
 Rubbish
 desktop.ini
 vignette.txt
 inst/doc
+inst/biblioshiny/__MACOSX
+inst/biblioshiny/rsconnect
 _gh-pages
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bibliometrix
 Type: Package
 Title: Comprehensive Science Mapping Analysis
-Version: 4.0.2
+Version: 4.1.0
 Authors@R: c(
     person(given = "Massimo",
            family = "Aria",
@@ -48,7 +48,7 @@ Imports: stats,
 		 shiny,
 		 SnowballC,
 		 stringdist,
-		 stringr,
+		 stringi,
 		 tidyr,
 		 tidytext
 Suggests: 
@@ -59,6 +59,6 @@ Suggests:
     shinycssloaders,
     visNetwork,
     wordcloud2
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 NeedsCompilation: no
 Config/testthat/edition: 3

NAMESPACE

@@ -26,6 +26,7 @@ export(localCitations)
 export(lotka)
 export(mergeDbSources)
 export(metaTagExtraction)
+export(missingData)
 export(net2VOSviewer)
 export(networkPlot)
 export(networkStat)
@@ -56,6 +57,7 @@ import(readr)
 import(readxl)
 import(shiny)
 import(stats)
+import(stringi)
 import(tidytext)
 importFrom(DT,DTOutput)
 importFrom(DT,datatable)
@@ -294,9 +296,6 @@ importFrom(rscopus,author_df_orig)
 importFrom(rscopus,author_search)
 importFrom(rscopus,get_complete_author_info)
 importFrom(stringdist,stringdistmatrix)
-importFrom(stringr,str_extract_all)
-importFrom(stringr,str_locate_all)
-importFrom(stringr,str_replace_all)
 importFrom(tidyr,drop_na)
 importFrom(tidyr,gather)
 importFrom(tidyr,pivot_longer)

NEWS

@@ -1,3 +1,17 @@
+bibliometrix v4.0.1 (Release date: 2023-01-13)
+
+Features:
+* Added a new function missingData() to check the completeness of metadata included in a bibliographic data frame 
+* Biblioshiny: Added the ability to create an excel report by adding step by step results of different analysis
+* Biblioshiny: Added a popup that returns the results of the metadata completeness check of imported collections
+* Biblioshiny: Revamped interface with floating options menu and more space for graphical analysis results
+
+Changes:
+* Several bug fixes
+* Computational speed improvements
+
+
+
 bibliometrix v4.0.1 (Release date: 2022-09-16)
 
 Features:

R/bib2df.R

@@ -22,8 +22,10 @@ bib2df<-function(D, dbsource = "isi"){
 
   if (dbsource == "isi") D <- gsub(" = \\{","={",D)
 
+  D <- gsub("\\\t","",gsub(" = \\{","=\\{",D)) # to work also with new scopus bib format
+  
   D[Papers] <- paste("Paper={",D[Papers],sep="")
-  #ii <- regexpr("\\{",D[Papers])
+
   ind <- regexpr("=\\{",D) # sep among tags and contents
   ind[Papers] <- 6
 

R/conceptualStructure.R

@@ -409,36 +409,34 @@ conceptualStructure<-function(M,field="ID", ngrams=1, method="MCA", quali.supp=N
     b_doc_TC <- b_doc_TC + annotation_custom(logo, xmin = xl[1], xmax = xl[2], ymin = yl[1], ymax = yl[2]) 
     ##
 
-    params <- list(field = field, 
-                   ngrams = ngrams,
-                   method=method,
-                   quali.supp=quali.supp,
-                   quanti.supp=quanti.supp,
-                   minDegree=minDegree,
-                   clust=clust,
-                   k.max=k.max,
-                   stemming = stemming, 
-                   labelsize=labelsize,
-                   documents=documents,
-                   graph=graph, 
-                   remove.terms = remove.terms, 
-                   synonyms = synonyms)
-    
-    params <- data.frame(params=names(unlist(params)),values=unlist(params), row.names = NULL)
 
     if (isTRUE(graph)){plot(b_doc_TC)}
 
     semanticResults=list(net=CW,res=res.mca,km.res=km.res,graph_terms=b,graph_dendogram=b_dend,
-                         graph_documents_Contrib=b_doc,graph_documents_TC=b_doc_TC,docCoord=docCoord,
-                         params=params)
+                         graph_documents_Contrib=b_doc,graph_documents_TC=b_doc_TC,docCoord=docCoord)
 
   }else{
 
     semanticResults=list(net=CW,res=res.mca,km.res=km.res,graph_terms=b,graph_dendogram=b_dend,
-                         graph_documents_Contrib=NULL,graph_documents_TC=NULL,docCoord=NULL,
-                         params=params)
+                         graph_documents_Contrib=NULL,graph_documents_TC=NULL,docCoord=NULL)
     }
 
+  params <- list(field = field, 
+                 ngrams = ngrams,
+                 method=method,
+                 quali.supp=quali.supp,
+                 quanti.supp=quanti.supp,
+                 minDegree=minDegree,
+                 clust=clust,
+                 k.max=k.max,
+                 stemming = stemming, 
+                 labelsize=labelsize,
+                 documents=documents,
+                 graph=graph, 
+                 remove.terms = remove.terms, 
+                 synonyms = synonyms)
+  
+  semanticResults$params <- data.frame(params=names(unlist(params)),values=unlist(params), row.names = NULL)
 
 
   return(semanticResults)

R/couplingMap.R

@@ -195,7 +195,22 @@ couplingMap <- function(M, analysis = "documents", field="CR", n=500, label.term
   row.names(df)=NULL
   df <- df %>% rename(items = .data$words)
 
-  results=list(map=g, clusters=df, data=df_lab,nclust=dim(df)[1], NCS = D, net=Net)
+  params <- list(analysis = analysis,
+                 field=field, 
+                 n=n, 
+                 minfreq=minfreq,
+                 label.term=label.term, 
+                 ngrams=ngrams, 
+                 impact.measure=impact.measure,
+                 stemming=stemming, 
+                 n.labels=n.labels, 
+                 size=size,
+                 community.repulsion = community.repulsion, 
+                 repel=repel, 
+                 cluster=cluster)
+  params <- data.frame(params=names(unlist(params)),values=unlist(params), row.names = NULL)
+  
+  results=list(map=g, clusters=df, data=df_lab,nclust=dim(df)[1], NCS = D, net=Net, params=params)
   return(results)
 }
 
@@ -315,7 +330,7 @@ labeling <- function(M, df_lab, term, n, n.labels, analysis, ngrams){
 
   #clusters <- unique(df$Cluster)
   #w <- character(length(clusters))
-  
+  df$SR <- df[,1]
   tab_global <- tableTag(df, term)
   tab_global <- data.frame(label=names(tab_global),tot=as.numeric(tab_global), n=nrow(M),stringsAsFactors = FALSE)
 

R/dimensions2df.R

@@ -76,7 +76,7 @@ dimensions2df <- function(file, format = "csv") {
 
 
 postprocessingDim <- function(DATA) {
-  DATA <- data.frame(lapply(DATA, toupper), stringsAsFactors = FALSE)
+  # DATA <- data.frame(lapply(DATA, toupper), stringsAsFactors = FALSE)
 
   ## Converting original references in WOS format (AU, PY, SO, VOL, NUM, DOI)
   if ("Cited.references" %in% names(DATA)) {
@@ -232,15 +232,20 @@ postprocessingDim <- function(DATA) {
   if (("SO" %in% names(DATA)) & ("Anthology.title" %in% names(DATA))) {
     ind <- which(is.na(DATA$SO) | DATA$SO=="")
     DATA$SO[ind] <- DATA$Anthology.title[ind]
-    DATA$SO[DATA$SO==""] <- NA
+    DATA$SO[is.na(DATA$SO) | DATA$SO==""] <- "NA"
   }
 
   if (!("SO" %in% names(DATA))) {
     DATA$SO <- "NA"
   }
 
+  ####
+  cat("\nCreating ISO Source names...")
   DATA$JI <- sapply(DATA$SO, AbbrevTitle, USE.NAMES = FALSE)
   DATA$J9 <- gsub("\\.","",DATA$JI)
+  ####
+  
+  DATA <- data.frame(lapply(DATA, toupper), stringsAsFactors = FALSE)
 
   DATA$PY <- as.numeric(DATA$PY)
 

R/histNetwork.R

@@ -203,8 +203,8 @@ scopus <- function(M, min.citations, sep, network, verbose){
   nCum <- c(1, cumsum(n[-length(n)]))
   CR <- paste(CR, collapse = " ")
 
-  L <- str_locate_all(CR, TIpost)
-  
+  #L <- str_locate_all(CR, TIpost)
+  L <- stringi::stri_locate_all_regex(CR,TIpost, omit_no_match = TRUE)
 
   LCS <- lengths(L) / 2
 

R/histPlot.R

@@ -74,14 +74,14 @@ histPlot<-function(histResults, n=20, size = 5, labelsize = 5, title_as_label =
 
   switch(label,
          title={
-           title <- strsplit(stringr::str_to_title(V(bsk.network)$title), " ")
+           title <- strsplit(stringi::stri_trans_totitle(V(bsk.network)$title), " ")
            V(bsk.network)$id <- unlist(lapply(title, function(l){
              n <- floor(length(l)/2)
              paste0(paste(l[1:n], collapse=" ", sep=""),"\n",paste(l[(n+1):length(l)], collapse=" ", sep=""))
            }))
          },
          keywords={
-           kw <- strsplit(stringr::str_to_title(V(bsk.network)$keywords), ";")
+           kw <- strsplit(stringi::stri_trans_totitle(V(bsk.network)$keywords), ";")
            kw[is.na(kw)] <- "Not Available"
            V(bsk.network)$id <- unlist(lapply(kw, function(l){
              if (length(l)>1){
@@ -92,7 +92,7 @@ histPlot<-function(histResults, n=20, size = 5, labelsize = 5, title_as_label =
            }))
          },
          keywordsplus={
-           kw <- strsplit(stringr::str_to_title(V(bsk.network)$keywordsplus), ";")
+           kw <- strsplit(stringi::stri_trans_totitle(V(bsk.network)$keywordsplus), ";")
            kw[is.na(kw)] <- "Not Available"
            V(bsk.network)$id <- unlist(lapply(kw, function(l){
              if (length(l)>1){
@@ -107,24 +107,13 @@ histPlot<-function(histResults, n=20, size = 5, labelsize = 5, title_as_label =
          }
   )
 
-  # if (isTRUE(title_as_label)){
-  #   title <- strsplit(stringr::str_to_title(V(bsk.network)$title), " ")
-  #   V(bsk.network)$id <- unlist(lapply(title, function(l){
-  #     n <- floor(length(l)/2)
-  #     paste0(paste(l[1:n], collapse=" ", sep=""),"\n",paste(l[(n+1):length(l)], collapse=" ", sep=""))
-  #   }))
-  #   #V(bsk.network)$id <- tolower(paste(substr(V(bsk.network)$title,1,50),"...",sep=""))
-  # } else {
-  #   V(bsk.network)$id <- tolower(unlist(RR))
-  # }
-  
   # Compute node degrees (#links) and use that to set node size:
   deg <- LCS
   V(bsk.network)$size <- size
     #rep(size,length(V(bsk.network)))}
 
   #Years=histResults$histData$Year[ind]
-  Years <- as.numeric(unlist(str_extract_all(unlist(RR),"[[:digit:]]{4}$")))
+  Years <- as.numeric(unlist(stringi::stri_extract_all_regex(unlist(RR),"[[:digit:]]{4}$")))
   V(bsk.network)$years <- Years
 
   # Remove loops