How to extract input from a dynamic matrix in R shiny - html

This is related to an old question about creating a matrix-style input in a shiny app with dynamic dimensions. My goal is to have a matrix of numerical inputs (the dimensions of which are determined by other user inputs), and then pass that matrix to other R commands and print some output from those calculations. I have code that successfully executes everything except that I can only access the user inputs as characters.
Here is an example that sets up the input and just prints a couple cells from the matrix (this works fine, but isn't what I need):
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("test"),
sidebarPanel(
numericInput(inputId = "nrow",
label = "number of rows",
min = 1,
max = 20,
value = 1),
numericInput(inputId = "ncol",
label = "number of columns",
min = 1,
max = 20,
value = 1)
),
mainPanel(
tableOutput("value"),
uiOutput("textoutput"))
),
server = function(input,output){
isolate({
output$value <-renderTable({
num.inputs.col1 <- paste0("<input id='r", 1:input$nrow, "c", 1, "' class='shiny-bound-input' type='number' value='1'>")
df <- data.frame(num.inputs.col1)
if (input$ncol >= 2){
for (i in 2:input$ncol){
num.inputs.coli <- paste0("<input id='r", 1:input$nrow, "c", i, "' class='shiny-bound-input' type='number' value='1'>")
df <- cbind(df,num.inputs.coli)
}
}
colnames(df) <- paste0("time ",as.numeric(1:input$ncol))
df
}, sanitize.text.function = function(x) x)
})
output$textoutput <- renderUI(paste0("Cells [1,1] and [2,2]: ",input$r1c1,",",input$r2c2))
}
))
However, when I try to do any operation on the inputs in the matrix, such as output$textoutput <- renderUI(as.numeric(paste0(input$r1c1))+as.numeric(paste0(input$r2c2))), I get classic R errors like $ operator is invalid for atomic vectors. I have tried many combinations of 'as.numeric', 'as.character', ect. to try to get it into the correct format. When I check the structure of those input cells, I see that they have an extra 'NULL' attribute that I can't seem to get rid of, but I am unsure if that is the root of the problem.
In short, how do I extract the plain numbers from that matrix? Or is there a better way to do this in shiny? The only other solution I'm aware of is the rhandsontable package, which I would prefer not to use if there is a reasonable alternative.
Any suggestions would be very appreciated. Thank you!
Edit/solution: replacing renderUI and uiOutput with renderPrint and verbatimTextOutput solves the problem. Thank you for the comment, blondeclover!

Related

Deleting commas in R Markdown html output

I am using R Markdown to create an html file for regression results tables, which are produced by stargazer and lfe in a code chunk.
library(lfe); library(stargazer)
data <- data.frame(x = 1:10, y = rnorm(10), z = rnorm(10))
result <- stargazer(felm(y ~ x + z, data = data), type = 'html')
I create a html file win an inline code r result after the chunk above. However, a bunch of commas appear at the top of the table.
When I check the html code, I see almost every </tr> is followed by a comma.
How can I delete these commas?
Maybe not what you are looking for exactly but I am a huge fan of modelsummary. I knit to HTML to see how it looks and then usually knit to pdf. The modelsummary equivalent would look something like this
library(lfe)
library(modelsummary)
data = data.frame(x = 1:10, y = rnorm(10), z = rnorm(10))
results = felm(y ~ x + z, data = data)
modelsummary(results)
There are a lot of ways to customize it through kableExtra and other packages. The documentation is really good. Here is kind of a silly example
library(kableExtra)
modelsummary(results,
coef_map = c("x" = "Cool Treatment",
"z" = "Confounder",
"(Intercept)" = "(Intercept)")) %>%
row_spec(1, background = "#F5ABEA")

Extend width of column with renderDataTable in Shiny

I having trouble understanding the behavior of renderDataTable function using Shiny.
I am trying to extend the width of one specific column.
When I am not using Shiny, and just trying to visualize the output of the table, I write the below and I get the expected output in the plot (Amazon Title column is extended):
Category <- c("Tools & Home Improvement", "Tools & Home Improvement")
AmazonTitle <- c("0.15,Klein Tools NCVT-2 Non Contact Voltage Tester- Dual Range Pen Voltage Detector for Standard and Low Voltage with 3 m Drop Protection", " ABCDFGEGEEFE")
ASIN_url <- c("<a href='https://www.amazon.com/dp/B004FXJOQO'>https://www.amazon.com/dp/B004FXJOQO</a>", "<a href='https://www.amazon.com/dp/B004FXJOQO'>https://www.amazon.com/dp/B0043XJOQO</a>")
ASIN <- c("B004FXJOQO", "B0043XJOQO")
All_ASIN_Information <- data.frame(Category, AmazonTitle, ASIN_url, ASIN)
DT::datatable(All_ASIN_Information, escape=FALSE,
options = list(
pageLength = 20, autoWidth = TRUE,
columnDefs = list(list( targets = 2, width = '600px'))
)
)
But when I use this exact block inside a DT::renderDataTable function for Shiny, the result is different and the column width is not extended....
See behavior for Shiny with below code:
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
DT::dataTableOutput("Table_ASIN")))
server <- function(input, output){
output$Table_ASIN <- DT::renderDataTable(
DT::datatable(All_ASIN_Information, escape=FALSE,
options = list(
pageLength = 20, autoWidth = TRUE,
columnDefs = list(list( targets = 2, width = '600px'))
)))
}
shinyApp(ui, server)
I don't know if this behavior is caused by the hyperlinks created in column 'ASIN_url' but I would really need them anyway.
Any help much appreciated on this !
One option would be to shorten the link like this:
ASIN_url <- c("<a href='https://www.amazon.com/dp/B004FXJOQO'>Link</a>", "<a href='https://www.amazon.com/dp/B004FXJOQO'>Link</a>")
Another would be to add a scroll bar by including scrollX = TRUE in the option list

Get the name in selectInput widget in R shiny

I'm using the selectInput function of shiny package with option groups like this Output of the selectInput function
In the ui.r file i've something like that:
ListOfItemsWithNames = list(condition = c("KO","WT"),treatment = c("non","oui"))
selectInput("Select1_contrast",label="Compare",ListOfItemsWithNames)
In the server.R file, when i call input$Select1_contrast I only get the selected value ("oui" for instance).
Is there a way to get both the value an the name of the variable (ie, "oui" and "treatment") ?
Here is another possibility. It uses key-value pairs. Those pairs are allowed according to the documentation of selectInput
choices List of values to select from. If elements of the list are named, then that name rather than the value is displayed to the user. This can also be a named list whose elements are (either named or unnamed) lists or vectors. If this is the case, the outermost names will be used as the "optgroup" label for the elements in the respective sublist. This allows you to group and label similar choices. See the example section for a small demo of this feature.
addKeys = function(nested_list){
keyed_nl = list()
for (a in names(nested_list))
for (b in (nested_list[[a]]))
keyed_nl[[a]][[b]] = paste0(a, "-", b)
keyed_nl
}
ListOfItemsWithNames = list(condition = c("KO", "WT"),
treatment = c("non", "oui"))
keyedList = addKeys(ListOfItemsWithNames)
library(shiny)
shinyApp(
fluidPage(
selectInput("choiceKey", "choose", keyedList),
textOutput('text')
),
function(input, output, session)
output$text = renderText(input$choiceKey)
)
As you can see, input$choiceKey will give you the category and the choice seperated with -. Using strsplit, you can get both parts seperately
This should work. In this version, you have a sencond dropdown menu and therefore a second input.
library(shiny)
ListOfItemsWithNames = list(condition = c("KO","WT"),treatment = c("non","oui"))
ui = inputPanel(
selectInput("category", "choose a category", names(ListOfItemsWithNames )),
selectInput("choice", "select a choice", ListOfItemsWithNames[[1]])
)
server = function(input, output, session){
observe({
updateSelectInput(session, "choice",
choices = ListOfItemsWithNames[[input$category]])
})
}
shinyApp(ui, server)

plotting interaction from mixed model lme4 with CI bands

I have the following mixed effects model:
p1 <- lmer(log(price) ~ year*loca + (1|author), data = df)
'year' is continuous
'loca' is categorical variable with 2 levels
I am trying to plot the significant interaction from this model.
The following code (using the visreg package) plots the lines from each of the two 'loca' but it does not produce a 95% confidence band:
visreg(p1, "year", by = "loca", overlay = T,
line=list(lty = 1, col = c("grey", "black")), points=list(cex=1, pch=19,
col = c("grey", "black")), type="conditional", axes = T)
Then, I tried the following code which allows me to plot the lines, but with no data points on top and no CIs:
visreg(p1, "year", by = "loca", overlay = T,
line=list(lty = 1, col = c("grey60", "black")), points=list(cex=1,
pch=19, col = c("grey", "black")),
type="conditional", trans = exp, fill.par = list(col = c("grey80",
"grey70")))
I get CI bands when I use type = 'contrast' rather than 'conditional'. However, this doesn't work when I try to backtransform the price as above using trans = exp.
Overall I need to be able to plot the interaction with the following attributes:
Confidence bands
backtransformed points
predicted line (one for each level of 'loca')
More than happy to try other methods....but I can't seem to find any that work so far.
Help much appreciated!
one possibility is with the use of the effects package:
library(effects)
eff.p1 <- effect("year*loca", p1, KR=T)
then you could either directly plot it with what the package provides and customize it from there:
plot(eff.p1)
or take what effect produces and plot it with ggplot in a nicer plot:
eff.p1 <- as.data.frame(eff.p1)
ggplot(eff.p1, aes(year, linetype=factor(loca),
color = factor(loca))) +
geom_line(aes(y = fit, group=factor(loca)), size=1.2) +
geom_line(aes(y = lower,
group=factor(loca)), linetype =3) +
geom_line(aes(y = upper,
group=factor(loca)), linetype =3) +
xlab("year") +
ylab("Marginal Effects on Log Price") +
scale_colour_discrete("") +
scale_linetype_discrete("") +
labs(color='loca') + theme_minimal()
I can't really try the code without the data, but I think it should work.
This should do the trick:
install.packages(sjPlot)
library(sjPlot)
plot_model(p1, type = "int", terms = c(year,loca), ci.lvl = 0.95)
Although it comes out with some warnings about labels, testing on my data, it does the back transformation automatically and seems to work fine. Customising should be easy, because I believe sjPlot uses ggplot.
EDIT: #Daniel points out that alternative options which allow more customization would be plot_model(type = "pred", ...) or plot_model(type = "eff", ...)

Two inputs for the same value in Shiny

I'm new to shiny and i don't know anything about html, I'm having an issue to find a way to get a slider and a numeric input at the same time for the same input value in my app. Also I would like that when i for instance set the numeric value to 25 the slider automatically sets itself to 25 once the button is pushed.
Thank you for your help.
I tried that for my ui but it doesn't work ...
library(shiny)
shinyUI(fluidPage(
numericInput(inputId = "num1",
label = "Jour limite",
value = 10, min = 1, max=500),
sliderInput(inputId = "num",
label= "Jour limite",
value= 10 ,min=1 ,max=500
),
actionButton(inputId="clicks",
label= "Actualiser"),
plotOutput("courbj")
))
Don't know if it's relevant but here is my server code :
print(getwd())
CourbeTot <- read.table("data/CourbeTot.csv",header=TRUE,sep=";")
shinyServer(
function(input,output) {
valeur <- eventReactive(input$clicks, {
(input$num)
})
output$courbj <- renderPlot({
plot(CourbeTot$DFSurvieTot.time,CourbeTot$DFSurvieTot.ProptionAuDelaDe,xlim=c(1,2*valeur()))
})
})
You can try to set a reactive Input (slider and numeric) using renderUI on server site.
here the UI.R
library(shiny)
shinyUI(fluidPage(
uiOutput("INPUT"),
uiOutput("SLIDER"),
plotOutput("courbj")
))
Here the Server.R.
library(shiny)
print(getwd())
CourbeTot <- 1:10
shinyServer(
function(input,output) {
valeur <- reactive({
S <- input$num
N <- input$num1
max(c(10,S,N))
})
output$courbj <- renderPlot({
plot(c(CourbeTot,valeur()))
})
# rective slider and numeric input
output$SLIDER = renderUI({
sliderInput(inputId = "num",
label= "Jour limite",
value= valeur() ,min=1 ,max=500)
})
output$INPUT = renderUI({
numericInput(inputId = "num1",
label = "Jour limite",
value = valeur(), min = 1, max=500)
})
})
As you provided no reproducible example I created one. Slider and numeric Input will change according to the other, respectively. This is done 1. per the max function which will alwas output the highest value set by one of the two inputs. And. 2 that the inputs are moved to the server side using the renderUI. You see that I removed the click button because of problems with the initial NULL behavior. Upon this error you can't (or I found no way) select one value and update the other after the click. This seems to be a shiny bug asked already here. The code is not perfect, but I think it is a good basis to play around and you can adjust it for your purpose.