R/fct_opinometro.R
In EAMI91/textoMagisterio: Análisis de texto para preguntas poderosas
Defines functions
graficarOpinometro
graficarOpinometro <- function(bd,codigos,pregunta,tipo,sw,titulo,bd.preguntas){
tipo <- match.arg(tipo,choices = c("texto_barras","texto_spiderweb","texto_wordcloud","texto_mesas","categorica_barras",
"numerica_gauge","numerica_errorBar","numerica_histogram",
"numerica_spiderweb"))
if(tipo == "numerica_gauge"){
aux <- bd %>% summarise(y=round(mean(!!parse_quosure(pregunta), na.rm = T),1))
g <- aux%>% hchart(hcaes(y=y), type="gauge") %>%
hc_pane(startAngle=-90, endAngle=90, background=NULL) %>%
hc_yAxis(min=0, max=10,
lineColor= '#FFFFFF',
lineWidth=0,
gridLineWidth = 3,
labels=list(style=list(color="#356570", fontSize = "25px")),
tickColor= "#183E60",
title=list( tickColor= '#FFFFFF',text= "", style=list( fontSize="17px" )),
plotBands=list(list(from=0,to=2,color="#D80A45"),
list(from=2, to=4, color="#FE7E14"),
list(from=4,to=6,color="#FFC006"),
list(from=6, to=8, color="#7BED90"),
list(from=8, to=10, color="#43C631")
)) %>%
hc_plotOptions(series= list(dataLabels=list(enabled = F))) %>%
hc_tooltip(
positioner = JS(paste0("function (labelWidth, labelHeight) {return{x: (this.chart.plotLeft + (this.chart.plotWidth- this.chart.plotLeft)*",".4","),
y: (this.chart.plotHeight)-(this.chart.plotHeight-this.chart.plotTop)*", ".4","};}")),
headerFormat= '',
borderWidth= 0, shadow=F,
# backgroundColor= 'transparent',
pointFormat = '<b>Valor: </b> {point.y}<br>',
style= list(fontSize= "20px"
)
) %>%
hc_xAxis(
labels=list(style=list(color="#183E60", fontSize = "20px")),
crosshair= F,
# lineColor = "#FFFF",
lineWidth = 0,
tickColor= "#183E60",
title=list( tickColor= '#FFFFFF',text= "", style=list( fontSize="17px" ))) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "numerica_errorBar"){
aux <-bd %>% gather(key,value,str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>%
group_by(key) %>%
summarise(
m= round(mean(value, na.rm = T),1),
min=min(value, na.rm = T),
max=max(value, na.rm = T)) %>%
mutate(x=key) %>% left_join(bd.preguntas %>% select(id,pregunta), by = c("x"="id")) %>%
mutate(sidebar = paste("<font size='7px'>",pregunta, "<hr/>","Mínimo:",min,"<hr/>","Media",m,"<hr/>","Máximo:",max))
g <- aux %>% hchart(hcaes(low= min, high= max, x= pregunta), type= "errorbar") %>%
hc_add_series(data= aux ,type="scatter", hcaes(x= pregunta, y= m), marker=list(symbol="circle")) %>%
hc_chart(inverted=T, style=list(fontFamily="Avenir")) %>%
hc_plotOptions(errorbar=list(lineWidth=3, color= "#183E60"), scatter=list(marker=list(radius=10,
fillColor= "#FF8A7F"))
) %>%
hc_yAxis(gridLineColor= '#18A2B7',
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px"),
format=paste0("{value:,.0f}", "") ),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
tickLength= 5,
min = 0,
max =10 ,
crosshair = F,
title=list(style= list(color="#717B87", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
lineColor = "#575757",
lineWidth = 0,
title=list(style= list(color="#3D444C", fontSize = "20px"),
text= ""), tickColor= '#FFFFFF') %>% hc_tooltip(enabled = F) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "numerica_histogram"){
aux<-bd %>% count(!!parse_quosure(pregunta)) %>% set_names(c("x","y")) %>% na.omit()
g <-aux %>% hchart(hcaes(x= x, y = y),type= "column") %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_yAxis(gridLineColor= '#18A2B7',
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= T,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px"),
format=paste0("{value:,.0f}", "") ),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
tickLength= 5,
# max=100,
crosshair = F,
title=list(style= list(color="#717B87", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
lineColor = "#1A5A7C",
lineWidth = 0,
title=list(style= list(color="#3D444C", fontSize = "20px"),
text= ""), tickColor= '#FFFFFF') %>%
hc_legend(enabled = F) %>%
hc_tooltip(enabled= F) %>%
hc_colors("#FF8A7F") %>%
hc_plotOptions(
series=list(
borderRadius= 10,
pointWidth= 70,
opacity=.2,
dataLabels =list(
enabled=T,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast")
)
)
) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
# # hc_yAxis(gridLineColor= '#18A2B7',
# # gridLineWidth = 2.5,
# # gridLineDashStyle= "Dot",
# # reversedStacks= F,
# # gridZIndex= 1,
# # # labels=list(style=list(color="#717B87", fontSize = "20px"),
# # # format=paste0("{value:,.0f}", "") ),
# # tickAmount = 3,
# # tickColor = "#B8CBE5",
# # tickWidth = 2.5,
# # tickLength= 5,
# # crosshair = F,
# # title=list(style= list(color="#717B87", fontSize = "20px"),
# # text= ""),
# # lineColor= '#18A2B7',lineWidth= 3) %>%
# # hc_xAxis(labels=list(style=list(color="#10394F", fontSize = "23px")),
# # gridLineWidth = 0,
# # lineColor = "#1A5A7C",
# # lineWidth = 0,
# # title=list(style= list(color="#3D444C", fontSize = "20px"),
# # text= ""), tickColor= '#FFFFFF') %>%
# # hc_legend(enabled = F) %>%
# # hc_tooltip(enabled= F) %>%
# # hc_colors(color="#963484") %>%
# # hc_plotOptions(
# # series=list(
# # borderRadius= 10,
# # pointWidth= 70,
# # opacity=.2,
# # dataLabels =list(
# # enabled=T,
# # style=list(fontSize= "25px")
# )
# )
# )
}
if(tipo == "numerica_spiderweb"){
aux <- bd %>% gather("cat","frec",str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>%
group_by(id,cat) %>%
summarise(n=sum(frec)) %>%
ungroup() %>% mutate(id= as.character(id)) %>%
group_by(id) %>% mutate(suma= sum(n)) %>%
arrange(suma) %>% left_join(bd.preguntas %>% select(id,pregunta), by = c("cat"="id")) %>%
mutate(sidebar = paste(paste(pregunta,": " ,n, "<hr/>"), collapse = "")) %>% ungroup %>%
mutate(sidebar = paste("<font size='7px'>",sidebar,"Total: ",suma))
g <- aux %>%
hchart(hcaes(x=id, y=n, group= pregunta),type="bar") %>% hc_chart(polar = T) %>%
hc_xAxis(lineWidth=0,
labels=list(style=list(color="black",fontSize= "0px")),
title=list(text=""),
tickColor= '#FFFFFF',
gridLineWidth=0,
allowDecimals=F,
gridLineColor= "#34DDE2") %>%
hc_yAxis(gridLineColor= '#B8CBE5',
allowDecimals=F,
gridLineWidth = 1.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "0px")),
# max = max(aux$suma),
tickAmount = 4,
tickColor = "#F24800",
tickWidth = 2.5,
tickLength= 5,
crosshair = as.logical(F),
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 2) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') ) %>%
hc_subtitle(text="",
style=list(color="#015281",
fontSize="20px",
fontWeight='bold') ) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_plotOptions(bar=list(
allowPointSelect=T,
stacking = T,
dataLabels= list(enabled = as.logical(F),
align= "outside",
inside= F,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast"),
format = paste0("{point.y:,.1f} ", "")
),
enableMouseTracking = T,
lineWidth = 5)) %>%
hc_colors(colors=c("#F2916D", "#CAF76F", "#60D6D2", "#E667AD", "#F2E36D")) %>%
hc_tooltip(
positioner= JS(paste0("function (labelWidth, labelHeight) {return{x: (this.chart.plotLeft + (this.chart.plotWidth- this.chart.plotLeft)*",".8","),
y: (this.chart.plotHeight)-(this.chart.plotHeight-this.chart.plotTop)*", ".9","};}")),
style=list(fontSize= "30px"),
headerFormat = "",
pointFormat = '',
borderWidth= 0,
shadow=F,
shape ="square",
shared = T,
backgroundColor= 'transparent') %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )%>%
hc_legend(align="middle",
verticalAlign= 'bottom',
# layout= 'vertical',
itemStyle = list(fontSize = "20px"))
}
if(tipo == "categorica_barras"){
g <- bd %>% gather(a,b,contains(pregunta)) %>%
filter(!is.na(b)) %>%
group_by(a) %>% summarise(n=n()) %>% arrange(desc(n)) %>%
left_join(codigos %>% select(texto,codigo2), by = c("a"="codigo2")) %>%
hchart(hcaes(x=texto, y=n), type="bar") %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_yAxis(gridLineColor= '#18A2B7',
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px"),
format=paste0("{value:,.0f}", "") ),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
tickLength= 5,
# max=100,
crosshair = F,
title=list(style= list(color="#717B87", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
lineColor = "#1A5A7C",
lineWidth = 0,
title=list(style= list(color="#3D444C", fontSize = "20px"),
text= ""), tickColor= '#FFFFFF') %>%
hc_legend(enabled = F) %>%
hc_tooltip(enabled= F) %>%
hc_colors("#FF8A7F") %>%
hc_plotOptions(
series=list(
borderRadius= 10,
pointWidth= 70,
opacity=.2,
dataLabels =list(
enabled=T,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast")
)
)
) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "texto_barras"){
bd %<>% select(str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>% na.omit
pregunta <- sprintf("paste(%s)",pregunta)
enunciados <- bd %>% na.omit %>%
mutate(Texto := !!parse_quosure(pregunta)) %>%
unnest_tokens(input = Texto, output = enunciado, token="sentences",drop = T) %>%
select(enunciado) %>% na.omit()
coll <- enunciados %>% discursera_collocations(texto = "enunciado", sw=sw) %>%
mutate(Palabras=gsub(replacement = "_",x = Palabras, pattern=" "))
enunciados
g <- coll %>% mutate( Palabras = str_to_sentence(Palabras),
sidebar=paste0("<font size='7px'>", Palabras," (",n,") :<hr/>",
map_chr(.x=coll$Palabras,
.f=~enunciados %>%
filter(grepl(pattern=.x, x = enunciado,fixed = T)) %>%
pull(enunciado) %>% str_to_sentence() %>%
paste(collapse="<hr/>")),"</font>")) %>%
filter(!grepl("[0-9]",Palabras)) %>%
arrange(desc(n)) %>% slice(1:10) %>%
hchart(hcaes(x=Palabras, y=n), type="bar") %>%
hc_yAxis(gridLineColor= '#B8CBE5',
allowDecimals=F,
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px")),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
crosshair = as.logical(F),
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
tickWidth = 0,
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor = "#FFFF", lineWidth = 2.6,
crosshair = as.logical(F)) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_tooltip(enabled=F) %>%
hc_plotOptions(series=list(borderRadius= 10,stacking=F, colorByPoint=T,
allowPointSelect= T,
dataLabels= list(enabled = as.logical(T),
align= "outside",
inside= F,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast"),
format = paste0("{point.y:,.0f} ", "")
))) %>%
hc_colors("#FF8A7F") %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "texto_spiderweb"){
bd %<>% select(str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>% na.omit
pregunta <- sprintf("paste(%s)",pregunta)
enunciados <- bd %>% na.omit %>%
mutate(Texto := !!parse_quosure(pregunta)) %>%
unnest_tokens(input = Texto, output = enunciado, token="sentences",drop = T) %>%
select(enunciado) %>% na.omit()
coll <- enunciados %>% discursera_collocations(texto = "enunciado", sw=sw)
g <- coll %>% mutate(sidebar=paste0("<font size='7px'>", Palabras," (",n,") :<hr/>",
map_chr(.x=coll$Palabras,
.f=~enunciados %>%
filter(grepl(pattern=.x, x = enunciado,fixed = T)) %>%
pull(enunciado) %>% str_to_sentence() %>%
paste(collapse="<hr/>")),"</font>")) %>%
filter(!grepl("[0-9]",Palabras)) %>%
# arrange(desc(n)) %>%
slice(1:10) %>%
arrange(Palabras) %>%
mutate(Palabras = str_to_sentence(Palabras)) %>%
hchart(hcaes(x=Palabras, y=n ),type="area") %>% hc_chart(polar = T) %>%
hc_xAxis(lineWidth=0,
labels=list(style=list(color="#356570", fontSize = "30px")),
title=list(text=""),
tickColor= '#FFFFFF',
gridLineWidth=1,
allowDecimals=F,
gridLineColor= "#34DDE2") %>%
hc_yAxis(gridLineColor= '#B8CBE5',
allowDecimals=F,
gridLineWidth = 1.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(enabled = F, style=list(color="#356570", fontSize = "0px")),
tickAmount = 5,
tickColor = "#F24800",
tickWidth = 2.5,
tickLength= 5,
crosshair = as.logical(F),
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor= '#249A9E',lineWidth= 2) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )%>%
hc_subtitle(text="",
style=list(color="#015281",
fontSize="20px",
fontWeight='bold') ) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_plotOptions(bar=list(
dataLabels= list(enabled = as.logical(T),
align= "outside",
inside= F,
style=list(color="#548E99", fontSize = "27px", textOutline= "3px contrast"),
format = paste0("{point.y:,.1f} ", "")
),
enableMouseTracking = F,
lineWidth = 5)) %>%
hc_colors("#FF8A7F") %>%
hc_tooltip(
style=list(fontSize= "30px"),
headerFormat = "<b>{point.Palabras}</b>",
pointFormat = '{point.y}',
borderWidth= .5,
shadow=F,
backgroundColor= 'white'
)
}
if(tipo == "texto_wordcloud"){
bd %<>% select(str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>% na.omit
pregunta <- sprintf("paste(%s)",pregunta)
enunciados <- bd %>% na.omit %>%
mutate(Texto := !!parse_quosure(pregunta)) %>%
unnest_tokens(input = Texto, output = enunciado, token="sentences",drop = T) %>%
select(enunciado) %>% na.omit()
coll <- enunciados %>% discursera_collocations(texto = "enunciado", sw=sw)
g <- coll %>% mutate(sidebar=paste0("<font size='7px'>", Palabras," (",n,") :<hr/>",
map_chr(.x=coll$Palabras,
.f=~enunciados %>%
filter(grepl(pattern=.x, x = enunciado,fixed = T)) %>%
pull(enunciado) %>% str_to_sentence() %>%
paste(collapse="<hr/>")),"</font>")) %>%
# mutate(sidebar = gsub(pattern = Palabras,replacement = strong(Palabras),x = sidebar)) %>%
arrange(desc(n)) %>%
filter(!grepl("[0-9]",Palabras)) %>%
mutate(colores = case_when(n<=quantile(n,probs=.75)~"#F24800",
n>=quantile(n,probs=.75) & n<=quantile(n,probs=.90)~"#FF8A7F",
n>=quantile(n,probs=.90)~"#0C5566"),
Palabras = case_when(colores == "#0C5566"~ paste0("<b>", Palabras, "</b>"),
T~ Palabras
)
) %>%
hchart(hcaes(x= Palabras, weight =log(n), color=colores), type= "wordcloud") %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_tooltip(enabled=F,
pointFormat= '<b>Frecuencia:<b/> {point.n}<br> <b>Frases mencionadas:<b/> <br>{point.sidebar}',
headerFormat= '',
backgroundColor= '#FFFFFF',
style=list(fontSize ="25px", color = "#005B70")) %>%
hc_plotOptions( wordcloud= list(allowPointSelect=T,
style=list( '{"fontFamily":"Avenir", "fontWeight": "200"}'))) %>%
hc_title(text=titulo,
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "texto_mesas"){
bd %<>% select(id, str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>%
arrange(id) %>% mutate(rw=row_number()) %>%
na.omit
pregunta <- sprintf("paste(%s, sep='. \n')",pregunta)
aux <- bd %>%
mutate(Texto:= !!parse_quosure(pregunta),
id= as.character(id),
x= row_number(),
Texto=str_to_sentence(Texto)) %>%
select(id, x, Texto, rw)
mesas <- aux %>% nrow()
columnas <- floor(sqrt(mesas*6/3))
aux %<>% mutate(y=ceiling(x/columnas), x=(x-1)%%columnas+1)
g <- aux %>% mutate(sidebar= paste0("<hr/> <font size='7px'>",rw, "</font>","<hr/> <font size='7px'>" ,Texto, "</font>")) %>%
hchart(hcaes(x=x, y= y), type="scatter") %>%
hc_plotOptions( series = list(
marker=list(
symbol='url(https://cdn.iconscout.com/icon/free/png-256/meeting-1543537-1306029.png)',
width=400/columnas,
height= 400/columnas
),
dataLabels= list(enabled = T,
inside= T,
y= 70,
align="center",
style=list(color="#183E60", fontSize = "35px",
textOutline= "3px contrast"),
format = paste0("{point.rw}") ))) %>%
hc_tooltip(enabled = F, headerFormat = "", borderColor="none", lineWidth=0,
shape = "",
backgroundColor ="white",
positioner= JS(paste0("function (labelWidth, labelHeight) {return{x: 0*(this.chart.plotLeft + (this.chart.plotWidth- this.chart.plotLeft)*",".0","),
y: (this.chart.plotHeight)-(this.chart.plotHeight-this.chart.plotTop)*", ".98","};}")),
pointFormat = " {point.Texto}",
style=list(fontSize="35px")) %>%
hc_yAxis(lineWidth =0, labels= list(enabled=F), gridLineWidth =0,
max=max(aux$y)+1, min =0,
title= list(text= "")) %>%
hc_xAxis(gridLineWidth =0, lineWidth=0,
tickWidth = 0,min=0, max=columnas+1,
title = list(text = ""),
labels= list(enabled=F,
style= list(fontSize= "25px"))) %>%
hc_chart(zoomType= 'xy', style=list(fontFamily="Avenir")) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
g %<>% hc_title(text=titulo)
return(g)
}
EAMI91/textoMagisterio documentation built on Oct. 9, 2020, 2:27 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions graficarOpinometro
graficarOpinometro <- function(bd,codigos,pregunta,tipo,sw,titulo,bd.preguntas){
tipo <- match.arg(tipo,choices = c("texto_barras","texto_spiderweb","texto_wordcloud","texto_mesas","categorica_barras",
"numerica_gauge","numerica_errorBar","numerica_histogram",
"numerica_spiderweb"))
if(tipo == "numerica_gauge"){
aux <- bd %>% summarise(y=round(mean(!!parse_quosure(pregunta), na.rm = T),1))
g <- aux%>% hchart(hcaes(y=y), type="gauge") %>%
hc_pane(startAngle=-90, endAngle=90, background=NULL) %>%
hc_yAxis(min=0, max=10,
lineColor= '#FFFFFF',
lineWidth=0,
gridLineWidth = 3,
labels=list(style=list(color="#356570", fontSize = "25px")),
tickColor= "#183E60",
title=list( tickColor= '#FFFFFF',text= "", style=list( fontSize="17px" )),
plotBands=list(list(from=0,to=2,color="#D80A45"),
list(from=2, to=4, color="#FE7E14"),
list(from=4,to=6,color="#FFC006"),
list(from=6, to=8, color="#7BED90"),
list(from=8, to=10, color="#43C631")
)) %>%
hc_plotOptions(series= list(dataLabels=list(enabled = F))) %>%
hc_tooltip(
positioner = JS(paste0("function (labelWidth, labelHeight) {return{x: (this.chart.plotLeft + (this.chart.plotWidth- this.chart.plotLeft)*",".4","),
y: (this.chart.plotHeight)-(this.chart.plotHeight-this.chart.plotTop)*", ".4","};}")),
headerFormat= '',
borderWidth= 0, shadow=F,
# backgroundColor= 'transparent',
pointFormat = '<b>Valor: </b> {point.y}<br>',
style= list(fontSize= "20px"
)
) %>%
hc_xAxis(
labels=list(style=list(color="#183E60", fontSize = "20px")),
crosshair= F,
# lineColor = "#FFFF",
lineWidth = 0,
tickColor= "#183E60",
title=list( tickColor= '#FFFFFF',text= "", style=list( fontSize="17px" ))) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "numerica_errorBar"){
aux <-bd %>% gather(key,value,str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>%
group_by(key) %>%
summarise(
m= round(mean(value, na.rm = T),1),
min=min(value, na.rm = T),
max=max(value, na.rm = T)) %>%
mutate(x=key) %>% left_join(bd.preguntas %>% select(id,pregunta), by = c("x"="id")) %>%
mutate(sidebar = paste("<font size='7px'>",pregunta, "<hr/>","Mínimo:",min,"<hr/>","Media",m,"<hr/>","Máximo:",max))
g <- aux %>% hchart(hcaes(low= min, high= max, x= pregunta), type= "errorbar") %>%
hc_add_series(data= aux ,type="scatter", hcaes(x= pregunta, y= m), marker=list(symbol="circle")) %>%
hc_chart(inverted=T, style=list(fontFamily="Avenir")) %>%
hc_plotOptions(errorbar=list(lineWidth=3, color= "#183E60"), scatter=list(marker=list(radius=10,
fillColor= "#FF8A7F"))
) %>%
hc_yAxis(gridLineColor= '#18A2B7',
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px"),
format=paste0("{value:,.0f}", "") ),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
tickLength= 5,
min = 0,
max =10 ,
crosshair = F,
title=list(style= list(color="#717B87", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
lineColor = "#575757",
lineWidth = 0,
title=list(style= list(color="#3D444C", fontSize = "20px"),
text= ""), tickColor= '#FFFFFF') %>% hc_tooltip(enabled = F) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "numerica_histogram"){
aux<-bd %>% count(!!parse_quosure(pregunta)) %>% set_names(c("x","y")) %>% na.omit()
g <-aux %>% hchart(hcaes(x= x, y = y),type= "column") %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_yAxis(gridLineColor= '#18A2B7',
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= T,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px"),
format=paste0("{value:,.0f}", "") ),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
tickLength= 5,
# max=100,
crosshair = F,
title=list(style= list(color="#717B87", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
lineColor = "#1A5A7C",
lineWidth = 0,
title=list(style= list(color="#3D444C", fontSize = "20px"),
text= ""), tickColor= '#FFFFFF') %>%
hc_legend(enabled = F) %>%
hc_tooltip(enabled= F) %>%
hc_colors("#FF8A7F") %>%
hc_plotOptions(
series=list(
borderRadius= 10,
pointWidth= 70,
opacity=.2,
dataLabels =list(
enabled=T,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast")
)
)
) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
# # hc_yAxis(gridLineColor= '#18A2B7',
# # gridLineWidth = 2.5,
# # gridLineDashStyle= "Dot",
# # reversedStacks= F,
# # gridZIndex= 1,
# # # labels=list(style=list(color="#717B87", fontSize = "20px"),
# # # format=paste0("{value:,.0f}", "") ),
# # tickAmount = 3,
# # tickColor = "#B8CBE5",
# # tickWidth = 2.5,
# # tickLength= 5,
# # crosshair = F,
# # title=list(style= list(color="#717B87", fontSize = "20px"),
# # text= ""),
# # lineColor= '#18A2B7',lineWidth= 3) %>%
# # hc_xAxis(labels=list(style=list(color="#10394F", fontSize = "23px")),
# # gridLineWidth = 0,
# # lineColor = "#1A5A7C",
# # lineWidth = 0,
# # title=list(style= list(color="#3D444C", fontSize = "20px"),
# # text= ""), tickColor= '#FFFFFF') %>%
# # hc_legend(enabled = F) %>%
# # hc_tooltip(enabled= F) %>%
# # hc_colors(color="#963484") %>%
# # hc_plotOptions(
# # series=list(
# # borderRadius= 10,
# # pointWidth= 70,
# # opacity=.2,
# # dataLabels =list(
# # enabled=T,
# # style=list(fontSize= "25px")
# )
# )
# )
}
if(tipo == "numerica_spiderweb"){
aux <- bd %>% gather("cat","frec",str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>%
group_by(id,cat) %>%
summarise(n=sum(frec)) %>%
ungroup() %>% mutate(id= as.character(id)) %>%
group_by(id) %>% mutate(suma= sum(n)) %>%
arrange(suma) %>% left_join(bd.preguntas %>% select(id,pregunta), by = c("cat"="id")) %>%
mutate(sidebar = paste(paste(pregunta,": " ,n, "<hr/>"), collapse = "")) %>% ungroup %>%
mutate(sidebar = paste("<font size='7px'>",sidebar,"Total: ",suma))
g <- aux %>%
hchart(hcaes(x=id, y=n, group= pregunta),type="bar") %>% hc_chart(polar = T) %>%
hc_xAxis(lineWidth=0,
labels=list(style=list(color="black",fontSize= "0px")),
title=list(text=""),
tickColor= '#FFFFFF',
gridLineWidth=0,
allowDecimals=F,
gridLineColor= "#34DDE2") %>%
hc_yAxis(gridLineColor= '#B8CBE5',
allowDecimals=F,
gridLineWidth = 1.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "0px")),
# max = max(aux$suma),
tickAmount = 4,
tickColor = "#F24800",
tickWidth = 2.5,
tickLength= 5,
crosshair = as.logical(F),
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 2) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') ) %>%
hc_subtitle(text="",
style=list(color="#015281",
fontSize="20px",
fontWeight='bold') ) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_plotOptions(bar=list(
allowPointSelect=T,
stacking = T,
dataLabels= list(enabled = as.logical(F),
align= "outside",
inside= F,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast"),
format = paste0("{point.y:,.1f} ", "")
),
enableMouseTracking = T,
lineWidth = 5)) %>%
hc_colors(colors=c("#F2916D", "#CAF76F", "#60D6D2", "#E667AD", "#F2E36D")) %>%
hc_tooltip(
positioner= JS(paste0("function (labelWidth, labelHeight) {return{x: (this.chart.plotLeft + (this.chart.plotWidth- this.chart.plotLeft)*",".8","),
y: (this.chart.plotHeight)-(this.chart.plotHeight-this.chart.plotTop)*", ".9","};}")),
style=list(fontSize= "30px"),
headerFormat = "",
pointFormat = '',
borderWidth= 0,
shadow=F,
shape ="square",
shared = T,
backgroundColor= 'transparent') %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )%>%
hc_legend(align="middle",
verticalAlign= 'bottom',
# layout= 'vertical',
itemStyle = list(fontSize = "20px"))
}
if(tipo == "categorica_barras"){
g <- bd %>% gather(a,b,contains(pregunta)) %>%
filter(!is.na(b)) %>%
group_by(a) %>% summarise(n=n()) %>% arrange(desc(n)) %>%
left_join(codigos %>% select(texto,codigo2), by = c("a"="codigo2")) %>%
hchart(hcaes(x=texto, y=n), type="bar") %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_yAxis(gridLineColor= '#18A2B7',
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px"),
format=paste0("{value:,.0f}", "") ),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
tickLength= 5,
# max=100,
crosshair = F,
title=list(style= list(color="#717B87", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
lineColor = "#1A5A7C",
lineWidth = 0,
title=list(style= list(color="#3D444C", fontSize = "20px"),
text= ""), tickColor= '#FFFFFF') %>%
hc_legend(enabled = F) %>%
hc_tooltip(enabled= F) %>%
hc_colors("#FF8A7F") %>%
hc_plotOptions(
series=list(
borderRadius= 10,
pointWidth= 70,
opacity=.2,
dataLabels =list(
enabled=T,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast")
)
)
) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "texto_barras"){
bd %<>% select(str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>% na.omit
pregunta <- sprintf("paste(%s)",pregunta)
enunciados <- bd %>% na.omit %>%
mutate(Texto := !!parse_quosure(pregunta)) %>%
unnest_tokens(input = Texto, output = enunciado, token="sentences",drop = T) %>%
select(enunciado) %>% na.omit()
coll <- enunciados %>% discursera_collocations(texto = "enunciado", sw=sw) %>%
mutate(Palabras=gsub(replacement = "_",x = Palabras, pattern=" "))
enunciados
g <- coll %>% mutate( Palabras = str_to_sentence(Palabras),
sidebar=paste0("<font size='7px'>", Palabras," (",n,") :<hr/>",
map_chr(.x=coll$Palabras,
.f=~enunciados %>%
filter(grepl(pattern=.x, x = enunciado,fixed = T)) %>%
pull(enunciado) %>% str_to_sentence() %>%
paste(collapse="<hr/>")),"</font>")) %>%
filter(!grepl("[0-9]",Palabras)) %>%
arrange(desc(n)) %>% slice(1:10) %>%
hchart(hcaes(x=Palabras, y=n), type="bar") %>%
hc_yAxis(gridLineColor= '#B8CBE5',
allowDecimals=F,
gridLineWidth = 2.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(style=list(color="#356570", fontSize = "25px")),
tickAmount = 3,
tickColor = "#B8CBE5",
tickWidth = 2.5,
crosshair = as.logical(F),
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor= '#34DDE2',lineWidth= 3) %>%
hc_xAxis(labels=list(style=list(color="#356570", fontSize = "35px")),
gridLineWidth = 0,
tickWidth = 0,
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor = "#FFFF", lineWidth = 2.6,
crosshair = as.logical(F)) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_tooltip(enabled=F) %>%
hc_plotOptions(series=list(borderRadius= 10,stacking=F, colorByPoint=T,
allowPointSelect= T,
dataLabels= list(enabled = as.logical(T),
align= "outside",
inside= F,
style=list(color="#548E99", fontSize = "27px",
textOutline= "3px contrast"),
format = paste0("{point.y:,.0f} ", "")
))) %>%
hc_colors("#FF8A7F") %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "texto_spiderweb"){
bd %<>% select(str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>% na.omit
pregunta <- sprintf("paste(%s)",pregunta)
enunciados <- bd %>% na.omit %>%
mutate(Texto := !!parse_quosure(pregunta)) %>%
unnest_tokens(input = Texto, output = enunciado, token="sentences",drop = T) %>%
select(enunciado) %>% na.omit()
coll <- enunciados %>% discursera_collocations(texto = "enunciado", sw=sw)
g <- coll %>% mutate(sidebar=paste0("<font size='7px'>", Palabras," (",n,") :<hr/>",
map_chr(.x=coll$Palabras,
.f=~enunciados %>%
filter(grepl(pattern=.x, x = enunciado,fixed = T)) %>%
pull(enunciado) %>% str_to_sentence() %>%
paste(collapse="<hr/>")),"</font>")) %>%
filter(!grepl("[0-9]",Palabras)) %>%
# arrange(desc(n)) %>%
slice(1:10) %>%
arrange(Palabras) %>%
mutate(Palabras = str_to_sentence(Palabras)) %>%
hchart(hcaes(x=Palabras, y=n ),type="area") %>% hc_chart(polar = T) %>%
hc_xAxis(lineWidth=0,
labels=list(style=list(color="#356570", fontSize = "30px")),
title=list(text=""),
tickColor= '#FFFFFF',
gridLineWidth=1,
allowDecimals=F,
gridLineColor= "#34DDE2") %>%
hc_yAxis(gridLineColor= '#B8CBE5',
allowDecimals=F,
gridLineWidth = 1.5,
gridLineDashStyle= "Dot",
reversedStacks= F,
gridZIndex= 1,
labels=list(enabled = F, style=list(color="#356570", fontSize = "0px")),
tickAmount = 5,
tickColor = "#F24800",
tickWidth = 2.5,
tickLength= 5,
crosshair = as.logical(F),
title=list(style= list(color="#0B2545", fontSize = "20px"),
text= ""),
lineColor= '#249A9E',lineWidth= 2) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )%>%
hc_subtitle(text="",
style=list(color="#015281",
fontSize="20px",
fontWeight='bold') ) %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_plotOptions(bar=list(
dataLabels= list(enabled = as.logical(T),
align= "outside",
inside= F,
style=list(color="#548E99", fontSize = "27px", textOutline= "3px contrast"),
format = paste0("{point.y:,.1f} ", "")
),
enableMouseTracking = F,
lineWidth = 5)) %>%
hc_colors("#FF8A7F") %>%
hc_tooltip(
style=list(fontSize= "30px"),
headerFormat = "<b>{point.Palabras}</b>",
pointFormat = '{point.y}',
borderWidth= .5,
shadow=F,
backgroundColor= 'white'
)
}
if(tipo == "texto_wordcloud"){
bd %<>% select(str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>% na.omit
pregunta <- sprintf("paste(%s)",pregunta)
enunciados <- bd %>% na.omit %>%
mutate(Texto := !!parse_quosure(pregunta)) %>%
unnest_tokens(input = Texto, output = enunciado, token="sentences",drop = T) %>%
select(enunciado) %>% na.omit()
coll <- enunciados %>% discursera_collocations(texto = "enunciado", sw=sw)
g <- coll %>% mutate(sidebar=paste0("<font size='7px'>", Palabras," (",n,") :<hr/>",
map_chr(.x=coll$Palabras,
.f=~enunciados %>%
filter(grepl(pattern=.x, x = enunciado,fixed = T)) %>%
pull(enunciado) %>% str_to_sentence() %>%
paste(collapse="<hr/>")),"</font>")) %>%
# mutate(sidebar = gsub(pattern = Palabras,replacement = strong(Palabras),x = sidebar)) %>%
arrange(desc(n)) %>%
filter(!grepl("[0-9]",Palabras)) %>%
mutate(colores = case_when(n<=quantile(n,probs=.75)~"#F24800",
n>=quantile(n,probs=.75) & n<=quantile(n,probs=.90)~"#FF8A7F",
n>=quantile(n,probs=.90)~"#0C5566"),
Palabras = case_when(colores == "#0C5566"~ paste0("<b>", Palabras, "</b>"),
T~ Palabras
)
) %>%
hchart(hcaes(x= Palabras, weight =log(n), color=colores), type= "wordcloud") %>%
hc_chart(style=list(fontFamily="Avenir")) %>%
hc_tooltip(enabled=F,
pointFormat= '<b>Frecuencia:<b/> {point.n}<br> <b>Frases mencionadas:<b/> <br>{point.sidebar}',
headerFormat= '',
backgroundColor= '#FFFFFF',
style=list(fontSize ="25px", color = "#005B70")) %>%
hc_plotOptions( wordcloud= list(allowPointSelect=T,
style=list( '{"fontFamily":"Avenir", "fontWeight": "200"}'))) %>%
hc_title(text=titulo,
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
if(tipo == "texto_mesas"){
bd %<>% select(id, str_split(string = pregunta,pattern = ", ") %>% pluck(1)) %>%
arrange(id) %>% mutate(rw=row_number()) %>%
na.omit
pregunta <- sprintf("paste(%s, sep='. \n')",pregunta)
aux <- bd %>%
mutate(Texto:= !!parse_quosure(pregunta),
id= as.character(id),
x= row_number(),
Texto=str_to_sentence(Texto)) %>%
select(id, x, Texto, rw)
mesas <- aux %>% nrow()
columnas <- floor(sqrt(mesas*6/3))
aux %<>% mutate(y=ceiling(x/columnas), x=(x-1)%%columnas+1)
g <- aux %>% mutate(sidebar= paste0("<hr/> <font size='7px'>",rw, "</font>","<hr/> <font size='7px'>" ,Texto, "</font>")) %>%
hchart(hcaes(x=x, y= y), type="scatter") %>%
hc_plotOptions( series = list(
marker=list(
symbol='url(https://cdn.iconscout.com/icon/free/png-256/meeting-1543537-1306029.png)',
width=400/columnas,
height= 400/columnas
),
dataLabels= list(enabled = T,
inside= T,
y= 70,
align="center",
style=list(color="#183E60", fontSize = "35px",
textOutline= "3px contrast"),
format = paste0("{point.rw}") ))) %>%
hc_tooltip(enabled = F, headerFormat = "", borderColor="none", lineWidth=0,
shape = "",
backgroundColor ="white",
positioner= JS(paste0("function (labelWidth, labelHeight) {return{x: 0*(this.chart.plotLeft + (this.chart.plotWidth- this.chart.plotLeft)*",".0","),
y: (this.chart.plotHeight)-(this.chart.plotHeight-this.chart.plotTop)*", ".98","};}")),
pointFormat = " {point.Texto}",
style=list(fontSize="35px")) %>%
hc_yAxis(lineWidth =0, labels= list(enabled=F), gridLineWidth =0,
max=max(aux$y)+1, min =0,
title= list(text= "")) %>%
hc_xAxis(gridLineWidth =0, lineWidth=0,
tickWidth = 0,min=0, max=columnas+1,
title = list(text = ""),
labels= list(enabled=F,
style= list(fontSize= "25px"))) %>%
hc_chart(zoomType= 'xy', style=list(fontFamily="Avenir")) %>%
hc_title(text="Título",
style=list(color="#183E60",fontSize = "35px",
fontWeight='bold') )
}
g %<>% hc_title(text=titulo)
return(g)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.