How to switch active device with gWidgets tabbed notebook? - gwidgets

I have created a two-tab GUI with gWidgets. A graph is embedded in each of the two tabs. The problem is that both graphs are sent to tab 2. How can I switch or choose the active device? The vignette of the gwidgets package suggests either addHandlerChanged or ggraphicsnotebook. In using ggraphicsnotebook, some unwanted buttons are generated. So I am wondering how to do it with addHandlerChanged or other methods. A small example is attached. Thanks.
# library
library(gWidgets); library(cairoDevice)
options(guiToolkit = "RGtk2")
# first tab -----------------------------------------------------------
r.main <- gwindow(title = "Correlation", visible = TRUE)
r.nb <- gnotebook(container = r.main)
rSta <- ggroup(container = r.nb, horizontal = TRUE, label = "Static")
rDyn <- ggroup(container = r.nb, horizontal = FALSE, label = "Dynamic")
ggraphics(container = rSta)
obj.ptNum <- gradio(items = c("100", "1,000", "5,000"),
selected = 2, horizontal = FALSE, container = rSta,
handler = function(h, ...) {plot(1:10, main = "Static graph")})
# second tab -----------------------------------------------
obj.plotNum <- gradio(items = c("10", "50", "300", "400"),
selected = 2, horizontal = TRUE, container = rDyn,
handler = function(h, ...) {
plot(30:35, col = 'red', main = "Dynamic graph")})
ggraphics(container = rDyn)
Edit: I found one solution. Note the problem is not about selecting tab, but about selecting the current active embedded device. For future reference, my code is copied below. One small problem that I cannot figure out: how to show the graph when the application is launched without clicking? Thanks all.
library(gWidgets); library(cairoDevice); library(gWidgetsRGtk2)
library(RGtk2)
options(guiToolkit = "RGtk2")
# first tab -----------------------------------------------------------
r.main <- gwindow(title = "Correlation", visible = TRUE)
r.nb <- gnotebook(container = r.main)
rSta <- ggroup(container = r.nb, horizontal = TRUE, label = "Static")
ggraphics(container = rSta)
staPlot <- function(h, ...) {
sel <- ifelse(test = length(dev.list()) >= 2, yes = 2, no = 1)
dev.set(which = sel)
plot(1:as.numeric(svalue(obj.ptNum)), main = "Static graph")}
obj.ptNum <- gradio(items = c("100", "150", "200"),
selected = 2, horizontal = FALSE, container = rSta,
handler = staPlot)
# second tab -----------------------------------------------
rDyn <- ggroup(container = r.nb, horizontal = FALSE, label = "Dynamic")
dynPlot <- function(h, ...) {
sel <- ifelse(test = length(dev.list()) >= 2, yes = 3, no = 1)
dev.set(which = sel)
plot(1:as.numeric(svalue(obj.plotNum)), col = 'red',
main = "Dynamic graph")}
obj.plotNum <- gradio(items = c("10", "50", "300", "400"),
selected = 2, horizontal = TRUE, container = rDyn,
handler = dynPlot)
ggraphics(container = rDyn)
svalue(r.nb) <- 1

It's bad to use dev.set. If you to create a plot in a graphics device, you can use the following code.
graph <- ggraphics()
visible(graph) <- TRUE
boxplot(...)

Related

The labels for my Sankey diagram (R, Plotly) do not show properly on the online version of my Shiny dashboard, but behave correctly locally

So I'm working on a Shiny dashboard, which I deployed on an AWS EC2 instance. It behaves exactly the same both locally and online save for one detail: the labels on the right hand side do not behave properly!
Here is the online version of the Plotly Sankey diagram in question:
Here is what I see locally when I run the app through RStudio.
There's absolutely no difference among any files. I don't see why the rendering of the labels should differ on both versions, but anyway, here's the relevant part of the code inside server.R:
# gender_sankey
nodes <- c('Hombres', 'Mujeres', unique(gender_df$UltimoGradoEstudios))
nodes <- nodes[c(1,2,4,3,5,7,12,10,8,6,11,9)]
gender_df$count <- 1
hom_stud <- aggregate(count ~ UltimoGradoEstudios, FUN = sum,
data = gender_df[gender_df$hom == 1,])
muj_stud <- aggregate(count ~ UltimoGradoEstudios, FUN = sum,
data = gender_df[gender_df$muj == 1,])
# Setting the sources and targets
hom_stud$src <- 0
muj_stud$src <- 1
hom_stud$tgt <- c(2,4,3,11,5,8,6,9,7)
muj_stud$tgt <- c(2,4,3,11,5,8,10,6,9,7)
# Setting the positions for the nodes
node_x <- c(0,0,1,1,1,1,1,1,1,1,1,1)
node_y <- c(0,1,-10:-1) # NOTE: Probably one of the fishy parts (2/2)
colors <- c('#C7FFA9','#E4A9FF','#2424FF','#2477FF','#248EFF','#249FFF',
'#24B3FF','#24C7FF','#24DEFF','#24F8FF','#24FFF8','#24FFEE')
# NOTE: Probably one of the fishy parts (1/2)
# Button to select/de-select all
observe({
if (input$selectall_sankey > 0) {
if (input$selectall_sankey %% 2 == 0){
updateCheckboxGroupInput(session = session,
inputId = "schoolSelect",
choices = list("Doctorado" = 'Doctorado',
"Maestría" = 'Maestría',
"Licenciatura" = 'Licenciatura',
"Pasante/Licenciatura trunca" = 'Pasante/Licenciatura trunca',
"Profesor Normalista" = 'Profesor Normalista',
"Técnico" = "Técnico",
"Preparatoria" = "Preparatoria",
"Secundaria" = 'Secundaria',
"Primaria" = "Primaria",
"No disponible" = 'No disponible'
),
selected = c(choices = list("Doctorado" = 'Doctorado',
"Maestría" = 'Maestría',
"Licenciatura" = 'Licenciatura',
"Pasante/Licenciatura trunca" = 'Pasante/Licenciatura trunca',
"Profesor Normalista" = 'Profesor Normalista',
"Técnico" = "Técnico",
"Preparatoria" = "Preparatoria",
"Secundaria" = 'Secundaria',
"Primaria" = "Primaria",
"No disponible" = 'No disponible'
))
)
} else {
updateCheckboxGroupInput(session = session,
inputId = "schoolSelect",
choices = list("Doctorado" = 'Doctorado',
"Maestría" = 'Maestría',
"Licenciatura" = 'Licenciatura',
"Pasante/Licenciatura trunca" = 'Pasante/Licenciatura trunca',
"Profesor Normalista" = 'Profesor Normalista',
"Técnico" = "Técnico",
"Preparatoria" = "Preparatoria",
"Secundaria" = 'Secundaria',
"Primaria" = "Primaria",
"No disponible" = 'No disponible'
),
selected = c())
}}
})
# Plot
output$gender_sankey <- renderPlotly({
hom_stud <- hom_stud[hom_stud$UltimoGradoEstudios %in% input$schoolSelect,]
muj_stud <- muj_stud[muj_stud$UltimoGradoEstudios %in% input$schoolSelect,]
node_x <- c(node_x[hom_stud$UltimoGradoEstudios %in% input$schoolSelect])
node_y <- c(node_y[hom_stud$UltimoGradoEstudios %in% input$schoolSelect])
colors <- c(colors[hom_stud$UltimoGradoEstudios %in% input$schoolSelect])
fig <- plot_ly(
type = "sankey",
orientation = "h",
arrangement = 'snap',
node = list(
label = nodes,
color = colors,
x = node_x,
y = node_y,
pad = 15,
thickness = 20,
line = list(
color = "black",
width = 0.5
)
),
link = list(
source = c(hom_stud$src, muj_stud$src),
target = c(hom_stud$tgt, muj_stud$tgt),
value = c(hom_stud$count, muj_stud$count)
)
)
fig <- fig %>% layout(
font = list(
size = 10
)
) %>% config(modeBarButtons = list(list('toImage'), list('resetScale2d')), displaylogo = F)
})
Packages used: shiny, shinydashboard, shinythemes and plotly (same versions both locally and on server). dplyr, magrittr, and ggplot2 are on the same version as well.
R version in my computer is 4.0.2, R version in the server is 3.6.3
It's not the cleanest implementation, specially on the button part, but it works perfectly locally! Note that I marked the sketchy practices I used, and where the problem could lie. Basically the default node order wasn't cutting it because the position on the right hand side itself contains information (Doctorado > Maestría > Licenciatura> ...), so I kind of forced a different order for the nodes through node_x and node_y. The thing is, the implementation works locally! What could be the reason for it not to work online?

The networkd3 is displaying all data, not the subset I want to show based on widget inputs in Shiny app

I am trying to make a Shiny app where the user selects a few options and a network and data table will display based on the inputs. I have a diet study database and would like users to be able to specify the predator species they are interested in, the diet metric (weight, volumetric, etc) and the taxonomic level they want nodes identified to. The data table works fine (so I did not include the code) and updates based on the input but the network does not change, it only shows all of the data. When I run the code for generating the plot outside of Shiny it works fine. This is my first shiny attempt so any suggestions would be greatly appreciated.
library(dplyr)
library(igraph)
library(networkD3)
Diet <-data.frame(
Predator_Scientific_Name = rep("Acanthocybium solanderi", 10),
Class_Predator = rep("Actinopterygii", 10),
Order_Predator = rep("Perciformes", 10),
Family_Predator = rep("Scombridae", 10),
Genus_Predator = rep("Acanthocybium", 10),
Species_Predator = rep("solandri", 10),
Class_Prey = rep("Actinopterygii", 10),
Order_Prey = c( "Clupeiformes" , NA , "Perciformes", "Perciformes", "Perciformes", "Perciformes", "Perciformes", "Perciformes", "Tetraodontiformes", "Tetraodontiformes"),
Family_Prey = c("Clupeidae", NA, "Coryphaenidae", "Carangidae", "Scombridae","Echeneidae","Carangidae", "Scombridae", "Balistidae","Diodontidae"),
Genus_Prey = c("Sardinella", NA, "Coryphaena", "Decapterus", "Euthynnus", NA, NA, NA, "Balistes", "Diodon"),
Species_Prey = c("aurita" , "", "hippurus", "punctatus","alletteratus", "", "", "","capriscus", "spp." ),
Lowest_Taxonomic_Identification_Prey = c("Sardinella aurita","Actinopterygii","Coryphaena hippurus","Decapterus punctatus","Euthynnus alletteratus", "Echeneidae", "Carangidae","Scombridae","Balistes capriscus","Diodon spp."),
Frequency_of_Occurrence = c(2.8, 59.1, 1.4, 7.0, 1.4, 1.4, 15.5, 21.1, 2.8, 4.2), StringAsFactors = FALSE
)
pred.name <- unique(Diet$Predator_Scientific_Name)
prey.tax <- unique(Diet$Lowest_Taxonomic_Identification_Prey)
#Progress bar function
compute_data <- function(updateProgress = NULL) {
# Create 0-row data frame which will be used to store data
dat <- data.frame(x = numeric(0), y = numeric(0))
for (i in 1:10) {
Sys.sleep(0.25)
# Compute new row of data
new_row <- data.frame(x = rnorm(1), y = rnorm(1))
# If we were passed a progress update function, call it
if (is.function(updateProgress)) {
text <- paste0("x:", round(new_row$x, 2), " y:", round(new_row$y, 2))
updateProgress(detail = text)
}
# Add the new row of data
dat <- rbind(dat, new_row)
}
dat
}
####
# Define UI for application that draws a histogram
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "Diet Database"),
dashboardSidebar(
sidebarMenu(
menuItem("Parameters",
tabName = "paramaters",
icon = shiny::icon("bar-chart")))
),
dashboardBody(
tabItems(
tabItem(
tabName = "paramaters",
fluidRow(
shiny::column(
width = 4,
shinydashboard::box(
title = "Predator",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a predator to view its connections and prey items:"),
shiny::selectInput(
"pred",
shiny::h5("Predator Scientific Name:"),
c(NA,pred.name))),
shinydashboard::box(
title = "Prey",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a prey taxa to view its connections and predators:"),
shiny::selectInput(
"prey",
shiny::h5("Prey Taxa:"),
c(NA,prey.tax))),
shinydashboard::box(
title = "Diet Metric",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a diet metric to use:"),
shiny::selectInput(
"dietmetric",
shiny::h5("Diet Metric:"),
c("Frequency of Occurrence" = "Frequency_of_Occurrence",
"Wet Weight" = "Weight",
"Dry Weight" = "Dry_Weight",
"Volume" = "Volume",
"Index of Relative Importance" = "IRI",
"Index of Caloric Importance" = "ICI",
"Number" = "Number"))),
shinydashboard::box(
title = "Taxonomic Level",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
width = NULL,
shiny::helpText("Select a taxonomic level of nodes:"),
shiny::selectInput(
"nodetax",
shiny::h5("Taxonomic Level:"),
c("Order" = "Order",
"Family" = "Family",
"Genus" = "Genus",
"Species" = "Species"))),
shinydashboard::box(
title = "Generate Network",
status = "primary",
solidHeader = T,
collapsible = T,
width = NULL,
actionButton("makenet", "Generate")
)
),
#Area for network to be displayed
shiny::column(
width = 8,
shinydashboard::box(
title = "Trophic Network",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
width = NULL,
forceNetworkOutput("netplot")
)
)
))
)))
server <- function(input, output, session) {
network.data <- eventReactive(input$makenet, {
edgelist <- Diet %>% filter(Predator_Scientific_Name == input$pred|Lowest_Taxonomic_Identification_Prey == input$prey
) %>% select(
paste(input$nodetax, "Predator", sep = "_"),
Class_Predator,
paste(input$nodetax, "Prey", sep = "_"),
Class_Prey,
input$dietmetric
)
colnames(edgelist) <- c("SourceName",
"SourceClass",
"TargetName",
"TargetClass",
"Weight")
edgelist <- edgelist[complete.cases(edgelist),]
})
output$netplot <- renderForceNetwork( {
network.data()
ig <-igraph::simplify(igraph::graph_from_data_frame(edgelist[,c(1,3,5)], directed = TRUE))
SourceID <- TargetID <- c()
for (i in 1:nrow(edgelist)) {
SourceID[i] <- which(edgelist[i,1] == V(ig)$name)-1
TargetID[i] <- which(edgelist[i,3] == V(ig)$name)-1
}
#Create edgelist that contains source and target nodes and edge weights
edgeList <- cbind(edgelist, SourceID, TargetID)
nodeList <- data.frame(ID = c(0:(igraph::vcount(ig) - 1)),
nName = igraph::V(ig)$name)
#Determine and assign groups based on class
preddf <-
data.frame(SciName = edgelist[, 1], class = edgelist[, 2])
preydf <-
data.frame(SciName = edgelist[, 3], class = edgelist[, 4])
groupsdf <- rbind(preddf, preydf)
groupsdf <- groupsdf %>% mutate(SciName = as.character(SciName),
class = as.character(class))
nodeGroup <- c()
for (i in 1:nrow(nodeList)) {
index <- which(groupsdf[, 1] == nodeList$nName[i])
nodeGroup[i] <- groupsdf[index[1], 2]
}
nodeList <-
cbind(nodeList,
nodeGroup)
progress <- shiny::Progress$new()
progress$set(message = "Generating your network...", value = 0)
# Close the progress when this reactive exits (even if there's an error)
on.exit(progress$close())
# Create a callback function to update progress.
# Each time this is called:
# - If `value` is NULL, it will move the progress bar 1/5 of the remaining
# distance. If non-NULL, it will set the progress to that value.
# - It also accepts optional detail text.
updateProgress <- function(value = NULL, detail = NULL) {
if (is.null(value)) {
value <- progress$getValue()
value <- value + (progress$getMax() - value) / 5
}
progress$set(value = value, detail = detail)
}
# Compute the new data, and pass in the updateProgress function so
# that it can update the progress indicator.
compute_data(updateProgress)
networkD3::forceNetwork(
Links = edgeList,
# data frame that contains info about edges
Nodes = nodeList,
# data frame that contains info about nodes
Source = "SourceID",
# ID of source node
Target = "TargetID",
# ID of target node
Value = "Weight",
# value from the edge list (data frame) that will be used to value/weight relationship amongst nodes
NodeID = "nName",
# value from the node list (data frame) that contains node
Group = "nodeGroup",
# value from the node list (data frame) that contains value we want to use for node color
fontSize = 25,
opacity = 0.85,
zoom = TRUE,
# ability to zoom when click on the node
opacityNoHover = 0.4 # opacity of labels when static
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am sharing my fixed code in case it helps someone in the future. I basically just changed the top of the server code.
network.data <- eventReactive(input$makenet, {
Diet %>% filter(Predator_Scientific_Name == input$pred|Lowest_Taxonomic_Identification_Prey == input$prey
) %>% select(
paste(input$nodetax, "Predator", sep = "_"),
Class_Predator,
paste(input$nodetax, "Prey", sep = "_"),
Class_Prey,
input$dietmetric
) %>% rename("SourceName" = paste(input$nodetax, "Predator", sep = "_"),
"SourceClass" = Class_Predator,
"TargetName" = paste(input$nodetax, "Prey", sep = "_"),
"TargetClass" = Class_Prey,
"Weight" = input$dietmetric) %>% na.omit()
})
output$netplot <- renderForceNetwork( {
edgelist <- network.data()

How can I render a networkDynamic network using the MDSJ rendering engine in R?

I would like to render a dynamic network in R using the fast MDSJ library. Unfortunately, however, all the vertices' coordinates seem to be 0,0 using this rendering engine, which is not the case when using one of the other layouts (kamadakawai or Graphviz. If you paste the code below, you should be able to reproduce the problem.
if (!require("pacman")) install.packages("pacman")
library("pacman")
pacman::p_load(network, networkDynamic, ndtv)
#animation.mode = "MDSJ"
#animation.mode = "Graphviz"
animation.mode = "kamadakawai"
people <- c("A","B","C","D","E")
documents <- paste0("a",1:10)
edges <- data.frame(from = c("A","A","A","B","B","C","D"),
to = c("a1","a2","a3","a4","a5","a1","a1"),
active = c(1,2,3,3,4,4,4))
net <- network.initialize(0, directed = TRUE, bipartite = length(people))
add.vertices.networkDynamic(net, 5, vertex.pid = people)
add.vertices.networkDynamic(net, 10, vertex.pid = documents)
net %v% "vertex.names" <- c(people, documents)
net %v% "vertex.col" <- c(rep("blue", length(people)), rep("gray", length(documents)))
set.network.attribute(net,'vertex.pid','vertex.names')
add.edges.networkDynamic(net,
tail = get.vertex.id(net, edges[[1]]),
head = get.vertex.id(net, edges[[2]]),
edge.pid = paste0(edges[[1]], "->", edges[[2]]))
activate.edges(net, e = 1:7, at = edges[[3]])
reconcile.vertex.activity(net = net, mode = "encompass.edges", edge.active.default = FALSE)
slice.par <- list(start = 1, end = 4, interval = 1, aggregate.dur = 2, rule = "earliest")
compute.animation(net,
animation.mode = animation.mode,
slice.par = slice.par)
render.d3movie(net,
slice.par = slice.par,
displaylabels = TRUE,
output.mode = "htmlWidget",
vertex.col = 'vertex.col')
Using kamadakawai, one gets a dynamic view like this:
Using MDSJ, all slides look like this:
This code works on my system with MDSJ. Does it install correctly on yours? When it's first used, it has to download and install a Java application mdsj.jar.

How to set up a "save pic as pdf" button in GUI

1) I used the package gWidget to make a GUI in R. I have had some problems. I want to add a "save" button in the window, but I don't know how to store the pic already drawn in ggraphics.
library("memoise")
library("gWidgets2RGtk2")
library("RGtk2")
library("digest")
library("gWidgets2")
library("stats")
options(guiToolkit="RGtk2")
d<-0
#the main window to make and some parts of it to make
win <- gwindow("Load curve analysis", visible=TRUE,expand = TRUE)
biggroup <- ggroup(horizontal = FALSE, container=win, expand = TRUE)
topgroup<-ggroup(horizontal = TRUE, container=biggroup,expand = TRUE)
bottomgroup<-ggroup(horizontal = TRUE, container=biggroup, expand = TRUE)
leftgroup<-ggroup(horizontal = FALSE, container=bottomgroup,expand= TRUE)
rightgroup<-ggroup(horizontal = FALSE, container=bottomgroup,expand=TRUE)
add(rightgroup, ggraphics(), expand=TRUE)
#draw a pic
updatePlot <- function(h,...) {
if(d==1){
if(svalue(Analyse1)=="Month duration curve")
plot(1:100,1:100,main="1")
if(svalue(Analyse1)=="Month load curve")
plot(1:100,1:100,main="2")
}
if(d==2){
if(svalue(Analyse2)=="Jahresdauerlinie"){
plot(1:100,1:100,main="3")
}
}
}
#the "save" button to make, this button will bring another window,
#but after setting up the road of the saving place, this smaller window will be closed
Store<-gbutton("Save as pdf",container=topgroup, handler = function(h,...){
win1 <- gwindow("set up road", visible=TRUE,expand = TRUE)
group <- ggroup(horizontal = FALSE, container=win1, expand = TRUE)
tmp <- gframe("Pls type the place you want to save in", container=group)
obj0<-gedit("",cont=tmp,expand = TRUE)
tmp <- gframe("Pls name the new diagram, and end it with .pdf", container=group)
obj1<-gedit("Lastganganalyse.pdf",cont=tmp,expand = TRUE)
#here the function recordPlot will be used,but it doesnt work,the document cant be opened
ok<-gbutton("Ok",container=group, handler = function(h,...){
p<-recordPlot()
# I dont know why this record Plot doesnt work
setwd(svalue(obj0))
pdf(svalue(obj1))
p
dev.off()
dispose(win1)
})
})
#the other parts of the main window
tmp <- gframe("Year(after input a year pls press Enter)", container=leftgroup)
#Jahren <- gradio(c(2012,2013,2014), horizontal=FALSE, cont=tmp, handler=updatePlot)
Jahren<-gedit("2012",cont=tmp, handler=updatePlot)
tmp <- gframe("Month", container=leftgroup)
Monat <- gslider(from=1,to=12,by=1, value=1, cont=tmp, handler=updatePlot)
tmp <- gframe("Analysis' way of a month", container=leftgroup)
Analyse1 <- gcombobox(c(" ","Month duration curve","Month load curve"), cont=tmp, handler=function(h,...){
d<<-1
updatePlot(h,...)
},expand = TRUE)
tmp <- gframe("Analysis' way of a year", container=leftgroup)
Analyse2 <- gcombobox(c(" ","Jahresdauerlinie"),cont=tmp,handler=function(h,...){
d<<-2
updatePlot(h,...)},expand = TRUE)
2) Besides, I don't know how to set up the size of the ggroup. Or how can I control all parts of the window's size to look better. I dont know that kind of function.
3) The line which is drawn in ggraphics is hard to be seen. And how can I change this situation?
Suppose we had the following plot in the graphics:
ggplot(dat = data.frame("x" = 1:100, "y" = rnorm(100)), aes(x = x, y = y)) + geom_point()
Within the handler for the button, you can try the following:
setwd(svalue(obj0))
dev.copy2pdf(file = svalue(obj1))

RGTK2 Implementing a Scrolled Window

I'm writing a GUI in R that compares a bunch of different plots. I am trying to implement a scrolling window to contain the plots.
What I am having trouble with is controlling the size of a scrolledwindow using Rgtk2:
window = gtkWindow(show = FALSE)
hbox = gtkHBoxNew(homogeneous = FALSE, spacing = 0)
window$add(hbox)
vboxLoad = gtkVBoxNew(homogeneous = FALSE, spacing = 0)
hbox$add(vboxLoad)
scroll = gtkScrolledWindow()
vbox2 = gtkVBoxNew(homogeneous = FALSE, spacing = 0)
scroll$addWithViewport(vbox2)
vboxLoad$add(scroll)
framePlot = gtkFrameNew("Plot1")
framePlot2 = gtkFrameNew("Plot2")
vbox2$add(framePlot)
vbox2$add(framePlot2)
plot1 = gtkDrawingArea()
gtkWidgetSetSizeRequest(plot1,450,400)
asCairoDevice(plot1)
gtkWidgetShow(plot1)
framePlot$add(plot1)
plot2 = gtkDrawingArea()
gtkWidgetSetSizeRequest(plot2,450,400)
asCairoDevice(plot2)
gtkWidgetShow(plot2)
framePlot2$add(plot2)
Gives me something tantalizingly close to what I need, but Rgtk2 does not have a gtk_scrolled_window_set_min_content_width option and I don't know how to use adjustments to achieve the desired effect, i.e:
hadjustment = gtkAdjustmentNew(value = NULL, lower = NULL, upper = NULL, step.incr = NULL, page.incr = NULL, page.size = 600)
gtkScrolledWindowSetHadjustment(scroll, hadjustment)
does not work as a blunt instrument.
Any help would be appreciated.
As usual, I tried to attack the wrong part of the problem. Controlling the size of the box that contains the scrolled window seems to work just fine:
window = gtkWindow(show = FALSE)
hbox = gtkHBoxNew(homogeneous = FALSE, spacing = 0)
window$add(hbox)
vboxLoad = gtkVBoxNew(homogeneous = FALSE, spacing = 0)
vboxd$setSizeRequest(400,400)
hbox$add(vboxLoad)
scroll = gtkScrolledWindow()
vbox2 = gtkVBoxNew(homogeneous = FALSE, spacing = 0)
scroll$addWithViewport(vbox2)
vboxLoad$add(scroll)
framePlot = gtkFrameNew("Plot1")
framePlot2 = gtkFrameNew("Plot2")
vbox2$add(framePlot)
vbox2$add(framePlot2)
plot1 = gtkDrawingArea()
gtkWidgetSetSizeRequest(plot1,450,400)
asCairoDevice(plot1)
gtkWidgetShow(plot1)
framePlot$add(plot1)
plot2 = gtkDrawingArea()
gtkWidgetSetSizeRequest(plot2,450,400)
asCairoDevice(plot2)
gtkWidgetShow(plot2)
framePlot2$add(plot2)

Resources