Hidden OK button because of window size in Tcl-tk - r

I have the following problem, described in the image above.
Actually sometimes when I use my script the "OK" button shows, and not at other times when I use the script. If I make the window bigger myself, using my mouse it will then show up (It was previously hidden because the window was to small). I don't understand why and I couldn't find anything really helpful on the internet. (Changing stuff like the value of padx and pady didn't work.)
There has to be a parameter to adjust the general window size but I can't find it.
My second problem is that if the strings are long as in the example; a scroll bar to scroll from left to right will show. I would like to show the full strings. I also don't know how to fix that, sadly.
Is there something to do about it?
My code is the following:
noms_var_manif is a character vector
win2 <- tktoplevel()
tkgrid(tk2label(win2, text = "Veuillez selectionner les variables appartenant à ce bloc",
wraplength = 200, justify = "left"),
padx = 10, pady = c(15, 5), sticky = "w", columnspan = 2)
# Note that 'selection' uses indices starting at 1, like R and not Tcl/Tk!
win2$env$lst <- tk2listbox(win2,values=noms_var_manif, height = 10, selectmode = "extended")
tkgrid(win2$env$lst, padx = 100, pady = c(10, 20), sticky = "ew", columnspan = 2)
onOK <- function() {
select_var_bloc<- noms_var_manif[as.numeric(tkcurselection(win2$env$lst)) + 1]
tkdestroy(win2)
if (!length(select_var_bloc)) {
msg <- "Il n'y a donc aucune variable dans ce bloc?"
} else {
msg <- paste0("Vous avez choisi les variables suivantes: ",
paste(select_var_bloc, collapse = ", "))
}
tkmessageBox(message = msg)
win2$env$select_var_bloc= select_var_bloc
tkdestroy(win2)
}
win2$env$butOK <-tk2button(win2, text = "OK ", width = -6, command = onOK)
tkgrid(win2$env$butOK, padx = 10, pady = c(10, 15))
tkwait.window(win2)
select_var_bloc=win2$env$select_var_bloc

What you want to do is (1) fix the height and width of the the listbox, and
(2) fix the height and width of the window so that it is big enough to allow the OK button to always show. You can also fix the window so that it cannot be resized.

Related

Update a dependent field in R6 object when a parent field is updated

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

IDL: Button Widget stops updating after one push

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.

R : Select first value from gradio

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)
}

Shiny slider on logarithmic scale

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>
')
)
)
)

MsRdpClient - open with querystring parameters

I'm currently trying to open an MsRdpClient connection in a web browser by opening a new tab and passing it dynamic server names. However, the following code doesn't seem to work and I can't dynimically populate any of the required values, namely servername and available screen width and height.
resWidth = request.querystring("width")
resHeight = request.querystring("height")
MsRdpClient.DesktopWidth = resWidth
MsRdpClient.DesktopHeight = resHeight
MsRdpClient.Width = resWidth
MsRdpClient.Height = resHeight
MsRdpClient.server = request.querystring("fqdn")
MsRdpClient.username = "username"
MsRdpClient.AdvancedSettings.ClearTextPassword = "password"
MsRdpClient.AdvancedSettings2.RDPPort = "3389"
MsRdpClient.Connect
I'm not really sure where to go from here. I see it's been asked on a few boards but no one has seem to come up with an answer. Any help would be greatly appreciated.
Below is the script I ended up using. putting the required variables in via scriptlets is what did the trick. i.e. the "<%=fqdn%>"
resWidth = (screen.AvailWidth - 45)
resHeight = (screen.AvailHeight - 150)
MsRdpClient.DesktopWidth = resWidth
MsRdpClient.DesktopHeight = resHeight
MsRdpClient.Width = resWidth
MsRdpClient.Height = resHeight
MsRdpClient.server = "<%=fqdn%>"
MsRdpClient.AdvancedSettings2.RDPPort = "3389"
MsRdpClient.Connect
sub MsRdpClient_OnDisconnected(disconnectCode)
history.go(-1)
end sub

Resources