Isolating variable in Shiny - r

Question

Shiny beginner question, but getting tired after reading the docs and apparently missing the point of isolate(). I am working on a simple app for simulating phenotype based on genotypes. Not important, unless you are a geneticist. What I want to achieve is that only changing values of m or N results in re-sampling genotypes G and displays them in the table. When I change mean effect or its std. dev., I want only the 1 st row values to change. Was trying to add isolate when I call currG() and currBetas() but no desired effect achieved. Would be grateful for some hints. The code:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Phenotype simulator"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("N",
"Number of individuals:",
min=1000,
max=10000,
step = 1000,
value=5000),
sliderInput("m",
"Number of markers:",
min=1,
max=10,
step=1,
value=5),
sliderInput("betas_mu",
"Mean effect:",
min=0,
max=5,
step=.5,
value=1),
sliderInput("betas_sd",
"Effect SD:",
min=0,
max=3,
step=0.1,
value=1),
sliderInput("e_mu",
"Mean error:",
min=0,
max=0.5,
step=0.01,
value=0.25),
sliderInput("e_sd",
"Error SD:",
min=0,
max=1,
step=0.01,
value=1),
sliderInput("m_neg",
"Number of markers with negative effect:",
value = 0,
step = 1,
min = 0,
max = 5
),
sliderInput("q",
"Minor allele frequency:",
min=0,
max=1,
step=0.01,
value=.33),
# sliderInput("precision",
# "Decimals:",
# min=1,
# max=5,
# value=3),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
p("Error and simulated trait distributions", style="font-size:15pt"),
plotOutput("distPlot"),
p("Genotypes for the first 5 individuals", style="font-size:15pt"),
tableOutput("genos"),
p("Distribution of effect sizes", style="font-size:15pt"),
plotOutput("eff_distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
currG <- function() {
p <- 1 - input$q
q <- input$q
m <- input$m
N <- input$N
gt <- sample(x = c(0,1,2), size = (input$N * input$m), replace = T, prob = c(p^2, p*q, q^2))
G <- matrix(gt, ncol = m, byrow = T)
return(G)
}
currBetas <- function() {
cg <- currG()
m <- dim(cg)[2]
N <- dim(cg)[1]
m_neg <- input$m_neg
betas <- abs(rnorm(n = m, mean = input$betas_mu, sd = input$betas_sd))
negative_idx <- sample(c(1:m), size=m_neg, replace=F)
signs <- rep(1, times=m)
betas[negative_idx] <- -betas[negative_idx]
return(list(betas=betas, signs=signs))
}
currPheno <- function() {
G <- currG()
tmp <- currBetas()
N <- dim(G)[1]
m <- dim(G)[2]
m_neg <- input$m_neg
errors <- rnorm(n = N, mean = input$e_mu, sd = input$e_sd)
y <- G %*% (tmp$signs * tmp$betas) + errors
y2 <- round(y, digits = 3)
data <- data.frame(error = errors, y = y2)
dat <- data %>% pivot_longer(cols = c(error, y))
return(list(dat=dat, betas=betas, G=G))
}
output$eff_distPlot <- renderPlot({
dat <- data.frame(value=rnorm(n = 1000, mean = input$betas_mu, sd = input$betas_sd))
ggplot(dat, mapping = aes(x=value)) +
geom_histogram(mapping = aes(fill='orange')) +
theme_bw()
})
output$distPlot <- renderPlot({
new_data = currPheno()
ggplot(new_data$dat, mapping = aes(x=value)) +
geom_histogram(mapping = aes(fill=name), bins = input$bins) +
theme_bw() +
facet_wrap(~name)
})
output$genos <- renderTable({
G <- currG()
B <- currBetas()
G <- G[1:5,]
tmp <- apply(G, MARGIN = c(1,2), as.integer)
tmp <- cbind(c('effect', paste0("ind", 1:dim(G)[1])), rbind(round(B$betas, 3), G))
colnames(tmp) <- c(" ", paste0("SNP", c(1:dim(G)[2])))
print(tmp)
},
colnames = T
)}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

Indeed, reactiveValues along with observeEvent and observe seem to be a much nicer and cleaner way to achieve what I wanted. Still a lot to learn when it comes to Shiny but one step forward has been made. Thanx MrFlick for suggestions!
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Phenotype simulator"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("N",
"Number of individuals:",
min=1000,
max=10000,
step = 1000,
value=5000),
sliderInput("m",
"Number of markers:",
min=1,
max=10,
step=1,
value=5),
sliderInput("betas_mu",
"Mean effect:",
min=0,
max=5,
step=.5,
value=1),
sliderInput("betas_sd",
"Effect SD:",
min=0,
max=3,
step=0.1,
value=1),
sliderInput("e_mu",
"Mean error:",
min=0,
max=0.5,
step=0.01,
value=0.25),
sliderInput("e_sd",
"Error SD:",
min=0,
max=1,
step=0.01,
value=1),
sliderInput("m_neg",
"Number of markers with negative effect:",
value = 0,
step = 1,
min = 0,
max = 5
),
sliderInput("q",
"Minor allele frequency:",
min=0,
max=1,
step=0.01,
value=.33),
# sliderInput("precision",
# "Decimals:",
# min=1,
# max=5,
# value=3),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
p("Genotypes for the first 5 individuals", style="font-size:15pt"),
tableOutput("genos"),
tableOutput("betas"),
plotOutput("errors"),
plotOutput("phenos"),
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
rvals <- reactiveValues(
G = NULL,
betas = NULL,
errors = c(0),
phenos = c(0),
)
observeEvent(c(input$N, input$m, input$q), {
p <- 1 - input$q
q <- input$q
gt <- sample(x = c(0,1,2),
size = (input$N * input$m),
replace = T,
prob = c(p^2, p*q, q^2))
rvals$G <- matrix(gt, ncol = input$m, byrow = T)
})
observe({
betas <- abs(rnorm(n = input$m,
mean = input$betas_mu,
sd = input$betas_sd))
negative_idx <- sample(c(1:input$m), size=input$m_neg, replace=F)
signs <- rep(1, times=input$m)
betas[negative_idx] <- -betas[negative_idx]
rvals$betas <- betas
})
observe({
N <- dim(rvals$G)[1]
m <- dim(rvals$G)[2]
errors <- rnorm(n = N, mean = input$e_mu, sd = input$e_sd)
rvals$errors <- errors
})
observe({
phenos <- round(rvals$G %*% rvals$betas + rvals$errors, digits = 3)
rvals$phenos <- phenos
})
output$genos <- renderTable({
rvals$G[1:5,]
})
output$betas <- renderTable({
t(rvals$betas)
})
output$errors <- renderPlot({
x <- data.frame(errors = rvals$errors)
ggplot(x, mapping = aes(x = errors)) +
geom_histogram() +
theme_bw()
})
output$phenos <- renderPlot({
x <- data.frame(phenos = rvals$phenos)
ggplot(x, mapping = aes(x = phenos, fill = 'orange')) +
geom_histogram() +
theme_bw()
})
}
# Run the application
shinyApp(ui = ui, server = server)