Input ID in Shiny selectInput() not refreshing the results - r

I am trying to provide Organization name as input in ui.R as following -
selectInput("Organization", "Enter an Org:", choices = c("Blenheim Palace", "Chatsworth", "Gloucester Cathedral", "Manchester Cathedral", "Royal Albert Hall", "StPauls Cathedral"))
I try to use this input to refresh my wordcloud. Essentially when I select an organization, say Blenheim Palace, wordcloud should change with the comments for that organization from tripadvisor.com.
My server.R code is as following -
OrganizationInput <- reactive({switch(input$Organization, "Blenheim Palace" = Blenheim_Palace, "Chatsworth" = Chatsworth, "Gloucester Cathedral" = Gloucester_Cathedral, "Manchester Cathedral" = Manchester_Cathedral, "Royal Albert Hall" = Royal_Albert_Hall, "StPauls Cathedral" = StPauls_Cathedral)})
rawData <- reactive(function(){
some_txt <- sqlQuery(dbhandle, 'SELECT REVIEW_COMMENTS FROM XXXXXX.tripadvisor_data where brand_name = "OrganizationInput()"')
some_txt <- data.frame(some_txt)
I try to use rawData() as input for wordcloud. But I get following error -
Error: invalid 'cex' value, if I give individual names (say Blenheim Palace) in rawData, it works.
Any help/clarification will be highly appreciated.

If you want OrganizationInput to be a character string, do you need to enquote the values in switch a la:
OrganizationInput <- reactive({switch(input$Organization, "Blenheim Palace" = "Blenheim_Palace", "Chatsworth" = "Chatsworth", ...
Otherwise, you're trying to reference a variable named named Blenheim_Palace, which likely doesn't exist, right?

It was essentially a problem of parametrizing input$Organization in sqlQuery(). I used the idea from
R Shiny error 'closure' not subsettable
and it worked. thanks for looking into my question.

Related

bib list print to a character string in R

I'm reading a bib file extracted from Google Scholar with BIB <- bibtex::read.bib("file.bib") command and this created a list object. If I use paste(BIB) or as.character(BIB) the console shows for all items in the list lines like:
"list(title = "A Lealdade no Sistema Financeiro Portugu{\\^e}s", author = list(list(given = c("Francisco", "José", "dos", "Santos", "Mota", "Ferreira"), family = "Guerra", role = NULL, email = NULL, comment = NULL)), year = "2017", school = "Universidade de Coimbra")"
And if I use print() shows:
Guerra FJdSMF (2017). A Lealdade no Sistema Financeiro Português. Ph.D. thesis,
Universidade de Coimbra.
I need to extract the second kind to a new character string, but any command I try just doesn't work. I've tried A <- paste(print(BIB)), A <- as.character(print(BIB)) or just A <- print(BIB). I just get the first kind of line or an equal object.
I have already tried open the same file with bib2df::bib2df() but has some problems with the encoding and the dataframe's columns and rows
Try format(BIB) For example
bib <- read.bib( package = "bibtex" )
x <- format(bib)
x
# [1] "R Development Core Team (2009). _R: A Language and Environment for\nStatistical Computing_. R Foundation for Statistical Computing, Vienna,\nAustria. ISBN 3-900051-07-0, <http://www.R-project.org>."
I found this by looking at class(BIB) and saw "bibentry" then looked for all methods that recognize that object methods(class="bibentry") and format seemed like a good candidate.

CleanNLP package in R: metadata data frame?

Let's assume my dataframe looks like this:
bio_text <- c("Georg Aemilius, eigentlich Georg Oemler, andere Namensvariationen „Aemylius“ und „Emilius“ (* 25. Juni 1517 in Mansfeld; † 22. Mai 1569 in Stolberg (Harz))...", "Johannes Aepinus auch: Johann Hoeck, Huck, Hugk, Hoch oder Äpinus (* um 1499 in Ziesar; † 13. Mai 1553 in Hamburg) war ein deutscher evangelischer Theologe und Reformator.\nAepinus wurde als Sohn des Ratsherrn Hans Hoeck im brandenburgischen Ziesar 1499 geboren...")
doc_id <- c("1", "2")
url <- c("https://de.wikipedia.org/wiki/Georg_Aemilius", "https://de.wikipedia.org/wiki/Johannes_Aepinus")
name <- c("Aemilius, Georg", "Aepinus, Johannes")
place_of_birth <- c("Mansfeld", "Ziesar")
full_wikidata <- data.frame(bio_text, doc_id, url, name, place_of_birth)
I want to carry out Named Entity Recognition with the cleanNLP package in R. Therefore, I initialize the tokenizers and the spaCy backend, everything works fine:
options(stringsAsFactors = FALSE)
library(cleanNLP)
cnlp_init_tokenizers()
require(reticulate)
cnlp_init_spacy("de")
wikidata <- full_wikidata[,c("doc_id", "bio_text")]
wikimeta <- full_wikidata[,c("url", "name", "place_of_birth")]
spacy_annotatedWikidata <- cleanNLP::cnlp_annotate(wikidata, as_strings = TRUE, meta = wikimeta)
My only problem is the metadata. When I run it like this, I get the following warning message: In cleanNLP::cnlp_annotate(full_wikidata, as_strings = TRUE, meta = wikimeta) : data frame input given along with meta; ignoring the latter. To be honest, I don't get the documentation concerning meta in cnlp_annotate: "an optional data frame to bind to the document table". This means that I should deliver a data frame containing the metadata, right?! Later on, I want to be able to do something like this, e.g. filter out all person entities in document no. 3:
cnlp_get_entity(spacy_annotatedWikidata) %>%
filter(doc_id == 3, entity_type == "PER") %>%
count(entity)
Therefore, I have to find a way to access the metadata. Any help would be highly appreciated!
Fortunatelly, in the meantime I got some help and the advice to take a closer look at the method code of cnlp_annotate on Github: https://github.com/statsmaths/cleanNLP/blob/master/R/annotate.R
It says that you only can pass in a metadata dataframe if the input itself is not a dataframe but a file path. So if you do want to pass in a dataframe, the first row has to be doc_id, the second text and the remaining ones are automatically considered as metadata! So in my example only the order in full_wikidata has to be changed:
full_wikidata <- data.frame(doc_id, bio_text, url, name, place_of_birth)
Like this, it can be directly used as an input in clnp_annotate:
spacy_annotatedWikidata <- cleanNLP::cnlp_annotate(full_wikidata, as_strings = TRUE)

Does sql_variant in dbplyr work as it should?

Let's take a look at the example in ?sql_variant:
We define a new translator function for aggregated functions, expanded from the default one:
postgres_agg <- sql_translator(.parent = base_agg,
cor = sql_prefix("corr"),
cov = sql_prefix("covar_samp"),
sd = sql_prefix("stddev_samp"),
var = sql_prefix("var_samp")
)
We then define a new variant, which is made from translation functions of the 3 different types (here 2):
postgres_var <- sql_variant(
base_scalar,
postgres_agg
)
translate_sql(cor(x, y), variant = postgres_var)
# <SQL> COR("x", "y")
translate_sql(sd(income / years), variant = postgres_var)
# <SQL> SD("income" / "years")
These don't look translated to me, shouldn't they be "CORR" and "STDDEV_SAMP" ?
# Original comment:
# Any functions not explicitly listed in the converter will be translated
# to sql as is, so you don't need to convert all functions.
translate_sql(regr_intercept(y, x), variant = postgres_var)
# <SQL> REGR_INTERCEPT("y", "x")
This one behaves as expected, which is just like the other 2.
On the other hand default translated functions work, see:
translate_sql(mean(x), variant = postgres_var)
#<SQL> avg("x") OVER ()
It's a bug right ? or am I missing something ?
My goal is to create some variants for Oracle and use it in the following fashion,then for more complicated functions (example with SQLite to be reproducible):
con <- DBI::dbConnect(RSQLite::SQLite(), path = ":memory:")
copy_to(con, cars, "cars")
con %>% tbl("cars") %>% summarize(dist = group_concat(dist)) # works as expected, as we're stealing the keyword from sqlite directly
sqlite_variant <- sql_variant(aggregate=sql_translator(.parent = base_agg,gpc = sql_prefix("group_concat")))
con %>% tbl("cars") %>% summarize(dist = gpc(dist)) # how do I make this work ?
EDIT:
One bounty later still no solution, I've cross posted the issue in the dplyr/dbplyr github page directly where I'm not sure if it has or will get attention, but in case I (or someone else) don't update this in time, check this url : https://github.com/tidyverse/dplyr/issues/3117
This is what Hadley Wickham answered on provided github link:
translate_sql() doesn't have a variant argument any more
Indeed the variant argument is not documented, though the examples use it, I suppose it will be corrected for next version.
Asked how to define custom SQL translations he had this to offer:
Have a look at http://dbplyr.tidyverse.org/articles/new-backend.html
and http://dbplyr.tidyverse.org/articles/sql-translation.html
I guess another option is to get the older version of dbplyr::sql_variant.

R get_ga function: filter component

I want to get Google analytic data from a specific list of cardnumbers. The component ga:dimension10 contains the cardnumbers. The following code works:
ga_datasubset <- subset(get_ga(id, Startdatum, Einddatum,
metrics = c("ga:sessions", " ga:pageviews","ga:sessionDuration"),
dimensions="ga:dimension10, ga:deviceCategory, ga:medium",
fetch.by ="day"),
dimension10 %in% Datatest[,1])
But I want to make this code without using the subset function. I tried the code below, but this doesn’t work.
ga_datasubset <- get_ga(id, Startdatum, Einddatum,
metrics = c("ga:sessions", " ga:pageviews","ga:sessionDuration"),
dimensions="ga:dimension10, ga:deviceCategory, ga:medium",
filters ="ga:dimension10 %in% Datatest[,1]" ,
fetch.by ="day")
Error: Invalid parameter: Invalid value 'ga:dimension10 %in% Datatest[,1]' for filters parameter.
Any help will be greatly appreciated

error-safe templating with brew / whisker

An external program needs an input file with some control parameters, and I wish to generate those automatically using R. Usually, I simply use paste("parameter1: ", param1, ...) to create the long string of text, and output to a file, but the script rapidly becomes unreadable. This problem is probably well suited to whisker,
library(whisker)
template= 'Hello {{name}}
You have just won ${{value}}!
'
data <- list( name = "Chris", value= 124)
whisker.render(template, data)
My issue here, is that there's no safe-checking that data contains all the required variables, e.g.
whisker.render(template, data[-1])
will silently ignore the fact that I forgot to specify a name. My end-program will crash, however, if I fail to produce a complete config file.
Another templating system is provided by brew; it has the advantage of actually evaluating things, and potentially this can also help detect missing variables,
library(brew)
template2 = 'Hello <%= name %>
You have just won $<%= value %>!
'
data <- list( name = "Chris", value= 124)
own_brew <- function(template, values){
attach(values, pos=2)
out = capture.output(brew(text = template))
detach(values, pos=2)
cat(out, sep='\n')
invisible(out)
}
own_brew(template2, data)
own_brew(template2, data[-1]) # error
However, I am stuck with two issues:
attach() ... detach() is not ideal, (gives warnings every now and then), or at least I don't know how to use it properly. I tried to define an environment for brew(), but it was too restrictive and didn't know about base functions anymore...
even though an error occurs, a string is still returned by the function. I tried to wrap the call in try() but I have no experience in error handling. How do I tell it to quit the function producing no output?
Edit: I have updated the brew solution to use a new environment instead of attach(), and stop execution in case of an error. (?capture.output suggests that it was not the right function to use here, since "An attempt is made to write output as far as possible to file if there is an error in evaluating the expressions"...)
own_brew <- function(template, values, file=""){
env <- as.environment(values)
parent.env(env) <- .GlobalEnv
a <- textConnection("cout", "w")
out <- try(brew(text = template, envir=env, output=a))
if(inherits(out, "try-error")){
close(a)
stop()
}
cat(cout, file=file, sep="\n")
close(a)
invisible(cout)
}
There must be an easier way with tryCatch, but I can't understand a single thing in its help page.
I welcome other suggestions on the more general problem.
Using regular expressions to retrieve the variable names from the template, you could validate before rendering, e.g.,
render <- function(template, data) {
vars <- unlist(regmatches(template, gregexpr('(?<=\\{\\{)[[:alnum:]_.]+(?=\\}\\})', template, perl=TRUE)))
stopifnot(all(vars %in% names(data)))
whisker.render(template, data)
}
render(template, data)
The new glue package provides another alternative,
library(glue)
template <- 'Hello {name} You have just won ${value}!'
data <- list( name = "Chris", value= 124)
glue_data(template, .x=data)
# Hello Chris You have just won $124!
glue_data(template, .x=data[-1])
# Error in eval(expr, envir, enclos) : object 'name' not found
Since version 1.1.0 (on CRAN 19 Aug, 2016), the stringr package includes the str_interp() function (unfortunately not mentioned in the NEWS file of the release).
template <- "Hello ${name} You have just won $${value}!"
data <- list( name = "Chris", value= 124)
stringr::str_interp(template, data)
[1] "Hello Chris You have just won $124!"
stringr::str_interp(template, data[-1L])
Error in FUN(X[[i]], ...) : object 'name' not found
While preparing the stringr answer I noticed that OP's questions concerning the usage of brew() hasn't been addressed so far. In particular, the OP was asking how to provide his data to the environment and how to prevent a character string being returned in case of an error.
The OP has created a function own_brew() which wraps the call to brew(). Although, there are alternative package available now, I feel the original question deserves an answer.
This is my attempt to improve baptiste's version:
own_brew <- function(template, values, file=""){
a <- textConnection("cout", "w")
out <- brew::brew(text = template, envir=list2env(values), output=a)
close(a)
if (inherits(out, "try-error")) stop()
cat(cout, file=file, sep="\n")
invisible(cout)
}
The main differences are that list2env() is used to pass the list of values to brew() and that the call to try() is avoided by testing the return value out for an error.
template <- "Hello <%= name %> You have just won $<%= value %>!"
data <- list( name = "Chris", value= 124)
own_brew(template, data)
Hello Chris You have just won $124!
own_brew(template, data[-1L])
Error in cat(name) : object 'name' not found
Error in own_brew(template, data[-1L]) :
The new jinjar package will raise an error if a data variable is missing. It also provides the ability to explicitly handle missing values in your template.
library(jinjar)
# if name missing, raise error
template <- 'Hello {{ name }}
You have just won ${{ value }}!'
render(template, value = 124)
#> Error: [inja.exception.render_error] (at 1:10) variable 'name' not found
# if name missing, use default
template <- 'Hello {{ default(name, "world") }}
You have just won ${{ value }}!'
render(template, value = 124)
#> [1] "Hello world\nYou have just won $124!"
# if name missing, skip section
template <- '{% if exists("name") %}Hello {{ name }}{% endif -%}
You have just won ${{ value }}!'
render(template, value = 124)
#> [1] "You have just won $124!"
Created on 2022-06-25 by the reprex package (v2.0.1)

Resources