Setting the interaction model of a Dygraph in Shiny for R - r

I am looking to add the custom interaction seen at http://dygraphs.com/gallery/#g/interaction under "Custom interaction model" into my Shiny web app.
As far as I understand it, this requires attaching some JS to the page and setting the interaction model on the graph:
interactionModel : {
'mousedown' : downV3,
'mousemove' : moveV3,
'mouseup' : upV3,
'click' : clickV3,
'dblclick' : dblClickV3,
'mousewheel' : scrollV3
}
However, interactionModel does not seem to be listed as a parameter in the dyOptions function on the R side.
Is there a way to work around this?
Update:
Looking at the source for dyOptions, it seems that options can be modified directly:
g <- dyGraph(series)
g$x$attr$option <- "Value"
However, setting the interactionModel here does not seem to work.
See: https://github.com/rstudio/dygraphs/blob/master/R/options.R
Update:
You can indeed set the options using:
g$x$attrs$option <- "Value" # Note that it is "attrs", not "attr"
This can be used to switch off the interaction mode:
graph$x$attrs$interactionModel <- "{}"
The remaining problem is passing JS function references via JSON to the page.

You can use the JS function to pass JavaScript over JSON to the client.
In ui.R:
tags$head(tags$script(src="interaction.js"))
In server.R:
g <- dygraph(series(), main = "Graph", xlab = "Date", ylab = "Amount") %>%
dySeries(label = "X")
g$x$attrs$interactionModel <- list(
mousedown = JS("downV3"),
mousemove = JS("moveV3"),
mouseup = JS("upV3"),
click = JS("clickV3"),
dblclick = JS("dblClickV3"),
mousewheel = JS("scrollV3"))

Related

quantmod adds indicators twice to chart

When plotting a chart with quantmod's chartSeries() called from Shiny server, the technical indicators are added twice to the chart.
If the below code is executed from the console the results is as expected. When executed by the Shiny App server the RSI and MACD are added twice to the chart. Although the print statement only shows once.
getChart.raPortfolio <- function(obj) {
if(is.xts(obj$chart)) {
print("Was here!")
chart <- chartSeries(obj$chart,
name = obj$symbol,
theme = chartTheme("white"),
type = "line", TA=c(
addBBands(n = 50),
addMACD(fast = 12, slow = 26, signal = 9),
addRSI(n=14)
)
)
}
return(chart)
}
The problem was caused by the assign to chart object prior to return, which only caused an issue when called via Shiny (not when run on the console). Below behaves correctly, including when adding indicators.
getChart.raPortfolio <- function(obj) {
chartSeries(obj$data,
name = obj$symbol,
theme = chartTheme("white")
)}

My google_map is not reacting after switching between tabs in a shiny dashboard

I have a google map that shows markers whenever I click on the map. This map is located at one tab in my shiny dashboard. I also have there a table that shows the tabulated info of the markers.
So far, so good.
The problem appears when I switch to a any different tab and then I get back to the google map tab. The maps is not reacting, the markers are not updating despite the information on the table is. So, the problem is on the map itself.
Is there a way to keep, I don't know, active the map even if I'm in different tab, or the map refresh when I get back to the tab?
This is my sidebar
sidebar<-dashboardSidebar(
fluidRow(column(width = 12,
fluidRow(column(width = 12,
sidebarMenu(
id = "sidebar",
menuItem("Inicio", tabName="BVND"),
menuItem("Localizador", tabName="LOC"),
menuItem("HomologaciĆ³n", tabName="HOM")
)))
)
Inside the "Localizador" is where I call the map: google_mapOutput(outputId = "map",height = 600).
and in the output I have
google_map(key = map_key
,location = c(avia[2], avia[1],"red")
,data=distancia2
,zoom = 18
,height = 1500
) %>%
add_markers(lat="latitud"
,lon="longitud"
,title ="title"
,info_window="info_window"
,close_info_window=TRUE
,marker_icon = "icon"
)
I tried the updatetabitems, google_map_update, as reactives/observe in my output or the server itself
I solved the issue by "fragmenting" the observe.
The action is that the map updates whenever I click on it, and it wasn't doing it if I went to a different section of the app.
I rewrote the "click on map" action by using an observe containing google_map_update.
google_map_update( "map"
,session = shiny::getDefaultReactiveDomain()
) %>%
clear_markers( ) %>%
clear_polygons()
google_map_update( "map"
,session = shiny::getDefaultReactiveDomain()
) %>%
add_markers(data = data
,lat="latitud"
,lon="longitud"
,title ="title"
,info_window="info_window"
,close_info_window=TRUE
,marker_icon = "icon"
)
you have to be careful. For some reason in another action, the add_markers cause problems inside an observeEvent. So you might want to avoid or test the add_markers in an map update.
(Sorry I didn't wrote the example of the problem, it's kind of a big project and didn't have time to make a slim version of it. I hope at least it helps to another fellow with same or similar issues)

Search from a textInput to a Handsontable in Shiny

I've been working for some days with Handsontable in Shiny and I got stuck in what I guess will be a very dumb question but I have not this much idea how to solve.
I have a Handsontable that has a custom function that allows searching and it works. It works but is not intuitive enough because you have to right-click on the table to pop the search option.
Because of this, I decided that I would like to have a textInput that does the same function but in a prettier way. I know that it should be related with an observeEvent of the input variable (input$searchId) but I have no idea of how to do it due to my lack of experience with Shiny and Handsontable.
This is the code from server.R that prints the table and that has a custom function that allows the user to search.
output$hot <-renderRHandsontable({rhandsontable(Dataset(),height = 600)%>%
hot_table( columnSorting = TRUE,highlightCol = TRUE, highlightRow = TRUE, search = TRUE) %>%
hot_context_menu(
customOpts = list(
search = list(name = "Search",
callback = htmlwidgets::JS(
"function (key, options) {
var aux = document.getElementById('searchId').value;
var srch = prompt(Search);
this.search.query(srch);
this.render();
}")))) })
And what I would like is to archive the same result but without having to right-click on the table and create a prompt.
Thank you so much,
Well I've been able to solve my problem. I've been inspired by this post
and then I got with something like:
js_search <- "
$(document).ready(setTimeout(function() {
document.getElementById('searchId').onchange = function(e){
var hot_instance = HTMLWidgets.getInstance(hot).hot
console.log('hola')
var aux = document.getElementById('searchId').value;
hot_instance.search.query(aux);
hot_instance.render();
}
}))
"
that has to be included in your ui.R with a tags$head(tags$script(HTML(js_search)))
That's all the problem I was having is that I ahd no idea of how to get the "this" from the custom operation in the server side I had before. Once you know that is hot_instance. where hot is the name of my table, I think is easy.

R & gwidgets2 - Collecting values from gRadio widget

My problem is very basic (I am a beginner user in R). I am trying to collect the value selected from a gradio widget (gwidgets2 package for R).
I am using a similar script as this simplified one :
U=vector(mode="character")
DF=function() {
Win=gbasicdialog(handler=function(h,...) {
T=svalue(A)
print(T)
# I can print but not assign the value using : assign (U,T, .GlobalEnv)
})
A<-gradio(c("1","2","3"), selected=1,container=Win,)
out <- visible(Win)
}
DF()
Using this script, I am able to print the value selected in the gradio widget, but when I try to assign this value to another variable passed to the global environment, I get an error.
It is strange as this structure of script works fine to collect values from other widgets (like gtable). What am I doing wrong ?
Thanks for the help.
I am not sure what goes wrong, but was able to run your code with a small change:
DF <- function() {
Win <- gbasicdialog(
handler = function(h, ...) {
.GlobalEnv$varT = svalue(A)
print(varT)
}
)
A <- gradio(c("1", "2", "3"), selected = 1, container = Win)
out <- visible(Win)
}
DF()
A small advice: avoid using the single letters T or F, as in your code T might be interpreted as TRUE and not object T.

How to add tooltips for gactions in gmenu bars?

I want to add a tooltip which pops up (at the position of the curser) by mouse hovering over the specific entry in a menubar.
I am using Windows, gwidgets with RGtk2 and R version 3.0.3
My code looks like this:
PG_top <- gwindow(...)
action_list = list (
open = gaction(label = "Open...", tooltip = "Open a File", icon = "open", handler = openDialogHandler, parent = PG_top)
)
menu_bar_list <- list(File = list (
Open = action_list$open
)
)
menu_bar <- gmenu(menu_bar_list, cont=PG_top)
I get no error messages nor any tooltip. Is this a toolkit Problem? I found a Handler called "addHandlerMouseMotion" but I don't know if this works for my kind of problem and what to do inside this Handler. If I try
tooltip<-(action_list[["open"]],"Open File")
or
tooltip<-(action_list$open,"Open File")
I get the errormessage: Error in (...): unexpected ","
Hope you can help me!

Resources