O processo de Transferência de Tencnologias (TT) na Embrapa reúne um conjunto de ações, dentre as quais a organização de atividades focadas no fomento à geração de novas soluções tecnológicas e sua disponibilização aos agentes multiplicadores. Considerando a dinâmica existente nas unidades da Empresa, distribuídas pelo território, faz-se necessário, para uma boa orientação do processo de TT à Pesquisa e Desenvolvimento (P&D), o amplo conhecimento do conjunto de tecnologias já desenvolvidas. Assim, para amparar tais ações, busca-se realizar uma investigação na base de dados “Sistema de Gestão das Soluções Tecnológicas da Embrapa” (Gestec) para: 1. identificar os principais tópicos e temas associados às tecnologias e 2. identificar a similaridade entre soluções tecnológicas. Para isso, será realizado o processamento de linguagem natural por meio do pacote TopicModels (Grun; Hornik, 2011; 2019).
pacotes <- c("knitr", "kableExtra", "htmltools", "readxl", "topicmodels", "caret", "tidyr", "ggplot2","stringr","NLP","curl", "tidytext", "wordcloud", "dplyr", "SnowballC", "stopwords", "tm", "RColorBrewer")
if(sum(as.numeric(!pacotes %in% installed.packages())) != 0){
instalador <- pacotes[!pacotes %in% installed.packages()]
for(i in 1:length(instalador)) {
install.packages(instalador, dependencies = T)
break()}
sapply(pacotes, require, character = T)
} else {
sapply(pacotes, require, character = T)
}## knitr kableExtra htmltools readxl topicmodels caret
## TRUE TRUE TRUE TRUE TRUE TRUE
## tidyr ggplot2 stringr NLP curl tidytext
## TRUE TRUE TRUE TRUE TRUE TRUE
## wordcloud dplyr SnowballC stopwords tm RColorBrewer
## TRUE TRUE TRUE TRUE TRUE TRUEbase_gestec <- read_excel(path = "gestec.xlsx")
base_gestec <- data.frame(base_gestec)
glimpse(base_gestec)## Rows: 4,774
## Columns: 11
## $ Unidade.Responsável <chr> "Embrapa Acre", "Embrapa Acre", "E…
## $ Tema <chr> "Agricultura familiar", "Agricultu…
## $ Nome.da.Solução.Tecnológica <chr> "Laranja Aquiri", "Mandioca Panati…
## $ Descrição.da.Solução.Tecnológica <chr> "A cultivar Aquiri, procedente de …
## $ Tipo.de.Solução.Tecnológica <chr> "Produto", "Produto", "Processo", …
## $ Categoria.da.Solução.Tecnológica <chr> "Cultivar", "Cultivar", "Processo/…
## $ Ano.de.Lançamento <chr> "1997.0", "1998.0", "2016.0", "200…
## $ Estágio.de.Desenvolvimento <chr> "Finalizada", "Finalizada", "Final…
## $ Situação.para.Negócio <chr> "Não aprovado pela SNE", "Não apro…
## $ Situação.da.Propriedade.Intelectual <chr> "Não passível de proteção", "Não p…
## $ Descontinuada <chr> "Sim", "Sim", "Não", "Não", "Não",…base_gestec <- base_gestec %>%
mutate(Descrição.da.Solução.Tecnológica = gsub(pattern = "\\d",
replacement = "",
x = Descrição.da.Solução.Tecnológica)) %>%
mutate(Descrição.da.Solução.Tecnológica = gsub(pattern = "%|,|;|\\?|\\!|\\-|\\.|\\:|\\(|\\)|~",
replacement = "",
x = Descrição.da.Solução.Tecnológica))Uso do pacote stopword para retirada de palavras indesejadas em pt.
stopword <- c(stopwords(kind = "pt"), "objetivo", "boa", "relação", "ser", "meio", "dados", "cm", "ha", "principalmente", "pesquisa", "durante", "Brasil", "além", "cada", "possui", "apresentar", "ano", "sempre", "engenheiro", "consulte", "é", "objetivo deste trabalho", "embrapa", "tempo", "avaliação", "condição", "informações", "estado", "principais", "alto", "recursos", "bem", "apresenta", "uso", "sobre", "dia", "maior", "produtor", "produtores", "produtividade", "produtivo", "podem", "outras", "produto")
# Removendo elementos entre duas colunas (vetores)
# %in% - função/atalho para cruzar verdadeiro e falso
c(1:10)[!c(1:10) %in% c(3,4)]## [1] 1 2 5 6 7 8 9 10remove_elements <- function(x, lixo){
return(x[! x %in% lixo])
}
a = lapply(X = base_gestec$Descrição.da.Solução.Tecnológica,
FUN = function(x) {
strsplit(x = x,
split = ' ')})
lista2 <- lapply(X = a,
FUN = function(elemento_de_lista){
remove_elements(x = elemento_de_lista[[1]],
lixo = stopword)
})
paste(lista2[[1]], collapse = " ")## [1] "A cultivar Aquiri procedente coleta realizada município Rio BrancoAC árvores porte médio excelente vigor Os frutos esféricos sucosos tamanho médio polpa alaranjada textura firme sementes casca espessura média cor verdeamarelada A média caixas kg/ha espaçamento x m enxertada Citrange Carrizo caixas/ha tangerina Cleópatra caixas/ha Limão Cravo A produção concentrase período abril junho safras menores meses fevereiro julho sendo produção econômica iniciada partir º após plantio"lista3 <- lapply(X = lista2,
FUN = function(x){
paste(x, collapse = " ")
})Para a identificação dos tópicos e temas das soluções tecnológicas, faz-se necessária a criação de um corpus. No contexto desse trabalho, a variável “Descrição da Solução Tecnológica” será utilizada para fins de comparação.
base_gestec$Descrição.da.Solução.Tecnológica <- unlist(lista3)
corpus <- Corpus(VectorSource(base_gestec$Descrição.da.Solução.Tecnológica))JSS_dtm <- DocumentTermMatrix(corpus,
control = list(stemming = TRUE, stopwords = TRUE, minWordLength = 3,
removeNumbers = TRUE, removePunctuation = TRUE))
dim(JSS_dtm)## [1] 4774 15104nrow(JSS_dtm)## [1] 4774term_tfidf <-
tapply(JSS_dtm$v/slam::row_sums(JSS_dtm)[JSS_dtm$i], JSS_dtm$j, mean) *
log2(nDocs(JSS_dtm)/slam::col_sums(JSS_dtm > 0))
SS_dtm <- JSS_dtm[, term_tfidf >= 0.1]
JSS_dtm <- JSS_dtm[slam::row_sums(JSS_dtm) > 0,]
summary(slam::col_sums(JSS_dtm))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 2.00 4.00 23.08 13.00 3050.00summary(term_tfidf)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.02086 0.08147 0.11688 0.14802 0.17533 2.24420Foram criados 30 grupos de tópicos e temas; em seguida, rodou-se os algoritmos dos modelos: VEM, Gibs e CTM.
k <- 30
SEED <- 2010
jss_TM <- list(
VEM = LDA(JSS_dtm, k = k, control = list(seed = SEED)),
VEM_fixed = LDA(JSS_dtm, k = k, control = list(estimate.alpha = FALSE,
seed = SEED)),
Gibbs = LDA(JSS_dtm, k = k, method = "Gibbs", control = list(
seed = SEED, burnin = 1000, thin = 100, iter = 1000)),
CTM = CTM(JSS_dtm, k = k, control = list(seed = SEED,
var = list(tol = 10^-4), em = list(tol = 10^-3))))
sapply(jss_TM[1:2], slot, "alpha")## VEM VEM_fixed
## 0.01529515 1.66666667sapply(jss_TM, function(x)
mean(apply(posterior(x)$topics,
1, function(z) - sum(z * log(z)))))## VEM VEM_fixed Gibbs CTM
## 0.5214062 2.7454915 2.7856860 0.6570163Os resultados apontam menor variância no modelo VEM.
Nessa etapa roda-se os tópicos e também salva-se os grupos: VEM, Gibs e CTM.
Topic <- topics(jss_TM[["VEM"]], 1) #agrupamento das tecnologias
table(Topic)## Topic
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 291 271 126 121 76 141 155 206 139 123 205 197 288 89 163 68 303 121 205 193
## 21 22 23 24 25 26 27 28 29 30
## 142 77 95 86 256 105 123 184 112 113Terms <- terms(x = jss_TM[["VEM"]], 5) #palavras mais comuns dos grupos de tecnologias, segundo cada um dos algoritmos (VEM, VEM_FIXED, Gibbs)
Terms[,]## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5 Topic 6
## [1,] "solo" "produção" "água" "solo" "cultivar" "sement"
## [2,] "área" "sistema" "irrigação" "sistema" "raíz" "muda"
## [3,] "vegetação" "planta" "cultura" "plantio" "plantio" "dia"
## [4,] "município" "cultura" "muda" "cultura" "solo" "apó"
## [5,] "estudo" "manejo" "área" "chuva" "função" "germinação"
## Topic 7 Topic 8 Topic 9 Topic 10 Topic 11
## [1,] "produção" "rec" "tecnologia" "produção" "nitrogênio"
## [2,] "sistema" "soja" "equipamento" "sistema" "planta"
## [3,] "impacto" "resistência" "sement" "embrapa" "fixação"
## [4,] "ambient" "cultivar" "milho" "arroz" "biológica"
## [5,] "tecnologia" "brs" "control" "qualidad" "inoculant"
## Topic 12 Topic 13 Topic 14 Topic 15 Topic 16 Topic 17
## [1,] "forragem" "grãos" "solo" "modelo" "fruto" "produção"
## [2,] "forrageira" "cultivar" "nutrient" "espéci" "coletar" "sistema"
## [3,] "pastagen" "brs" "cerrado" "crescimento" "população" "leit"
## [4,] "cerrado" "ciclo" "cálcio" "altura" "manejo" "manejo"
## [5,] "pastejo" "resistência" "região" "procedência" "processo" "curso"
## Topic 18 Topic 19 Topic 20 Topic 21 Topic 22 Topic 23
## [1,] "brs" "cultivar" "solo" "seleção" "brs" "resistent"
## [2,] "cultivar" "médio" "área" "espéci" "cultivar" "moderadament"
## [3,] "produção" "média" "cultura" "semiárido" "seca" "cultivar"
## [4,] "fruto" "dia" "água" "região" "cultivo" "suscetível"
## [5,] "doença" "grãos" "sistema" "produção" "solo" "trigo"
## Topic 24 Topic 25 Topic 26 Topic 27 Topic 28 Topic 29
## [1,] "área" "embrapa" "cultivar" "solo" "embrapa" "serviço"
## [2,] "embrapa" "control" "embrapa" "espéci" "germoplasma" "ambientai"
## [3,] "amazônia" "praga" "guaraná" "carbono" "planta" "familiar"
## [4,] "mapa" "espéci" "antracnos" "efeito" "genético" "cap"
## [5,] "projeto" "cerrado" "produção" "água" "acesso" "capítulo"
## Topic 30
## [1,] "produção"
## [2,] "mandioca"
## [3,] "raíz"
## [4,] "baixo"
## [5,] "grand"length(Topic)## [1] 4774base_gestec <- base_gestec %>%
mutate(VEM = topics(jss_TM[["VEM"]], 1),
VEM_FIXED = topics(jss_TM[["VEM_fixed"]], 1),
Gibbs = topics(jss_TM[["Gibbs"]], 1),
CTM = topics(jss_TM[["CTM"]], 1))
base_gestec <- data.frame(base_gestec)
Topic <- topics(jss_TM[["VEM"]], 1)
Terms <- terms(jss_TM[["VEM"]], 10) #termos mais comuns nos cinco primeiros grupos
Terms[,1:10]## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5
## [1,] "solo" "produção" "água" "solo" "cultivar"
## [2,] "área" "sistema" "irrigação" "sistema" "raíz"
## [3,] "vegetação" "planta" "cultura" "plantio" "plantio"
## [4,] "município" "cultura" "muda" "cultura" "solo"
## [5,] "estudo" "manejo" "área" "chuva" "função"
## [6,] "ambient" "cultivo" "espéci" "produção" "sendo"
## [7,] "atividad" "solo" "período" "direto" "hectar"
## [8,] "sistema" "doença" "armadilha" "água" "deve"
## [9,] "bacia" "adubação" "planta" "preparo" "mandioca"
## [10,] "agrícola" "praga" "manejo" "área" "característica"
## Topic 6 Topic 7 Topic 8 Topic 9 Topic 10
## [1,] "sement" "produção" "rec" "tecnologia" "produção"
## [2,] "muda" "sistema" "soja" "equipamento" "sistema"
## [3,] "dia" "impacto" "resistência" "sement" "embrapa"
## [4,] "apó" "ambient" "cultivar" "milho" "arroz"
## [5,] "germinação" "tecnologia" "brs" "control" "qualidad"
## [6,] "devem" "processo" "regiõ" "planta" "tecnologia"
## [7,] "pode" "clone" "nematoid" "custo" "alta"
## [8,] "semeadura" "atividad" "grupo" "área" "estado"
## [9,] "planta" "qualidad" "edafoclimática" "manejo" "cultivar"
## [10,] "enxertia" "partir" "região" "embrapa" "terra"A tokenização realizada buscou evidenciar os N-grams, Bi-grams e Tri-Gramns. Essa técnica, também conhecida como segmentação de palavras, quebra a sequência de caracteres em um texto localizando o limite de cada palavra, ou seja, os pontos onde uma palavra termina e outra começa R” 1.
##Token##
base_gestec_tokens <- base_gestec %>%
unnest_tokens(output = contagem,
input = Descrição.da.Solução.Tecnológica,
token = "ngrams",
n = 3)
contagem_grams <- base_gestec_tokens %>%
count(contagem,
sort = T) %>%
na.omit()
base_gestec_tokens_2 <- base_gestec %>%
unnest_tokens(output = contagem,
input = Descrição.da.Solução.Tecnológica,
token = "ngrams",
n = 1)
contagem_grams_2 <- base_gestec_tokens_2 %>%
count(contagem,
sort = T) %>%
na.omit()Para facilitar a visualização dos principais termos, de acordo com R” 2.
wordcloud(words = base_gestec_tokens$contagem,
max.words = 100,
random.order = F,
random.color = T)## Warning in tm_map.SimpleCorpus(corpus, tm::removePunctuation): transformation
## drops documents## Warning in tm_map.SimpleCorpus(corpus, function(x) tm::removeWords(x,
## tm::stopwords())): transformation drops documents## Warning in wordcloud(words = base_gestec_tokens$contagem, max.words = 100, :
## resultados could not be fit on page. It will not be plotted.## Warning in wordcloud(words = base_gestec_tokens$contagem, max.words = 100, :
## ambiente could not be fit on page. It will not be plotted.## Warning in wordcloud(words = base_gestec_tokens$contagem, max.words = 100, :
## mandioca could not be fit on page. It will not be plotted.
base_gestec %>% filter(!is.na(Tipo.de.Solução.Tecnológica)) %>%
ggplot(aes(x = Tipo.de.Solução.Tecnológica))+
geom_bar() 
base_df <- base_gestec[, c("Tipo.de.Solução.Tecnológica", "VEM")] #reduzindo o dataframe para só as colunas de interesse
df <- table(base_df) #transformando em uma tabela de counts
df <- as.data.frame.matrix(df) #transformando a tabela de counts em dataframe
df_sum <- apply(df, 1, sum) #criando um vetor que soma a quantidade de tópicos de cada tipo
df_sum <- order(df_sum, decreasing = TRUE) #ordenando o vetor pela quantidade de topicos
df_sorted <- df[df_sum,] #ordenando o dataframe pela soma dos tópicos em cada tipo
df_sorted <- data.matrix(df_sorted) #transformando o df em uma matriz numérica
heatmap(df_sorted[1:4, ], cexRow=1) #imprimindo o heatmap com os 30 tipos com mais tópicos
GRUN, B.; HORNIK, K. Topicmodels: An R Package for Fitting Topic Models. Journal of Statistical Software, v. 40, n. 13, p. 1–30, 2011. DOIi:10.18637/jss.v040.i13.
kableExtra: Por Hao Zhu