Búsqueda sistemática pubmed con R
knitr::opts_chunk$set(fig.align = "center",dpi=300,fig.width = 8,fig.height = 6,
warning=FALSE,message = FALSE)Métodos
Utilizamos los paquetes RISmed y easyPubMed dispuestos en el CRAN de R, para realizar las consultas a las bases de datos indexadas a través de términos de consulta. A su vez, con el paquete rcrossref se extrajo la cantidad de citaciones de los articulos.
Los paquetes RISmed y easyPubMed se diferencian en la velocidad de conexión a las bases de datos, y el os objetos que crean al final. Adicionalmente, son excluyentes en algunos resultados de consulta como el país y el lenguaje del artículo.
El ejemplo a continuación se centra en la búsqueda del método PET-CT para Cáncer en humanos en el año 2015. Para agilizar la construcción de las bases de datos y consultas, se usaron paqutes y funciones de computación en paralelo.
Cargar librerías
Primero, es necesario cargar las librerías necesarioas para los análisis.
Búsqueda
Para realizar las búsquedas es necesario contar con conexión a internet. Se establece los términos de búsqueda y se consultan los Query’s adicionales para complementar los mismo, finalmente se hace el proceso de extracción de la información con easyPubMed::articles_to_list y/o RISmed::EUtilsGet.
search_topic <- '(PET-CT AND Cancer [Filter] Humans) AND "2015" [PDAT]'
# consulta de los Query y cuantas publicaciones captura
my_query <- get_pubmed_ids(search_topic)
# Extracción de XML de cada uno de las publaciones (easyPubMed)
my_abstracts_xml <- fetch_pubmed_data(my_query,retmax = as.numeric(my_query$Count))
all_xml <- articles_to_list(my_abstracts_xml,simplify = F)
# Extracción de XML de cada uno de las publaciones (RISmed)
search_query <- EUtilsSummary(search_topic, retmax=as.numeric(my_query$Count))
records <- EUtilsGet(search_query, type = "efetch", db = "pubmed")Es posible poner límite al número de artículos a consultar con la opción retmax, para este caso se extrajo el total consultado, es decir, 3081 publicaciones.
Construcción de las bases de datos
# función para extraer el número de citaciones por DOI en rcrossref sin errores
Ncitation <- function(doi){
if(nchar(doi)==0){
cit <- data.frame(doi=doi,count=NA)
}else{
cit <- cr_citation_count(doi,async = T)
}
names(cit) <- c("doi","Num_Citation")
return(cit)
}
# Base de datos con la información adicional dada por RISmed
pubmed_data <- data.frame(pmid=PMID(records),
Language = Language(records),
country=Country(records),stringsAsFactors = F)
# Proceso de paralelización para construir la base de datos final
cl <- makeCluster(8) #de acuerdo al número de núcleos que cuente el PC
registerDoParallel(cl)
fullDF <- tryCatch(
{foreach(x=all_xml,
.packages = 'easyPubMed',
.combine = rbind) %dopar% article_to_df(
pubmedArticle = x,
autofill = T, #Llena todos los campos
max_chars = -1, #Extrae el abstract completo
getKeywords = T,
getAuthors = T)},
error = function(e) {NULL}, #si encuentra un error no se para el código
finally = {stopCluster(cl)}) #parar los núcleos
# Extraer información del número de citaciones del DOI
cit <- do.call("rbind",lapply(unique(FinalDF$doi),Ncitation))
# Extraer tipo de publicación
tyPub <- data.frame(pmid=records@PMID,
PubType=sapply(records@PublicationType,
function(x) paste(x,collapse = " ")),
stringsAsFactors = F)
# Unir las dos bases de datos según PMID
FinalDF <- left_join(x = fullDF,y = pubmed_data,"pmid")
# Base de datos final
FinalDF <- left_join(x = FinalDF,y = cit,"doi")
FinalDF <- left_join(x = FinalDF,y = tyPub,"pmid")
# Terminos Mesh
Mesh <- records@Mesh
names(Mesh) <- records@PMID
# remover memoria para ganar velocidad
rm(my_abstracts_xml,all_xml)
rm(cit,fullDF,pubmed_data)
# Resultados únicos reduciendo texto en título, abstract y keywords
FinalDF %>% mutate(abstract=substr(abstract,1,40),
title=substr(title,1,20),
keywords=substr(keywords,1,20)) %>%
distinct(pmid,.keep_all = T) %>% DT::datatable()Exploración de la base de datos
FinalDF %>% distinct(pmid,.keep_all = T) %>% group_by(Year=factor(year)) %>%
summarise(n=n()) %>%
ggplot(aes(x=Year,y=n,fill=Year))+geom_bar(stat = "identity")+
geom_text(aes(label=n),nudge_y = 500)+
theme_bw()+theme(legend.position = "none")+
ggtitle("Número de publicaciones por año")
FinalDF %>% distinct(pmid,.keep_all = T) %>% mutate(Date=paste(year,month,sep="-")) %>%
group_by(Date) %>%
summarise(Publicaciones=n()) %>%
ggplot(aes(x=Date,y=Publicaciones,group=1))+
geom_point()+geom_line()+theme_bw()+
geom_smooth()+
theme(axis.text.x = element_text(angle=90))+
ggtitle("Número de publicaciones mes/año")
FinalDF %>% distinct(pmid,.keep_all = T) %>% group_by(year,month) %>%
summarise(n=n()) %>%
ggplot(aes(x=month,y=n,group=1,colour=year))+
geom_point()+geom_line()+facet_wrap(~year)+theme_bw()+
ggtitle("Número de publicaciones mes/año")
FinalDF %>% distinct(pmid,.keep_all = T) %>% group_by(year,country) %>%
summarise(n=n(),Citation=sum(Num_Citation)) %>% na.omit() %>%
ggplot(aes(x=year,y=Citation,fill=country))+
geom_bar(stat = "identity",position=position_dodge())+
scale_fill_discrete(drop=FALSE)+theme_bw()+
geom_text(aes(label=paste("Pub:",n," Cit:",Citation)),size=2.5,
angle=90,hjust=.5,
position = position_dodge(width = 1))+
theme(legend.position="bottom",legend.text = element_text(size=8))+
ggtitle("Número de publicaciones y citaciones por año y país")
FinalDF %>%
mutate(Author=fct_infreq(factor(paste(firstname,lastname,sep=", "))))%>%
group_by(Author) %>% summarise(n=n()) %>%
.[1:30,] %>%
ggplot(aes(x=Author,y=n,fill=Author))+geom_bar(stat = "identity")+
theme_bw()+theme(axis.text.x = element_blank(),
legend.position = "none")+
geom_text(aes(x=Author,y=0.5,label=Author,angle=90),size=3.5,hjust="left")+
geom_text(aes(label=n),nudge_y = 1)+
ggtitle("Top 30 - Publicaciones por Autor")
Word cloud
KeyWords <- FinalDF %>% distinct(pmid,.keep_all = T) %>%
select(keywords) %>% unlist %>% enc2utf8 %>% cleanAbstracts
wordcloud2(KeyWords,size=1.5,color='random-dark',gridSize = 10)
cleanAbs <- FinalDF %>% distinct(pmid,.keep_all = T) %>%
select(abstract) %>% unlist %>% enc2utf8 %>% cleanAbstracts
wordcloud2(cleanAbs,size=1.5,color='random-dark',gridSize = 10)
jrnl <- FinalDF %>% distinct(pmid,.keep_all = T) %>% group_by(jabbrv) %>%
count(sort=T) %>% `colnames<-`(c("word", "freq"))
wordcloud2(jrnl,size=1.5,color='random-dark',gridSize = 10)
library(data.table)
BDMesh <- rbindlist(l = Mesh[-which(is.na(Mesh))],
idcol = names(Mesh[-which(is.na(Mesh))])) %>%
`colnames<-`(c("pmid", "Heading", "Type"))
Qualifier <- BDMesh %>% filter(Type=="Qualifier") %>%
select(Heading) %>% unlist %>% as.character %>% cleanAbstracts
wordcloud2(Qualifier,size=1.5,color='random-dark',gridSize = 10)
Descriptor <- BDMesh %>% filter(Type=="Descriptor") %>%
select(Heading) %>% unlist %>% as.character %>% cleanAbstracts
wordcloud2(Descriptor,size=1.5,color='random-dark',gridSize = 10)
Extraer abstracts que contengan la frase “Clinical Trial”
FinalDF[grepl("Clinical Trial | clinical trial", FinalDF$abstract),] %>%
distinct(pmid,.keep_all = T) %>%
select(title, journal, doi) %>%
DT::datatable(options = list(scrollX = TRUE,
initComplete = DT::JS(
"function(settings, json) {",
"$(this.api().table().container()).css({'font-size': '70%'});",
"}")))Extract abstracts containing the phrase ‘Cohort’
Crear matriz de términos del documento
Modelamiento de tópicos (cluster para abstracts)
library(topicmodels)
abs_lda <- LDA(abstracts1, k = 8, control = list(seed = 1234))
abs_lda_td <- tidytext:::tidy.LDA(abs_lda)Gráfico de términos por tópico
library(ggiraph)
library(plotly)
top_terms <- abs_lda_td %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)
t <- top_terms %>%
filter(term != "quot" & term != "of" & term != "95" & term != "ic")
ggplot(t, aes(reorder(term, beta),sqrt(beta), colour = factor(topic))) +
geom_point(size = .6)+
geom_line(aes(group = factor(topic)), lty = "dashed")+
theme(axis.text.x = element_text(size = 8, angle = 45, hjust = 1))+
labs(x = "") +
scale_fill_gradient2() +
theme(panel.background = element_rect(fill = "aliceblue")) +
facet_wrap(~topic, ncol = 2) +
geom_text(aes(label = term, angle = 90),size=3,hjust=0.2)
Clasificar Documentos
abs_lda_gamma <- tidytext:::tidy.LDA(abs_lda, matrix = "gamma")
abs_class <- abs_lda_gamma %>%
group_by(document) %>%
top_n(1, gamma) %>%
ungroup() %>%
arrange(gamma)
abs_class %>%
sample_n(10)## # A tibble: 10 x 3
## document topic gamma
## <chr> <int> <dbl>
## 1 10.1097/ICU.0000000000000207 7 0.911
## 2 10.1007/s00062-013-0280-4 7 0.759
## 3 10.3978/j.issn.2304-3865.2015.11.04 8 0.504
## 4 10.1016/j.remn.2015.03.009 7 0.759
## 5 10.5692/clinicalneurol.cn-000772 7 0.730
## 6 10.1097/RLU.0000000000000894 2 0.517
## 7 10.1007/s00259-015-3027-4 2 0.726
## 8 10.1007/s10554-015-0766-z 3 0.758
## 9 10.1097/RLU.0000000000000691 3 0.974
## 10 10.1007/s00259-015-3143-1 6 0.910FinalDF %>% distinct(pmid,.keep_all = T) %>%
group_by(jabbrv) %>%
count(sort = TRUE) %>%
filter(n >=40) ->top40
FinalDF %>%
left_join(top40) %>%
filter(!is.na(n)) %>%
rename(document = doi) %>%
left_join(abs_class) %>%
filter(!is.na(topic)) %>%
ggplot(aes(document, factor(topic))) +
geom_jitter(aes(colour = factor(topic)), size = 1, width = 0.1) +
facet_wrap(~journal) +
theme(strip.text.x = element_text(size = 8),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.text = element_text(size =10)) +
scale_color_viridis(discrete = TRUE, option = "C") +
theme(panel.background = element_rect(fill = "aliceblue")) +
labs(title = "Top 8 journals",
subtitle = "Documents by topic",
x = "Time")