I would like to know if it is possible to use the data described in a textAreaInput in a function.
I need the model described in the text field to be filled in the field specified in the function (my_model), replacing "dmodel()".
This is my code:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
library(psych)
library(MPsychoR)
library(ggplot2)
library(semPlot)
library(lavaan)
# Dashboard
ui <- fluidPage(
titlePanel("CFA"),
sidebarLayout(
sidebarPanel(
h4("Model")
),
# Show a plot of the generated distribution
mainPanel(
box(
textAreaInput(
width = 2000,
"dmodel", "Insert the model"),
br(),
box(
width = 2000,
plotOutput("cfagra")
),
box(
width = 2000,
verbatimTextOutput("cfares")
)
),
)
)
)
# Server
server <- function(input, output, session) {
# Copy the model for functions
dmodel <- reactive({
as.data.frame(input$dmodel)
})
# CFA Synthesis
output$cfares <-
renderPrint({
# Calculation of CFA
my_model <- 'dmodel()'
fitModel <- lavaan::cfa(my_model, data = csv(),
ordered = names(csv()))
summary(fitModel, standardized=TRUE,fit.measures=TRUE)
modindices(fitModel)
})
# Plot
output$cfagrafico <- renderPlot({
# Calculation of CFA
my_model <- 'dmodel()'
fitModel <- lavaan::cfa(my_model, data = csv(),
ordered = names(csv()))
semPaths(fitModel, what = "est", edge.label.cex = 0.7,
edge.color = 1, esize = 1, sizeMan = 4.5, asize = 2.5,
intercepts = FALSE, rotation = 4, thresholdColor = "red",
mar = c(1, 5, 1.5, 5), fade = FALSE, nCharNodes = 4)
summary(fitModel, standardized=TRUE,fit.measures=TRUE)
modindices(fitModel)
})
}
# App
shinyApp(ui = ui, server = server)
Based on lavaan documentation, my_model should be a string.
First,
dmodel <- reactive({
input$dmodel
})
and then call the reactive value without quotes.
output$cfares <-
renderPrint({
# Calculation of CFA
my_model <- dmodel()
fitModel <- lavaan::cfa(my_model, data = csv(),
ordered = names(csv()))
summary(fitModel, standardized=TRUE,fit.measures=TRUE)
modindices(fitModel)
})
Related
I'm building a basic R Shiny app, and have a list that contains individual lists, each storing a dataframe and a value. I've included sample data to demonstrate my list of lists. Within my app I am trying to have one select option (a dropdown menu that says "List 1", List 2", etc) and then have the main panel in the app display a boxplot of the dataframe (x and y) and a text output of the value stored in the list that was selected.
I'm having trouble with the ability to make the outputs (both plot and text) reactive to the input and display data from the selected list.
I've put my code of what I have so far below.
## Example Data
list_a <- list(df = data.frame(x = rnorm(n = 10, mean = 5, sd = 2),
y = rnorm(n = 10, mean = 7, sd = 3)),
value = "a")
list_b <- list(df = data.frame(x = rnorm(n = 10, mean = 20, sd = 5),
y = rnorm(n = 10, mean = 13, sd = 7)),
value = "b")
list_c <- list(df = data.frame(x = rnorm(n = 10, mean = 12, sd = 4),
y = rnorm(n = 10, mean = 10, sd = 4)),
value = "c")
mylist <- list(list_a, list_b, list_c)
## Packages
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel('Data'),
sidebarPanel(
selectInput('data', 'Dataset',
choices = c("1" = list_a, "2" = list_b, "3" = list_c)),
),
mainPanel(
plotOutput('plot1'),
textOutput('text1')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
reactivedata <- boxplot(input$data)
boxplot(reactivedata$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
reactivetext <- print(input$data)
print(reactivetext$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Main issue with your code that you used your raw lists for the choices argument. Additionally I added a reactive to pick the right list according to the user's input:
set.seed(123)
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
selectInput("data", "Dataset",
choices = c("list_a" = 1, "list_b" = 2, "list_c" = 3)
),
),
mainPanel(
plotOutput("plot1"),
textOutput("text1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
reactivedata <- reactive({
mylist[[as.integer(input$data)]]
})
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
boxplot(reactivedata()$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
print(reactivedata()$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4502
#> [1] "a"
Trying to edit a reactive database so that updates to the database are reflected in the output.
Have tried numerous variants, but none are working, general idea is shown - where I would like to have the figure update with changes to the database.
library(tidyverse)
library(shiny)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("ages", "Max age:", 10, 100, 15),
sliderInput("nsamp",
"Sample size:",
min = 10,
max = 1000,
value = 100)),
mainPanel(dt_output('Sample sizes and weighting', 'x1'),
plotOutput("fig"))
)
)
server <- function(input, output) {
x = reactive({
df = data.frame(age = 1:input$ages,
samples = input$nsamp,
weighting = 1)
})
output$x1 = renderDT(x(),
selection = 'none',
editable = TRUE,
server = TRUE,
rownames = FALSE)
output$fig = renderPlot({
ggplot(x(), aes(age, samples)) +
geom_line() +
geom_point()
})
}
shinyApp(ui = ui, server = server)
We can use input$x1_cell_edit and reactiveValues to modify the data that is passed to the plot.
Note the use of isolate inside renderDT, that is to prevent the table from re-rendering when db$database is modified.
library(tidyverse)
library(shiny)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("ages", "Max age:", 10, 100, 15),
sliderInput("nsamp",
"Sample size:",
min = 10,
max = 1000,
value = 100
)
),
mainPanel(
dataTableOutput("x1"),
plotOutput("fig")
)
)
)
server <- function(input, output) {
# all the data will be stored in this two objects
db <- reactiveValues(database = NULL)
# to store the modified values
edited_vals <- reactiveVal(tibble(row = numeric(), col = numeric(), value = numeric()))
# create a new table each time the sliders are changed
observeEvent(c(input$ages, input$nsamp), {
df <- data.frame(
age = 1:input$ages,
samples = input$nsamp,
weighting = 1
)
db$database <- df
})
observeEvent(input$x1_cell_edit, {
db$database[as.numeric(input$x1_cell_edit$row), as.numeric(input$x1_cell_edit$col + 1)] <- as.numeric(input$x1_cell_edit$value)
})
output$x1 <- renderDT(
{
input$ages
input$nsamp
datatable(
isolate(db$database),
selection = "none",
editable = TRUE,
rownames = FALSE,
options = list(stateSave = TRUE)
)
},
server = TRUE
)
output$fig <- renderPlot({
ggplot(db$database, aes(as.numeric(age), as.numeric(samples))) +
geom_point() +
geom_line()
})
}
shinyApp(ui = ui, server = server)
I am using LDAvis in R shiny app.
Here is the code and it works without errors.
# docs is a csv file with a "text" column, e.g.
# docs <- read.csv("docs.csv",sep=",",header=TRUE)
ui <- navbarPage(
title = "NLP app",
tabPanel("Topic Model",icon = icon("group"),
fluidPage(
headerPanel(""),
titlePanel(p(h2("Topic Modelling example",style = "color:#4d3a7d"))),
#sidebarPanel(
wellPanel(tags$style(type="text/css", '#leftPanel { width:200px; float:left;}'), style = "background: lightgrey",
id = "leftPanel",
sliderInput("nTopics", "Number of topics to display", min = 5, max = 50, value = 10, step=5),
sliderInput("nTerms", "#top terms per topic", min = 10, max = 50, value = 20, step=5),
tags$hr(),
actionButton(inputId = "GoButton", label = "Go", icon("refresh"))
),
mainPanel(
tabPanel("Topic Visualisation", hr(),helpText(h2("Please select a topic!")), visOutput('visChart')))
)
)
)
# server
server <- function(input, output, session) {
Topic_Subset <- reactive({
docs <- docs$text
nTopics <- input$nTopics
# topic model using text2vec package
tokens = docs %>%
tolower %>%
word_tokenizer
it = itoken(tokens, progressbar = FALSE)
v = create_vocabulary(it,stopwords=tm::stopwords("en"))
vectorizer = vocab_vectorizer(v)
dtm = create_dtm(it, vectorizer, type = "dgTMatrix")
lda_model = text2vec::LDA$new(n_topics = nTopics, doc_topic_prior = 0.1, topic_word_prior = 0.01)
lda_model$fit_transform(x = dtm, n_iter = 1000,
convergence_tol = 0.001, n_check_convergence = 25,
progressbar = FALSE)
return(lda_model) #
})
output$visChart <- renderVis({
input$GoButton
isolate({
nterms <- input$nTerms
lda_model <- Topic_Subset()
})
lda_model$plot(out.dir = "./results", R = nterms, open.browser = FALSE)
readLines("./results/lda.json")
})
}
shinyApp(ui = ui, server = server)
I would like to see whether it is possible to use width = "80%" in visOutput('visChart') similar to, for example, wordcloud2Output("a_name",width = "80%"); or any alternative methods to make the size of visualization smaller. Particularly, when I minimize the shiny app window, the plot does not fit in the page. My second question is: how can I initialize the parameter lambda (please see the below image and yellow highlights) with another number like 0.6 (not 1)?
I want to allow the users to see the changes in inputs to be reflected on the table directly. So as soon as the user changes numeric value for inputlower it should reflect the change in column lower_rate in the table and also multiply that value with low_val. Is this possible with observeEvent on numeric input change.
input_data <- data.frame(lower_rate = c (.5, .5, .5),
low_val = c(10,11,12),
upper_rate = c(1.5, 1.5, 1.5),
upp_val = c(20,21,22),
stringsAsFactors = FALSE)
ui <- shinyUI(
fluidPage(
titlePanel("Basic DataTable"),
# Create a new row for the table.
fluidRow(
column(12,
numericInput("low", label = h3("lower"), value = 0.5),
numericInput("up", label = h3("Upper"), value = 1.5),
dataTableOutput(outputId="table")
)
)
)
)
server <- shinyServer(function(input, output) {
d <- reactive({
input_data
})
dat <- reactiveValues(dat=NULL)
observe({
dat$dat <- d()
})
output$table <- renderDataTable({
dat$dat
})
})
shinyApp(ui=ui,server=server)```
I believe it would be best to edit the column value inside the reactive environment renderDataTable. The observe events are not needed. As long as you don't use the <<- notation to write to environment, this wont change the original data.
library(shiny)
library(data.table)
input_data <- data.frame(lower_rate = c(.5, .5, .5),
low_val = c(10,11,12),
upper_rate = c(1.5, 1.5, 1.5),
upp_val = c(20,21,22),
stringsAsFactors = FALSE)
ui <- shinyUI(
fluidPage(
titlePanel("Basic DataTable"),
# Create a new row for the table.
fluidRow(
column(12,
numericInput("low", label = h3("lower"), value = 0.5),
numericInput("up", label = h3("Upper"), value = 1.5),
dataTableOutput(outputId="table")
)
)
)
)
server <- shinyServer(function(input, output) {
output$table <- renderDataTable({
input_data$lower_rate <- input$low
#it is not clear where you want the multiplied value to end up
input_data$new_val <- input$low*input_data$low_val
data.table(input_data)
})
})
shinyApp(ui=ui,server=server)
I would like a user to be able to type in the name of a dataframe object and have that object rendered as a formatted data table in a Shiny application.
Here is a toy example. There are two dataframe objects available in the workspace: df1 and df2. When the user types in df1, I would like that dataframe to be rendered. Likewise for df2 or for any other dataframe they have in their workspace.
I suspect I have to do something with environments or scoping or evaluation but I am not sure what.
I have commented in the code where I can hardcode in the built-in mtcars dataset and have that rendered correctly. Now I just want to be able to do the same for any ad-hoc dataframe in a user's workspace.
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
# Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
textInput("dfInput", h5("Enter name of dataframe"),
value = "")),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
input$dfInput # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
We are going to get all the dataframes within the global enviriment first and then use get in order to access the object. I changed the textInput to selectInput so you dont need to type anything, potentially making a mistake. Moreover I added the data from datasets package however you should build more test cases to check if the data exists
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
mydataframes <- names(which(unlist(eapply(.GlobalEnv,is.data.frame))))
OpenData <- data()$results[,3]
#Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
selectInput("dfInput","Select Dataframe",
#choices = mydataframes,
list("Your Datasets" = c(mydataframes),
"R Datasets" = c(OpenData),
selected=NULL))),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
as.data.frame(get(input$dfInput)) # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)