-
Notifications
You must be signed in to change notification settings - Fork 0
/
server.R
200 lines (172 loc) · 7.75 KB
/
server.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
library(shiny)
library(ggplot2)
library(plotly)
library(stringr)
library(purrr)
library(dplyr)
library(xml2)
library(markdown)
library(shinythemes)
library(htmltools)
library(httr)
library(rvest)
library(GGally)
library(network)
library(igraph)
library(ggnetwork)
library(htmlwidgets)
Plot<-function(input,tableau){
tableau<-tableau[tableau$base2>=input$plancher,]
tableau<-tableau[tableau$base1>=input$plancher,]
table_edges<-tableau[,c(1,2,10)]
table_edges<-table_edges[table_edges$ratio_moy>input$seuil,]
table_edges<-table_edges[is.na(table_edges$ratio_moy)==FALSE,]
rownames(table_edges)=NULL
table_edges$color<-"autre"
ecrivain<-input$mot
table_edges$color[table_edges$ecrivain_1==ecrivain|table_edges$ecrivain_2==ecrivain]<-ecrivain
table_edges$etiquette<-str_c(table_edges$ecrivain_1,"-",table_edges$ecrivain_2," - ",round(table_edges$ratio_moy,digits = 3))
net <- graph.data.frame(table_edges, directed = F)
V(net)$degree <- graph.strength(net)
V(net)$color_v<-"autre"
V(net)$color_n<-"autre "
V(net)$color_v[V(net)$name==ecrivain]<-ecrivain
V(net)$texte<-str_c(V(net)$name," - ",V(net)$degree)
set.seed(123)
df_net <- ggnetwork(net)
x_end<-unique(df_net$x[df_net$name==ecrivain])
y_end<-unique(df_net$y[df_net$name==ecrivain])
for (i in 1:length(df_net$color_v)) {
if(df_net$xend[i]==x_end & df_net$yend[i]==y_end){
df_net$color_n[i]<-"reseau"
}
}
x_end<-df_net$xend[df_net$name==ecrivain]
y_end<-df_net$yend[df_net$name==ecrivain]
for (i in 1:length(df_net$color_v)) {
for (j in 1:length(x_end)) {
if(df_net$x[i]==x_end[j] & df_net$y[i]==y_end[j]){
df_net$color_n[i]<-"reseau"}
}
}
for (i in 1:length(df_net$color_n)) {
if(sum(str_detect(df_net$color_n[i],"reseau"))>=1){
df_net$color_n[df_net$name==df_net$name[i]]<-"reseau"
}
}
df_net$ratio_moy[is.na(df_net$ratio_moy)]<-0
#df_net<-df_net[is.na(df_net$ratio_moy)==FALSE,]
plot=ggplot(df_net, aes(x = x, y = y, xend = xend, yend = yend, label=name)) +
geom_edges(aes(color = color,size=ratio_moy^2,text=etiquette), alpha=0.2) +
geom_nodes(aes(color = color_v,size=degree^2,text=texte), alpha=0.4)+
geom_nodetext(aes(text=texte,color=color_n), size=3, alpha=1)+
theme_blank(legend.title=element_blank())+guides(size=FALSE) + scale_color_manual(breaks = c("autre","autre ","reseau",ecrivain),
values=c("gray","black","red", "red"))
plot
#plot+ggsave("plot.png",scale=5)
plot2<-plot %>% ggplotly(tooltip="texte")
xmax=max(df_net$x[df_net$color_n=="reseau"])+0.05
xmin=min(df_net$x[df_net$color_n=="reseau"])-0.05
ymax=max(df_net$y[df_net$color_n=="reseau"])+0.05
ymin=min(df_net$y[df_net$color_n=="reseau"])-0.05
plot2<-plot2%>%layout(xaxis=list(range=c(xmin,xmax)),yaxis=list(range=c(ymin,ymax)))
return(plot2)
}
prepare_data<-function(input,liste){
from<-min(input$dateRange)
from=str_replace_all(from,"-","/")
to<-max(input$dateRange)
to=str_replace_all(to,"-","/")
tableau_croise<-as.data.frame(cbind(c(NA),c(NA)))
for (i in 1:length(liste$V1))
{
for (j in 1:length(liste$V1))
{
tableau_croise<-rbind(tableau_croise,cbind(liste$V1[i],liste$V1[j]))
}
}
tableau_croise<-tableau_croise[-1,]
colnames(tableau_croise)<-c("ecrivain_1","ecrivain_2")
tableau_croise<-tableau_croise[tableau_croise$ecrivain_1!=tableau_croise$ecrivain_2,]
tableau_croise1<-tableau_croise %>%
group_by(grp = paste(pmax(ecrivain_1, ecrivain_2), pmin(ecrivain_1, ecrivain_2), sep = "_")) %>%
slice(1) %>%
ungroup() %>%
select(-grp)
tableau_croise1$requete_1<-str_replace_all(tableau_croise1$ecrivain_1,"[:punct:]","%20")
tableau_croise1$requete_2<-str_replace_all(tableau_croise1$ecrivain_2,"[:punct:]","%20")
tableau_croise1$requete_1<-str_replace_all(tableau_croise1$requete_1," ","%20")
tableau_croise1$requete_2<-str_replace_all(tableau_croise1$requete_2," ","%20")
liste$requete<-str_replace_all(liste$V1,"[:punct:]","%20")
liste$requete<-str_replace_all(liste$requete," ","%20")
liste$base<-NA
for (i in 1:length(liste$base))
{tryCatch({
url_base<-str_c("https://gallica.bnf.fr/SRU?operation=searchRetrieve&exactSearch=true&maximumRecords=1&page=1&collapsing=false&version=1.2&query=(dc.language%20all%20%22fre%22)%20and%20(text%20adj%20%22",liste$requete[i],"%22%20)%20%20and%20(dc.type%20all%20%22fascicule%22)%20and%20(ocr.quality%20all%20%22Texte%20disponible%22)%20and%20(gallicapublication_date%3E=%22",from,"%22%20and%20gallicapublication_date%3C=%22",to,"%22)&suggest=10&keywords=",liste$requete[i])
ngram_base<-as.character(read_xml(url_base))
b<-str_extract(str_extract(ngram_base,"numberOfRecordsDecollapser>+[:digit:]+"),"[:digit:]+")
liste$base[i]<-b
print(i)
}, error=function(e){print("error")})}
tableau_croise1$count<-NA
for (i in 1:length(tableau_croise1$requete_1))
{tryCatch({
url_base<-str_c("https://gallica.bnf.fr/SRU?operation=searchRetrieve&exactSearch=true&maximumRecords=1&page=1&collapsing=false&version=1.2&query=(dc.language%20all%20%22fre%22)%20and%20((%20text%20adj%20%22",tableau_croise1$requete_1[i],"%22%20%20prox/unit=word/distance=",input$distance,"%20%22",tableau_croise1$requete_2[i],"%22))%20%20and%20(dc.type%20all%20%22fascicule%22)%20and%20(ocr.quality%20all%20%22Texte%20disponible%22)%20and%20(gallicapublication_date%3E=%22",from,"%22%20and%20gallicapublication_date%3C=%22",to,"%22)&suggest=10&keywords=")
ngram_base<-as.character(read_xml(url_base))
b<-str_extract(str_extract(ngram_base,"numberOfRecordsDecollapser>+[:digit:]+"),"[:digit:]+")
tableau_croise1$count[i]<-b
print(i)
}, error=function(e){print("error")})}
tableau_croise1$base1<-NA
tableau_croise1$base2<-NA
for (i in 1:length(liste$base))
{
tableau_croise1$base1[liste$V1[i]==tableau_croise1$ecrivain_1]<-liste$base[i]
tableau_croise1$base2[liste$V1[i]==tableau_croise1$ecrivain_2]<-liste$base[i]
}
tableau_croise1$count<-as.integer(tableau_croise1$count)
tableau_croise1$base1<-as.integer(tableau_croise1$base1)
tableau_croise1$base2<-as.integer(tableau_croise1$base2)
tableau_croise1$ratio_1<-tableau_croise1$count/tableau_croise1$base1
tableau_croise1$ratio_2<-tableau_croise1$count/tableau_croise1$base2
tableau_croise1$ratio_moy<-(tableau_croise1$ratio_1+tableau_croise1$ratio_2)/2
return(tableau_croise1)
}
options(shiny.maxRequestSize = 100*1024^2)
shinyServer(function(input, output){
tableau<-read.csv("exemple.csv",encoding = "UTF-8")
output$plot<-renderPlotly(Plot(input,tableau))
output$target_upload <- reactive({
return(!is.null(input$target_upload))
})
outputOptions(output, 'target_upload', suspendWhenHidden=FALSE)
observeEvent(input$do,
{
if (is.null(input$target_upload)){}
else{
inFile<-input$target_upload
liste<- read.csv(inFile$datapath, header = FALSE, encoding = "UTF-8")
}
tableau<<-prepare_data(input,liste)
output$plot<-renderPlotly(Plot(input,tableau))
})
# observeEvent(input$update,
# {
# output$plot<-renderPlotly(Plot(input,tableau))
# })
output$downloadData <- downloadHandler(
filename = function() {
paste('data_', Sys.Date(), '.csv', sep='')
},
content = function(con) {
write.csv(tableau, con, fileEncoding = "UTF-8",row.names = F)
})
output$downloadPlot <- downloadHandler(
filename = function() {
paste('plot_', Sys.Date(),'.html', sep='')
},
content = function(con) {
htmlwidgets::saveWidget(as_widget(Plot(input,tableau)), con)
})
shinyOptions(progress.style="old")
})