I am trying to create a table using rhandsontable with several rows of merged cells (different cells in each row).
I am trying to achieve merging of the indicated cells in the screenshot below ...
I am able to successfully merge the first set of cells (row 11) but subsequent merges using a "list of lists" to specify the cells doesn't work. I have tried every permutation of the "list of lists" syntax that I can think of;
a reprex of the example is here ...
library(shiny)
library(rhandsontable)
## Create the data set
DF = data.frame((Cycle = 1:13),
`A` = as.numeric(""),
`B` = as.numeric(""),
`C` = as.numeric(""),
`D` = as.numeric(""))
DF[11,1] = "Total"
DF[12,1] = ""
DF[13,1] = "Loss"
server <- shinyServer(function(input, output, session) {
output$hotTable <- renderRHandsontable({rhandsontable(DF,
width = 1500, height = 350, rowHeaders = FALSE) %>%
hot_cols(colWidths = c(100, 150, 150, 150, 150)) %>%
hot_col(c(1,3:5), readOnly = TRUE) %>%
hot_col(col = c(1:5), halign = "htCenter") %>%
hot_col(col = c(2:4), format = "0.0000") %>%
hot_col(col = 5, format = 0000) %>%
hot_table(mergeCells = list(list(row = 10, col = 2, rowspan = 1, colspan = 3),
list(row = 11, col = 1, rowspan = 1, colspan = 5),
list(row = 12, col = 3, rowspan = 1, colspan = 3)))})
})
ui <- basicPage(mainPanel(rHandsontableOutput("hotTable")))
shinyApp(ui, server)
I think you should change some parameters as follow:
mergeCells = list(list(row = 10, col = 2, rowspan = 1, colspan = 3),
list(row = 11, col = 0, rowspan = 1, colspan = 5),
list(row = 12, col = 2, rowspan = 1, colspan = 3))
so your desired rhandsontable would be produced as you want:
Related
I have made a pbiviz custom visual using developer tools of Normal distribution curve over a Histogram plot with R - ggplot2 and plotly libraries in a pbiviz.package
The visual works fine. Now I want to add interactivity of the Histogram with other Power BI visuals.
i.e. If user clicks on a bar of the Histogram, it should filter out a Table on my PBI report with rows relevant to the histogram bar data.
Considering the limitations of using R script with Power BI, I do not know if it is possible with my current visual as I am new to scripting.
Is there a better way (Typescript, JS, Python, etc.) other than what I have done to make an Interactive Histogram & Distribution Curve in Power BI?
This is the R script along with sample data and Visual Image
Histogram represents the projects falling in different durations
There are two bell curves - One for closed projects and Other for Active Projects
source('./r_files/flatten_HTML.r')
############### Library Declarations ###############
libraryRequireInstall("ggplot2");
libraryRequireInstall("plotly");
libraryRequireInstall("tidyverse");
libraryRequireInstall("scales");
libraryRequireInstall("htmlwidgets");
library(ggplot2)
library(tidyverse)
library(scales)
library(plotly)
theme_set(theme_bw())
##### Making DataSet for All Selected Projects #####
Duration <- dataset$Duration
Status <- (rep(dataset$ProjectStatus))
da <- data.frame(Duration,Status)
lenx <- length(Duration)
meanall <- mean(da$Duration)
sdx <- sd(da$Duration)
binwidth <- 30
font_label <- list(family = "Segoe UI", size = 21, colour = "black")
hovlabel <- list(bordercolor = "black", font = font_label)
#Filtering Out Closed Projects from Dataset
#Creating Data Frame for Closed Projects
closedproj <- dataset %>%
select(Duration,ProjectStatus) %>%
filter(ProjectStatus == "Closed")
closed <- closedproj$Duration
df <- data.frame(closed)
xclosed <- closedproj$
df2 <- data.frame(xclosed)
lenc <- length(xclosed)
mean_closed <- mean(df2$xclosed)
sdc <- sd(df2$xclosed)
a <-
(ggplot(da,aes(x=Duration, fill = Status, text = paste("Duration: ",x,"-", x + binwidth,"<br />Project Count", ..count..)))+
#Histogram
geom_histogram(aes(y=..count..),alpha=0.5, position='identity',binwidth = binwidth)+
# #Distribution Curve
annotate(
geom = "line",
x = da$Duration,
y = dnorm(da$Duration, mean = meanall, sd = sdx) * lenx * binwidth,
width = 3,
color = "red"
) +
annotate(
geom = "line",
x = df2$xclosed,
y = dnorm(df2$xclosed, mean = mean_closed, sd = sdc)* lenc * binwidth,
width = 3,
color = "blue"
) +
labs(
x = "Project Duration (Days)",
y = "Project_Count",
fill = "Project Status")+
#Mean
geom_vline(aes(xintercept=meanall),color="red",linetype="dashed",size = 0.8,label=paste("Mean :",round(meanall,0)))+
geom_vline(aes(xintercept=mean_closed),color="blue",linetype="dashed",size = 0.8,label=paste("Mean (Closed):",round(mean_closed,0)))+
# 1 Sigma
geom_vline(aes(xintercept = (meanall + sdx)), color = "red", size = 1, linetype = "dashed") +
geom_vline(aes(xintercept = (meanall - sdx)), color = "red", size = 1, linetype = "dashed")+
geom_vline(aes(xintercept = (mean_closed + sdc)), color = "blue", size = 1, linetype = "dashed") +
geom_vline(aes(xintercept = (mean_closed - sdc)), color = "blue", size = 1, linetype = "dashed")+
# Theme
theme(
plot.background = element_rect(fill = "transparent"),
legend.background = element_rect(fill = "lightgray"),
axis.title.x = element_text(colour = "Black",size = 18,face = "bold"),
axis.title.y = element_text(colour = "Black",size = 18,face = "bold"),
axis.text.x = element_text(colour = "Black",size = 15),
axis.text.y = element_text(colour = "Black",size = 15),
panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
scale_x_continuous(labels = comma,
breaks = seq(0, max(Duration),50)) +
scale_y_continuous(labels = comma,
breaks = seq(0,max(Duration),10)))
############# Create and save widget ###############
p = ggplotly(a, tooltip = c("text")) %>%
style(hoverlabel = hovlabel) %>%
layout(legend = list(
orientation = "h",
x = 0,
y = 1.13,
title = list(text = "Project Status",font = list(family = "Segoe UI", size = 23)),
font = font_label
),
yaxis = list(title = list(standoff = 25L)),
xaxis = list(title = list(standoff = 25L)),
annotations = list(showarrow=FALSE,align = "left",valign = "top",x = 0.95, xref = "paper",yref = "paper",y = 0.955,
font = list(family = "Segoe UI", size = 22, color = "#cc0000"),
text = paste("Max Duration: ", comma(round(max(da$Duration),0)),
"<br>Mean (Closed): ", comma(round(mean_closed,0)),
"<br>Mean (All) : ", comma(round(meanall,0))))
) %>%
config(modeBarButtonsToRemove = c("select2d","hoverClosestCartesian", "lasso2d","hoverCompareCartesian","toggleSpikelines"), displaylogo = FALSE);
internalSaveWidget(p, 'out.html');
}
####################################################
################ Reduce paddings ###################
ReadFullFileReplaceString('out.html', 'out.html', ',"padding":[0-5]*,', ',"padding":0,')
What I expect is -- If user clicks on a bar of the Histogram, it should reflect on a Table visual on my PBI report with rows relevant to the histogram bar data.
Any help will be highly appreciated !
Regards
I want to get the following layout.
In my actual plots, the two plots in the third column are same x-axis and thus I
exhibit them in one column.
The following example Shiny code has the three histograms with one column.
So, we cannot observe how the most lowest histogram changes according to the bins. Thus I want to get the above layout.
Example Shiny Code
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot1"),
plotOutput("distPlot2"),
plotOutput("distPlot3")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot1 <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot2 <- renderPlot({
# generate bins based on input$bins from ui.R
y <- faithful[, 2]
bins <- seq(min(y), max(y), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(y, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot3 <- renderPlot({
# generate bins based on input$bins from ui.R
z <- faithful[, 2]
bins <- seq(min(z), max(z), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(z, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Please let me know any idea.
Edit for comment
I understand your idea. I do not use ggplot as follows;
x <- c(1, 2, 3, 4, 5)
y1 <- c(1, 1, 2, 3, 1)
y2 <- c(2, 2, 1, 2, 4)
y3 <- c(4, 3, 2, 1, 2)
split.screen(figs = c(1, 2))
split.screen(figs = c(2, 1), screen = 2)
screen(1)
plot(x, y1, type = "l")
screen(3)
plot(x, y2, type = "l")
screen(4)
plot(x, y3, type = "l")
The result is as follows;
I would use ggplot2 and gridExtra to arrange the plots.
Here is the final output I got:
Screenshot
The main plots were done using grid.arrange to combine them together, and ggplot2 gives you more ability to control each of the subplots, named plot1, plot2, and plot3 in the codes, and plot2 and plot3 formed the 3rd column.
Since your 3rd column has different x-axis, I added a second bin width to control them together. And, to make the program a bit more dynamic, I use renderUI and uiOutput to push the data information from the server back to ui to generate the two sliderInputs.
Codes:
library(ggplot2)
library(grid)
library(gridExtra)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
uiOutput("bins1"),
uiOutput("bins2")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("ggplot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
## Your Data and give colnames for ggplot
x <- as.data.frame(faithful[, 2])
y <- as.data.frame(faithful[, 1])
z <- as.data.frame(faithful[, 1])
colnames(x) <- "Count"
colnames(y) <- "Count"
colnames(z) <- "Count"
## Set bin size 1 and 2
binWidth1 <- c(max(x))
binWidth2 <- c(max(y))
output$bins1 <- renderUI({
sliderInput("bins1",
h3("Bin width #1 "),
min = 1,
max = max(x),
value = (1 + max(x))/10)
})
output$bins2 <- renderUI({
sliderInput("bins2",
h3("Bin width #2 "),
min = 1,
max = max(y),
value = (1 +max(y))/10)
})
output$ggplot <- renderPlot({
# bins <- seq(min(x), max(x), length.out = input$bins + 1)
plot1 <- ggplot(x, aes(x = Count)) +
geom_histogram(binwidth = input$bins1, fill = "black", col = "grey")
plot2 <- ggplot(y, aes(x = Count)) +
geom_histogram(binwidth = input$bins2, fill = "black", col = "grey")
plot3 <- ggplot(z, aes(x = Count)) +
geom_histogram(binwidth = input$bins2, fill = "black", col = "grey")
grid.arrange(grid.arrange(plot1), grid.arrange(plot2, plot3, ncol = 1), ncol = 2, widths = c(2, 1))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am creating a Shiny app where I would like to have the default of a numericInput be dependent on another default to a previously defined numericInput.
e.g.,
Here I would like the numericInput elements of (2) to be the reciprocal of (1), without having to specify values for value,min,max, and step beforehand:
(1) numericInput("obs1", "Label1", value = 10, min = 10, max = 20, step = 1)
(2) numericInput("obs2", "Label2", value = 1/10, min = 1/10, max = 1/20, step = 1)
Above (1) is the previously-defined numericInput.
Is there a simple way to do this?
If you want an input object to have dynamic parameters you need to use uiOutput, so that you can generate them in runtime (in server.R).
Example: In the first column you can set min, max and value. Modifying any of them renders obs1 and obs2 with new parameter values.
library(shiny)
ui <- fluidPage(
column(6,
tags$h2("Set parameters"),
numericInput("value", "Value", value = 20, min = 10, max = 60, step = 10),
numericInput("min", "Min", value = 10, min = 0, max = 30, step = 10),
numericInput("max", "Max", value = 40, min = 40, max = 60, step = 10)
),
column(6,
uiOutput("ui")
)
)
server <- function(input, output, session) {
output$ui <- renderUI( {
tagList(
tags$h2("Numeric inputs that depend on reactive data"),
numericInput("obs1", "Label1", value = input$value, min = input$min, max = input$max, step = 1),
numericInput("obs2", "Label2", value = input$value + 5, min = input$min - 5, max = input$max + 5, step = 1)
)
})
}
shinyApp(ui, server)
Please note that you need to wrap elements in tagList, when you want to pass more than one input element to renderUI.
Hi I'm trying to build a user interface and having problem with column and row positions. What I expect to see is some distance between buttons and entry widgets since I left two empty column between them. So why are they standing just next to the entry widgets and changing the distances between entry areas? Could anyone give me some help about this?
Here is the code...
from Tkinter import*
HMCC=Tk()
HMCC.title(" GUI v1.0 ")
HMCC.geometry("500x300")
entry_1 = Entry(HMCC)
entry_2 = Entry(HMCC)
entry_3 = Entry(HMCC)
entry_4 = Entry(HMCC)
entry_5 = Entry(HMCC)
entry_6 = Entry(HMCC)
entry_7 = Entry(HMCC)
entry_8 = Entry(HMCC)
entry_1.grid(row=2,column=1)
entry_2.grid(row=3,column=1)
entry_3.grid(row=4,column=1)
entry_4.grid(row=5,column=1)
entry_5.grid(row=6,column=1)
entry_6.grid(row=7,column=1)
entry_7.grid(row=8,column=1)
entry_8.grid(row=9,column=1)
Channel_1 = Label(HMCC, text = "Channel 1 : ")
Channel_2 = Label(HMCC, text = "Channel 2 : ")
Channel_3 = Label(HMCC, text = "Channel 3 : ")
Channel_4 = Label(HMCC, text = "Channel 4 : ")
Channel_5 = Label(HMCC, text = "Channel 5 : ")
Channel_6 = Label(HMCC, text = "Channel 6 : ")
Channel_7 = Label(HMCC, text = "Channel 7 : ")
Channel_8 = Label(HMCC, text = "Channel 8 : ")
Channel_1.grid( row = 2, column = 0, sticky = E)
Channel_2.grid( row = 3, column = 0, sticky = E)
Channel_3.grid( row = 4, column = 0, sticky = E)
Channel_4.grid( row = 5, column = 0, sticky = E)
Channel_5.grid( row = 6, column = 0, sticky = E)
Channel_6.grid( row = 7, column = 0, sticky = E)
Channel_7.grid( row = 8, column = 0, sticky = E)
Channel_8.grid( row = 9, column = 0, sticky = E)
#button1 = Button(text=" START " , fg="red" )
#button2 = Button(text=" PAUSE " , fg="blue" )
#button3 = Button(text=" STOP ", fg="green")
#button4 = Button(text="QUIT" , fg="black",command=HMCC.quit)
#button1.grid( row = 1, column = 3)
#button2.grid( row = 2, column = 3)
#button3.grid( row = 3, column = 3)
#button4.grid( row = 4, column = 3)
HMCC.mainloop()
Current view
Thanks in advance
If there is nothing in column 2, then tkinter will ignore it.
In addition to the comment posted above which contains the answer to your question, you can clean up your code significantly by just using a loop:
num_rows = 8
entries = [None]*num_rows
channels = [None]*num_rows
for i in range(num_rows):
channels[i] = Label(HMCC, text = "Channel {0} : ".format(i+1))
channels[i].grid(row=i+2,column=0,sticky=E)
entries[i] = Entry(HMCC)
entries[i].grid(row=i+2, column=1)
Better yet, use list comprehension:
num_rows = 8
entries = [Entry(HMCC).grid(row=i+2, column=1) for i in range(num_rows)]
channels = [Label(HMCC, text = "Channel {0} : ".format(i)).grid(row=i+2,column=0,sticky=E) for i in range(num_rows)]
I have 2 listboxes (which are connected so that items can move from one to the other) and at the end I would like to get all the entries in the second listbox by using a 'Ok' button (or simply closing the frame). I could add/remove values to a list every time an item is selected (as shown in the commented section of the code below) but I would rather have a single line of code along the lines of [master.selected.get(idx) for idx in master.selected.curselection()] in the close function but I am unable to get it working.
Code:
def measurementPopup(self,master):
self.chargeCarrier = StringVar()
self.massModifiers = StringVar()
self.chargeCarrier.set("[M+xH]")
def onselect1(evt):
w = evt.widget
index = int(w.curselection()[0])
value = w.get(index)
# My Dirty fix -> Here I could enter the selected value to a buffer list (to be returned in the ok function).
master.selected.insert(END,value)
master.avail.delete(index)
def onselect2(evt):
w = evt.widget
index = int(w.curselection()[0])
value = w.get(index)
# My Dirty fix -> Here I could remove the selected value from a buffer list (to be returned in the ok function).
master.selected.delete(index)
master.avail.insert(END,value)
def close(self):
# Here I would return the buffer list and close the window
master.measurementWindow = 0
top.destroy()
if master.measurementWindow == 1:
return
master.measurementWindow = 1
top = self.top = Toplevel()
top.protocol( "WM_DELETE_WINDOW", lambda: close(self))
self.charge = Label(top, text = "Charge", width = 10)
self.charge.grid(row = 0, column = 0, sticky = W)
self.min = Label(top, text = "Min", width = 5)
self.min.grid(row=0, column = 1, sticky = W)
self.minCharge = Spinbox(top, from_= 1, to = 3, width = 5)
self.minCharge.grid(row = 0, column = 2, sticky = W)
self.max = Label(top, text = "Max", width = 5)
self.max.grid(row = 0, column = 3, sticky = W)
self.maxCharge = Spinbox(top, from_ = 1, to=3, width=5)
self.maxCharge.grid(row = 0, column = 4, sticky = W)
self.chargeCarrier = OptionMenu(top, self.chargeCarrier, "[M+xH]", "[M+xNa]")
self.chargeCarrier.grid(row = 0, column = 5, sticky = W)
self.availMass = Label(top, text = "Available")
self.availMass.grid(row = 1, column = 1, sticky = W)
self.selectMass = Label(top, text = "Selected")
self.selectMass.grid(row = 1, column = 3, sticky = W)
self.massMod = Label(top, text = "Mass Mods")
self.massMod.grid(row = 2, column = 0, sticky = W)
self.avail = Listbox(top)
for i in UNITS:
if BLOCKS[i]['available'] == 1:
self.avail.insert(END,BLOCKS[i]['human_readable_name'])
self.avail.grid(row = 2, column = 1, columnspan = 2, sticky = W)
self.avail.bind('<<ListboxSelect>>',onselect1)
self.selected = Listbox(top)
self.selected.grid(row = 2, column = 3, columnspan = 2, sticky = W)
self.selected.bind('<<ListboxSelect>>',onselect2)
self.ok = Button(top,text = 'Ok',command = lambda: close(self))
self.ok.grid(row = 3, column = 0, sticky = W)
I have tried to use the following small snippet in the close function:
values = [master.selected.get(idx) for idx in master.selected.curselection()]
print ', '.join(values)
However, the for segment doesn't return anything. I would expect that this is due to the fact that nothing is actually selected but that I would need something opposite, along the lines of master.selected.allitems() (if it exists and if I understand it correctly).
Summary
How would one get all the items in 1 specific listbox?
The .get() function for the Listbox widget allows you to specify a range of items, which can be specified as 0 to END to return a tuple of all the items.
Example:
from Tkinter import *
root = Tk()
l = Listbox(root, width = 15)
l.pack()
l.insert(END, "Hello")
l.insert(END, "world")
l.insert(END, "here")
l.insert(END, "is")
l.insert(END, "an")
l.insert(END, "example")
def close():
global l, root
items = l.get(0, END)
print(items)
root.destroy()
b = Button(root, text = "OK", command = close).pack()
root.mainloop()
I hope this helps, if it's not what you were looking for let me know in a comment and I can try expand my answer.