I'm new to R6 and object oriented programming, so i'm not sure the right way to even talk about dependencies between fields inside an object.
My objects have fields that are dependent on other fields inside the object. I would like those dependent fields to automatically update when one of the inputs is updated.
I have figured out a manual way of doing this, but thought that there may be a better way. I played around with active fields but i could not get them to work.
This example should make it clear. I have an object quad that takes width and height and calculates area. I would like area to be automatically updated when width or height are updated.
This seems to be one of the things that active fields are intended to achieve, but i couldn't make them work.
For the purpose of exposition i hacked to my goal by including a re-calculation line for self$area in the set method for each field.
How is this supposed to be done?
library(R6)
quad <- R6Class("quad", public =
list(width = NULL,
height = NULL,
area = NULL,
initialize = function(width, height) {
self$width <- width
self$height <- height
self$area = self$width * self$height
self$greet()
},
set_width = function(W) {
self$width <- W
self$area = self$width * self$height #hack
},
set_height = function(H) {
self$height <- H
self$area = self$width * self$height #hack
},
greet = function() {
cat(paste0("your quad has area: ", self$area, ".\n"))
})
)
#
> quad1 <- quad$new(5, 5)
your quad has area: 25.
> quad1$set_height(10)
> quad1$area
[1] 50
An active binding is essentially a function that is invoked without needing to use (), so it looks like a regular field.
In the example below, area is an active binding and is computed each time you access it.
library(R6)
Quad <- R6Class(
"Quad",
public = list(
initialize = function(width, height) {
self$width <- width
self$height <- height
},
width = NULL,
height = NULL
),
active = list(
area = function() {
self$width * self$height
}
)
)
q <- Quad$new(8, 3)
q$area
#> [1] 24
q$height <- 5
q$area
#> [1] 40
I'm pretty new to IDL and as a way to learn I have tried to create a number guessing game. I have a Widget with three buttons: One that tells the program the number you are thinking of is larger than the one the computer asks about, one if it's smaller and one if it's correct.
My problem is that once you have pushed i.e. the larger button, if you press it again it won't do anything. E.g. the program starts to guess 500, if I press larger it guesses 750. If I now press larger again, the program doesn't respond.
My code is like this:
PRO test1_event, ev
WIDGET_CONTROL, ev.top, GET_UVALUE = stash
minimum = 0
maximum = 1000
IF (ev.Id EQ largerbutton) THEN BEGIN
minimum = (minimum+maximum)/2
maximum = maximum
ENDIF
IF (ev.Id EQ smallerbutton) THEN BEGIN
maximum = (minimum+maximum)/2
minimum = minimum
ENDIF
IF (ev.Id EQ correctbutton) THEN BEGIN
help2 = string('I got it!') ;This prints to a text widget
ENDIF
END
PRO test1
wBase = WIDGET_BASE(X_SCROLL_SIZE = 512, Y_SCROLL_SIZE = 512)
;wDraw = WIDGET_WINDOW(wBase, X_SCROLL_SIZE = 512, Y_SCROLL_SIZE = 512)
Lower = WIDGET_BUTTON(wBase, VALUE = 'Smaller', XOFFSET = 60, YOFFSET = 250)
Higher = WIDGET_BUTTON(wBase, VALUE = 'Larger', XOFFSET = 225, YOFFSET = 250)
Correct = WIDGET_BUTTON(wBase, VALUE = 'Correct', XOFFSET = 380, YOFFSET = 250)
minimum = 0
maximum = 1000
help1 = string('Please think of a number between' + string(minimum) + ' and ' + string(maximum))
help2 = string('Is your number ' + string((minimum + maximum)/2) + '?')
wText = WIDGET_TEXT(wBase, VALUE = ['Welcome to my little game. I will now try and guess a number you are thinking of.'], XSIZE = 63,XOFFSET = 50, YOFFSET = 100)
wText1 = WIDGET_TEXT(wBase, VALUE = help1, XSIZE = 63,XOFFSET = 50, YOFFSET = 120)
wText2 = WIDGET_TEXT(wBase, VALUE = help2, XSIZE = 63,XOFFSET = 50, YOFFSET = 140)
stash = {text1:wText, text2:wText1, text3:wText2, $
lower:Lower, higher:Higher, correct:Correct, minimum:minimum, maximum:maximum}
WIDGET_CONTROL, wBase, SET_UVALUE = stash, /REALIZE
XMANAGER, 'test1', wBase
end
I have tried using a while loop and also REPEAT, but then the program just goes right up to 999 if I press the larger button and to 0 if I press the smaller.
Any ideas to what I can do?
EDIT: Added the rest of the program
I think the buttons are working fine but your event handler doesn't actually do anything. First, I needed to change largerbutton, smallerbutton, and correctbutton to be stash.higher, stash.lower, stash.correct. Then, your code calculates the new minimum & maximum but it doesn't actually do anything with them.
I put a print statement into the event code and it's definitely getting the button presses.
In your event handler you probably want to use widget_control to update the text box with the new guess.
I am experimenting with gWidgets in R and simply trying to open a new gwindow for different values of selected option in gradio. There are 3 options and the last two work fine. When I select the first option, the error displayed is as follows.
Error in tkobj$env : $ operator is invalid for atomic vectors
I have tried to include the choices as a list too, but the error remains. The rest of the code is as follows. Any suggestions would be helpful.
library(gWidgets)
library(base)
options("guiToolkit"="tcltk")
win1<-gwindow("Welcome to OCCUR", visible = TRUE)
g0<-ggroup(container = win1)
g1 <- ggroup(container = win1)
g2 <-ggroup (container = win1)
l1<-glabel(text = "Please select one.",editable = FALSE,
container = g0,toolkit = guiToolkit())
#radio buttons
radiob<- gradio(c("Customer Data", "Sales Analysis",
"Market Basket Analysis"), horizontal = FALSE, container = g1)
#exit ok buttons
b1<- gbutton("Let's go", container = g2 , handler = newwin)
newwin <- function(svalue){
if(svalue(radiob)=="Customer Data"){
win2<-gmenu("1 ", visible = TRUE)
}
if(svalue(radiob)=="Sales Analysis"){
win2<-gwindow("1", visible = TRUE)
}
else{
win2<-gwindow(" 3", visible = TRUE)
}
}
b2<- gbutton("Exit", container=g2, handler = exit)
exit<-function(h,...){
dispose(win1)
}
I'm using Shiny to build a simple web application with a slider that controls what p-values should be displayed in the output.
How can I make the slider act on a logarithmic, rather than linear, scale?
At the moment I have:
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
),
Thanks!
UPDATE (May 2018):
This is now possible through the shinyWidgets::sliderTextInput() control. You can specify custom steps (e.g., logarithmic intervals), and the slider steps through those. The downside is that you need to specify each step, rather than a max and min and have the slider calculate the steps, but it works well for this kind of application.
Small example:
library(shiny)
ui <- fluidPage(
shinyWidgets::sliderTextInput("pvalue2","PValue:",
choices=c(0, 0.0001, 0.001, 0.01),
selected=0, grid = T)
)
server <- function(input, output) {}
shinyApp(ui, server)
I wasn't sure exactly what you wanted as the output, but what I did was have the possible p-values be [0, 0.00001, 0.0001, 0.001, 0.01]. If you want something a little different, hopefully this answer is a good enough starting point.
Basically, first I created an array that holds the values of the numbers (0, 0.0000.1, ...), and then I just use the special update function from the slider's API to make these values stick to the slider. It's pretty simple once you figure out how to use the slider's API. Also, for some reason running this inside RStudio looks weird, but in a browser it's fine. Also, note that I have a 5ms delay because I want to make sure this runs after the slider gets initialized. Not the cleanest solution, there's probably a better way to do that, but it works.
library(shiny)
JScode <-
"$(function() {
setTimeout(function(){
var vals = [0];
var powStart = 5;
var powStop = 2;
for (i = powStart; i >= powStop; i--) {
var val = Math.pow(10, -i);
val = parseFloat(val.toFixed(8));
vals.push(val);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 5)})"
runApp(shinyApp(
ui = fluidPage(
tags$head(tags$script(HTML(JScode))),
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
)
),
server = function(input, output, session) {
}
))
Not sure this thread is still active but just in case wanted to add a more generic way of "logifying" an inputSlider using the prettify function attribute of the ionRangeSlider rather than overwriting the values with the advantage being that you can define the min, max, step and default value of the inputSlider as usual and then all that happens on the Javascript side is a change of the displayed values (two options presented, one for numeric output, one for scientific notation):
library(shiny)
# logifySlider javascript function
JS.logify <-
"
// function to logify a sliderInput
function logifySlider (sliderId, sci = false) {
if (sci) {
// scientific style
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return ('10<sup>'+num+'</sup>'); }
})
} else {
// regular number style
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return (Math.pow(10, num)); }
})
}
}"
# call logifySlider for each relevant sliderInput
JS.onload <-
"
// execute upon document loading
$(document).ready(function() {
// wait a few ms to allow other scripts to execute
setTimeout(function() {
// include call for each slider
logifySlider('log_slider', sci = false)
logifySlider('log_slider2', sci = true)
}, 5)})
"
ui <- fluidPage(
tags$head(tags$script(HTML(JS.logify))),
tags$head(tags$script(HTML(JS.onload))),
sliderInput("log_slider", "Log Slider (numbers):",
min = -5, max = 3, value = -4, step = 1),
sliderInput("log_slider2", "Log Slider (sci. notation):",
min = -5, max = 3, value = 1, step = 0.5),
br(),
textOutput("readout1"),
textOutput("readout2")
)
server <- function(input, output, session) {
output$readout1 <- reactive({
paste0("Selected value (numbers): ", input$log_slider, " = ", 10^input$log_slider)
})
output$readout2 <- reactive({
paste0("Selected value (sci. notation): ", input$log_slider2, " = ", 10^input$log_slider2)
})
}
shinyApp(ui, server)
I don't have shiny at the moment with me, I have extended the range a little, what will happen if you try something like this:
sliderInput("pvalue",
"PValue:",
min = 1e-02,
max = 1e+02,
value = -10^seq(-2, 2)
),
your post it is mentioned 1e-2, i have used 1e-02, i checked like below
> 1e-2==1e-02
[1] TRUE
The reason the question hasn't gotten more attention is that its hard to answer. To do what the asker wants, you have to write javascript and inject it into the webpage. Below is code I adapted to properly format a shiny slider as dates. I haven't tried to modify it for logarithmic because I only learned enough javascript to tinker with this one script, and then promptly deleted it from memory to make room for more important things like the seasonal beer menu at the bar down the block.
Anyhoo:
output$selectUI <-
renderUI(
list(sliderInput(inputId = "target", label = "Date",
min = 0, max = diff_months(targetEnd(),targetStart()) - 1,
value = diff_months(targetEnd(),targetStart()) - 1,
animate = animationOptions( loop = T)),
singleton(HTML(
'
<script type="text/javascript">
$(document).ready(function() {
var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
"July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
var endDate = new Date(',
year(Sys.Date()),',', month(Sys.Date())
,', 1);
var slider = $("#dates").slider();
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text("Jan., 1962");
labels.eq(1).text([monthNames[endDate.getUTCMonth() +1], endDate.getUTCFullYear()].join(", "));
// override the default "nice" function.
slider.nice = function(value) {
alert("hi")
var ref_date = new Date(1962, 1, 1);
var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value));
return [monthNames[slider_date.getUTCMonth()], slider_date.getUTCFullYear()].join(", ");
}
$(slider).trigger("slidechange");
})
$(document).ready(function() {
var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
"July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
var slider = $("#target").slider();
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text([monthNames[', month(targetStart()) +1, '],', year(targetStart()), '].join(", "));
labels.eq(1).text([monthNames[', month(targetEnd()) + 1, '], ', year(targetEnd()), '].join(", "));
// override the default "nice" function.
slider.nice = function(value) {
alert("hi")
var ref_date = new Date(', year(targetStart()), ', ', month(targetStart()),',1 );
// each slider step is 4 weeks, translating to 24 * 3600 * 1000 milliseconds
var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value - 1));
return [monthNames[slider_date.getUTCMonth()],
slider_date.getUTCFullYear()].join(", ");
}
$(slider).trigger("slidechange");
})
</script>
')
)
)
)