R shiny how to partly change dataframe to plot? - r

The composition of my data has 4 parts, all_data <- rbind(data1,data2,data3,data4)
In shiny,I want to when I slider sliderinput 1,only data1 changed in this dataframe.
When I change slider 2,only data2 changed in this dataframe.
But when I changed every slider,all data will change ,maybe I should use observeEvent like this,but I am faild.
observeEvent(ignoreInit = TRUE,
c(input$Mean1,input$SD1), {
mean1 <- input$Mea1
sd1 <- input$SD1
n_sample <- 5
x1 <- 1:5
y1 <- rnorm(n_sample,mean1, sd1)
z1 <- rep("Distribution 1",length(x1) )
mean_1 <- rep(mean(y1),length(x1))
data1 <-data.frame(x = x1,y = y1,z = z1,my_mean =mean_1)
})
There is all my code, could you please tell me how to modify it. Thanks!
rm(list = ls())
library(shiny)
library(shinythemes)
library(ggplot2)
library(plotly)
ui_chart <- sidebarPanel(width =3,position = "right",
sliderInput("Mean1", "Mean of the distrubution1", -30, 30, value = -10),
sliderInput("Mean2", "Mean of the distrubution2", -30, 30, value = 0),
sliderInput("Mean3", "Mean of the distrubution3", -30, 30, value = 10),
sliderInput("Mean4", "Mean of the distrubution4", -30, 30, value = 20),
sliderInput("SD1", "Within group sd", 0.1, 20, value =6)
)
ui <- navbarPage("Distrubution for each group", theme = shinytheme("flatly"),
tabPanel("Distrubution simulation",
titlePanel("Within group and between group variance"),
mainPanel(width = 9
,plotlyOutput("chart2")
)
,ui_chart
)
)
server <- function(input, output) {
output$chart2 <- renderPlotly({
mean1 <- input$Mean1
mean2 <- input$Mean2
mean3 <- input$Mean3
mean4 <- input$Mean4
sd1 <- input$SD1
n_sample <- 5
x1 <- 1:5
y1 <- rnorm(n_sample,mean1, sd1)
z1 <- rep("Distribution 1",length(x1) )
mean_1 <- rep(mean(y1),length(x1))
data1 <-data.frame(x = x1,y = y1,z = z1,my_mean =mean_1 )
x2 <- 6:10
y2 <- rnorm(n_sample,mean2, sd1)
z2 <- rep("Distribution 2",length(x2) )
mean_2 <- rep(mean(y2),length(x2))
data2 <-data.frame(x = x2,y = y2,z = z2,my_mean =mean_2)
x3 <- 11:15
y3 <- rnorm(n_sample,mean3, sd1)
z3 <- rep("Distribution 3",length(x3) )
mean_3 <- rep(mean(y3),length(x3))
data3 <-data.frame(x = x3,y = y3,z = z3,my_mean =mean_3)
x4 <- 16:20
y4 <- rnorm(n_sample,mean4, sd1)
z4 <- rep("Distribution 4",length(x4) )
mean_4 <- rep(mean(y4),length(x4))
data4 <-data.frame(x = x4,y = y4,z = z4,my_mean =mean_4)
all_data <- rbind(data1,data2,data3,data4)
all_data$mean_all <- mean(all_data$y)
p2 <- ggplot(data = all_data)+
geom_point(aes(x = x ,y = y,color = z))+
geom_line(aes(x = x ,y = my_mean ,color = z))+
geom_line(aes(x = x ,y = mean_all ),color = "black")+
scale_x_continuous(breaks = c(1:20),
labels = paste0("Obs",1:20))+
ggtitle("Observed sampale data")+
theme_bw()+
labs(color = "Distribution")+
theme(plot.title = element_text(hjust = 0.5))
ggplotly(p2)
})
}
shinyApp(ui, server)

Well since you are using rnorm, you are getting new random values every-time an input changes. If you want to isolate those changes, you might want to make separate reactive data objects for each of the studies. Here's one way to do that
server <- function(input, output) {
generate_data <- function(dist, ids, n_sample, sample_mean, sample_sd) {
x <- 1:5
y <- rnorm(n_sample,sample_mean, sample_sd)
z <- rep(paste("Distribution", dist),length(x) )
mean <- rep(mean(y),length(x))
data.frame(x = ids, y = y, z = z, my_mean =mean)
}
n_sample <- 5
data1 <- reactive(generate_data("1", 1:5, n_sample, input$Mean1, input$SD1))
data2 <- reactive(generate_data("2", 6:10, n_sample, input$Mean2, input$SD1))
data3 <- reactive(generate_data("3", 11:15, n_sample, input$Mean3, input$SD1))
data4 <- reactive(generate_data("4", 16:20, n_sample, input$Mean4, input$SD1))
output$chart2 <- renderPlotly({
all_data <- rbind(data1(),data2(),data3(),data4())
all_data$mean_all <- mean(all_data$y)
p2 <- ggplot(data = all_data)+
geom_point(aes(x = x ,y = y,color = z))+
geom_line(aes(x = x ,y = my_mean ,color = z))+
geom_line(aes(x = x ,y = mean_all ),color = "black")+
scale_x_continuous(breaks = c(1:20),
labels = paste0("Obs",1:20))+
ggtitle("Observed sampale data")+
theme_bw()+
labs(color = "Distribution")+
theme(plot.title = element_text(hjust = 0.5))
ggplotly(p2)
})
}
Here we make a helper function to generate the data for each of the groups. We store the data in a reactive object that only depends on the group mean. Therefore they won't change when other inputs change

Related

R Getting numeric matrix from predict()

I have the following code:
fit_lm=lm(z~x+y)
mix <- 2
max <- 12
miy <- 2
may <- 12
griddf <- expand.grid(x = seq(mix,max, length.out = 10),
y = seq( miy,may,length.out = 10))
Prediction_data <- data.frame(griddf)
colnames(Prediction_data) <- c("x", "y")
coordinates(Prediction_data ) <- ~ x + y
terrain_lm <- predict(fit_lm, Prediction_data)
I want that terrain_lm is a numeric matrix, in such a way, that I can use
fig <- plot_ly()
fig <- fig %>% add_surface(terrain_lm)
but I get a 1d array with 100 elements.
The result of predict is a vector. You need to add it to the x and y values and then use xtabs to transform into a suitable matrix for a surface plot.
library(plotly)
#test data
x <- runif(20, 4, 10)
y <- runif(20, 3, 6)
z <- 3*x+y +runif(20, 0, 2)
fit_lm <- lm(z~x+y)
mix <- 2
max <- 12
miy <- 2
may <- 12
griddf <- expand.grid(x = seq(mix,max, length.out = 10),
y = seq( miy,may,length.out = 10))
terrain_lm <- data.frame(griddf)
terrain_lm$z <- predict(fit_lm, terrain_lm)
fig <- plot_ly(z = ~xtabs(z ~ x + y, data = terrain_lm))
fig <- fig %>% add_surface()

How to use shiny with check boxes from an excel file

I am trying to make a shiny app that all it does is display different line plots based on which check boxes are selected.
My data is housed in an excel file and it has 5 tabs, each of which I would like to have a plot and a corresponding check box. I have included a picture of the data
I found the code below that creates checkboxes, but it also has a slider bar that I don't need (if I could use it, I would have it set the range of years to show in the plot)
Thanks for the help
library(ggplot2)
library(tidyverse)
df <- iris[, colnames(iris) != "Species"]
ui <- fluidPage(
titlePanel("Density Plots of Quantitative Variables"),
sidebarLayout(
sidebarPanel(
sliderInput("bw", "Slide to change bandwidth of Plot",
min = 0.1,
max = 20,
value = 3,
step = 0.1,
animate = TRUE
),
checkboxGroupInput("variableinp", "Choose variables",
choices = colnames(df), selected = colnames(df)[1]
), verbatimTextOutput("value")
),
mainPanel(plotOutput("densityplot"))
)
)
server <- function(input, output) {
# observeEvent(input$variableinp, {
# print((input$variableinp))
# })
output$densityplot <- renderPlot({
if (!is.null(input$variableinp)) {
getoutandquant <- function(x) {
q1 <- quantile(x)[[2]]
q3 <- quantile(x)[[4]]
IQR <- q3 - q1
out1 <- q3 + (1.5) * IQR
out2 <- q1 - (1.5) * IQR
# Finding the list of points which are outliers for a particular variable.
out <- x[x > out1]
out2 <- x[x < out2]
outliers <- tibble(x = c(out, out2), y = 0)
return(outliers)
}
nplot <- length(input$variableinp)
x <- input$variableinp
for (i in 1:nplot) {
outlier <- getoutandquant(df[, x[i]])
}
p1 <- ggplot(df, aes_string(input$variableinp[i])) +
stat_density(geom = "line", adjust = input$bw) +
ylab("Density\n")
p1 + geom_point(data = outlier, aes(x, y), shape = 23)
}
})
}
shinyApp(ui = ui, server = server)
We can keep everything in one single plot by pivoting the data and modifying getoutandquant function with an additional argument. The purpose of this is to be able to use color argument to differentiate each column.
df <- iris[, colnames(iris) != "Species"]
#pivot data to long format
df_long <- df %>%
pivot_longer(everything())
#add an additional argument
getoutandquant <- function(x, group_name) {
q1 <- quantile(x)[[2]]
q3 <- quantile(x)[[4]]
IQR <- q3 - q1
out1 <- q3 + (1.5) * IQR
out2 <- q1 - (1.5) * IQR
# Finding the list of points which are outliers for a particular variable.
out <- x[x > out1]
out2 <- x[x < out2]
outliers <- tibble(x = c(out, out2), y = 0, group_name)
return(outliers)
}
Finally we change the server to plot one or more columns depending the number of checkboxes selected.
server <- function(input, output) {
outliers <- reactive({
#call getoutandquant function with each of the selected cols
map_dfr(input$variableinp, ~ getoutandquant(df[, ..1], group_name = .x))
})
df_long_filt <- reactive({
filter(df_long, name %in% input$variableinp)
})
output$densityplot <- renderPlot({
req(input$variableinp)
ggplot(df_long_filt()) +
stat_density(aes(x = value, color = name),
geom = "line",
adjust = input$bw
) +
labs(y = "Density\n", color = "Column") +
#we change the dataset to plot the outliers
geom_point(
data = outliers(), aes(x = x, y = y, color = group_name),
shape = 23,
size = 5
)
})
}
The ui will remain the same.
Full app:
library(shiny)
library(tidyverse)
df <- iris[, colnames(iris) != "Species"]
#pivot data to long format
df_long <- df %>%
pivot_longer(everything())
#add an additional argument
getoutandquant <- function(x, group_name) {
q1 <- quantile(x)[[2]]
q3 <- quantile(x)[[4]]
IQR <- q3 - q1
out1 <- q3 + (1.5) * IQR
out2 <- q1 - (1.5) * IQR
# Finding the list of points which are outliers for a particular variable.
out <- x[x > out1]
out2 <- x[x < out2]
outliers <- tibble(x = c(out, out2), y = 0, group_name)
return(outliers)
}
ui <- fluidPage(
titlePanel("Density Plots of Quantitative Variables"),
sidebarLayout(
sidebarPanel(
sliderInput("bw", "Slide to change bandwidth of Plot",
min = 0.1,
max = 20,
value = 3,
step = 0.1,
animate = TRUE
),
checkboxGroupInput("variableinp", "Choose variables",
choices = colnames(df), selected = colnames(df)[1]
), verbatimTextOutput("value")
),
mainPanel(plotOutput("densityplot"))
)
)
server <- function(input, output) {
outliers <- reactive({
#call getoutandquant function with each of the selected cols
map_dfr(input$variableinp, ~ getoutandquant(df[, ..1], group_name = .x))
})
df_long_filt <- reactive({
filter(df_long, name %in% input$variableinp)
})
output$densityplot <- renderPlot({
req(input$variableinp)
ggplot(df_long_filt()) +
stat_density(aes(x = value, color = name),
geom = "line",
adjust = input$bw
) +
labs(y = "Density\n", color = "Column") +
#we change the dataset to plot the outliers
geom_point(
data = outliers(), aes(x = x, y = y, color = group_name),
shape = 23,
size = 5
)
})
}
shinyApp(ui = ui, server = server)

plotting 3D playes in R, anyone can look through the code

I hope anyone can help me :)
Write this code including shiny, but at the end it doesnt work the way I want it to.
If anyone can look through that code an tell me why the plot isnt working ?
You will see that there is an error at the end.
Ok first why istn the rgl window implemented into the GUI ?
Second how can I plot the 3D in bigger cube ?
If I dont open a 3D plot wihtout data it doesnt plot it at all :(
library(shiny)
library(rgl)
library(shinythemes)
library(devtools)
#install_github("rgl", "trestletech", "js-class")
#install_github("rgl", "trestletech", "js-class")
#######################################################################################
# User Interface #
#######################################################################################
ui <- fluidPage(theme = shinytheme("slate"),
#shinythemes::themeSelector(), # <--- Add this somewhere in the UI
headerPanel("Block Theory 0.1"),
sidebarPanel(
numericInput(inputId = "dd", label = "Dip direction:", value = "", width = "80%", min = 0, max = 360),
numericInput(inputId = "fa", label = "Fracture angle:", value = "", width = "80%", min = 0, max = 90),
numericInput(inputId = "position_x", label = "Position:", value = "", width = "40%"),
numericInput(inputId = "position_y", label = "", value = "", width = "40%"),
selectInput("form", "Form:",
c("Circle", "Square", "Ellipsoid")),
actionButton(inputId = "add", label = "Add a plane"),
actionButton(inputId = "plotbutton", label = "Update")
),
mainPanel(
plotOutput(outputId = "plot")
),
verbatimTextOutput(outputId = "log_planes")
)
#######################################################################################
# SERVER #
#######################################################################################
server <- function(input, output) {
data_planes <- data.frame()
makeReactiveBinding("data_planes")
observe({
input$add
isolate({
data_planes <<- rbind(data_planes, data.frame(input$dd, input$fa , input$position_x , input$position_y))
data_planes <<- na.omit(data_planes)
})
})
output$plot <- renderRglwidget({
# try(rgl.close())
input$plotbutton
isolate({
#######################################################################################
# Open 3d plot:
x<-sample(1:100, 100)
y<-sample(1:100, 100)
z<-sample(1:100, 100)
plot3d(x, y, z, type = "n",xlim = c(-10, 10), ylim = c(-10, 10), zlim = c(-30, 30))
#######################################################################################
while (i <= nrow(data_planes)) {
phi <- data_planes[i,1] * pi / 180
deta <- data_planes[i,2] * pi / 180
Px <- data_planes[i,3]
Py <- data_planes[i,4]
Pz <- 0
n <- c(-sin(deta)*sin(phi), sin(deta) * cos(phi), -cos(deta))
T <- matrix(c(cos(deta)*cos(phi), sin(deta), cos(deta)*sin(phi), -sin(deta)*cos(phi), cos(deta), -sin(deta)*sin(phi), -sin(phi), 0 , cos(phi)), nrow=3,ncol = 3, byrow = TRUE)
P_new <- T %*% c(Px,Py,Pz)
P_n <- -P_new %*% n # d = -P * n
# planes3d() plots equation: a*x + b*y + c*z + d = 0
a <- -sin(deta)*sin(phi)
b <- sin(deta) * cos(phi)
c <- -cos(deta)
d <- P_n
cols<-rgb(runif(5),runif(5),runif(5)) #random color genarator
planes3d(a, b, c , d , col = cols, alpha = 1.0)
i <- i + 1
}
})
})
output$log_planes <- renderPrint({na.omit(data_planes)})
}
#######################################################################################
shinyApp(ui = ui, server = server)
There are few mistakes in your app:
Firstly, in your ui instead of plotOutput(outputId = "plot") it should be rglwidgetOutput(outputId = "plot").
Secondly, you wont be able to plot in a loop and also you need to give rglwidget(). Just for demonstration purpose I have altered your server code by removing the loop. Have a look:
server <- function(input, output) {
data_planes <- data.frame()
makeReactiveBinding("data_planes")
observe({
input$add
isolate({
data_planes <<- rbind(data_planes, data.frame(input$dd, input$fa , input$position_x , input$position_y))
data_planes <<- na.omit(data_planes)
})
})
output$plot <- renderRglwidget({
# try(rgl.close())
input$plotbutton
# isolate({
#######################################################################################
# Open 3d plot:
x<-sample(1:100, 100)
y<-sample(1:100, 100)
z<-sample(1:100, 100)
plot3d(x, y, z, type = "n",xlim = c(-10, 10), ylim = c(-10, 10), zlim = c(-30, 30))
#######################################################################################
i=1;
# while (i <= nrow(data_planes)) {
phi <- data_planes[i,1] * pi / 180
deta <- data_planes[i,2] * pi / 180
Px <- data_planes[i,3]
Py <- data_planes[i,4]
Pz <- 0
n <- c(-sin(deta)*sin(phi), sin(deta) * cos(phi), -cos(deta))
T <- matrix(c(cos(deta)*cos(phi), sin(deta), cos(deta)*sin(phi), -sin(deta)*cos(phi), cos(deta), -sin(deta)*sin(phi), -sin(phi), 0 , cos(phi)), nrow=3,ncol = 3, byrow = TRUE)
P_new <- T %*% c(Px,Py,Pz)
P_n <- -P_new %*% n # d = -P * n
# planes3d() plots equation: a*x + b*y + c*z + d = 0
a <- -sin(deta)*sin(phi)
b <- sin(deta) * cos(phi)
c <- -cos(deta)
d <- P_n
cols<-rgb(runif(5),runif(5),runif(5)) #random color genarator
i <- i + 1
# }
planes3d(a, b, c , d , col = cols, alpha = 1.0)
rglwidget()
# })
})
output$log_planes <- renderPrint({na.omit(data_planes)})
}
The output you see from this code is:
EDIT:
To plot more than 1 plot at a time and adjust the x, y and z limits you can use this server code:
server <- function(input, output) {
data_planes <- data.frame()
makeReactiveBinding("data_planes")
observe({
input$add
isolate({
data_planes <<- rbind(data_planes, data.frame(input$dd, input$fa , input$position_x , input$position_y))
data_planes <<- na.omit(data_planes)
})
})
output$plot <- renderRglwidget({
# try(rgl.close())
input$plotbutton
# isolate({
#######################################################################################
# Open 3d plot:
x<-sample(1:100, 100)
y<-sample(1:100, 100)
z<-sample(1:100, 100)
plot3d(x, y, z, type = "n",xlim = c(min(x), max(x)), ylim = c(min(y), max(y)), zlim = c(min(z), max(z)))
####################################################
i=1;
while (i <= nrow(data_planes)) {
phi <- data_planes[i,1] * pi / 180
deta <- data_planes[i,2] * pi / 180
Px <- data_planes[i,3]
Py <- data_planes[i,4]
Pz <- 0
n <- c(-sin(deta)*sin(phi), sin(deta) * cos(phi), -cos(deta))
T <- matrix(c(cos(deta)*cos(phi), sin(deta), cos(deta)*sin(phi), -sin(deta)*cos(phi), cos(deta), -sin(deta)*sin(phi), -sin(phi), 0 , cos(phi)), nrow=3,ncol = 3, byrow = TRUE)
P_new <- T %*% c(Px,Py,Pz)
P_n <- -P_new %*% n # d = -P * n
# planes3d() plots equation: a*x + b*y + c*z + d = 0
a <- -sin(deta)*sin(phi)
b <- sin(deta) * cos(phi)
c <- -cos(deta)
d <- P_n
cols<-rgb(runif(5),runif(5),runif(5)) #random color genarator
i <- i + 1
planes3d(a, b, c , d , col = cols, alpha = 1.0)
}
rglwidget()
# })
})
output$log_planes <- renderPrint({na.omit(data_planes)})
}

Calling additional functions in Shiny

I developed a simple shiny app that take as inputs a score my_x on a distribution with mean my_mean and standard deviation my_sd. As output, the app return a Lattice plot with a Normal Standard distribution with the corresponding z-score of my_x. Please find the code for the app on GitHub.
Now, I would like to add a second functionality to the app:
By checking a checkboxInput I would calculate, for example, the pnorm of the inputs and shade the relative area of the graph.
I wrote the code for the graph (here an example of the expected result), but I cannot figure out how to make it work in Shiny. In particular, I cannot figure how to make the function activated with the checkbox working properly with the first function drawing the graph.
library(lattice)
e4a <- seq(60, 170, length = 10000)
e4b <- dnorm(e4a, 110, 15)
#z-score is calculated with the inputs listed above:
z_score <- (my_x - my_mean)/my_sd
plot_e4d <- xyplot(e4b ~ e4a,
type = "l",
main = "Plot 4",
scales = list(x = list(at = seq(60, 170, 10)), rot = 45),
panel = function(x,y, ...){
panel.xyplot(x,y, ...)
panel.abline(v = c(z_score, 110), lty = 2)
xx <- c(60, x[x>=60 & x<=z_score], z_score)
yy <- c(0, y[x>=60 & x<=z_score], 0)
panel.polygon(xx,yy, ..., col='red')
})
print(plot_e4d)
I found a functioning solution. I am pretty sure that it is not the most efficient, but it works. It consists of an if/else statement within the server function calling the plot. I would like to thank #zx8754 for the inspiration.
Here is the ui.r file:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Standard Normal"),
sidebarPanel(
numericInput('mean', 'Your mean', 0),
numericInput('sd', 'Your standard deviation', 0),
numericInput('x', 'Your score', 0),
checkboxInput('p1', label = 'Probability of getting a score smaller than x or z', value = FALSE)
),
mainPanel(
h3('Standard Normal'),
plotOutput('sdNorm'),
h4('Your z-score is:'),
verbatimTextOutput('z'),
h4('Your lower tail probability is:'),
verbatimTextOutput('p1')
))
)
And the server.R file:
library(lattice)
shinyServer(
function(input, output){
output$sdNorm <- renderPlot({
dt1 <- seq(-3, 3, length = 1000)
dt2 <- dnorm(dt1, 0, 1)
my_mean <- input$mean
my_sd <- input$sd
my_x <- input$x
z <- (my_x - my_mean)/my_sd
if(input$p1){
xyplot(dt2 ~ dt1,
type = "l",
main = "Lower tail probability",
panel = function(x,y, ...){
panel.xyplot(x,y, ...)
panel.abline(v = c(z, 0), lty = 2)
xx <- c(-3, x[x>=-3 & x<=z], z)
yy <- c(0, y[x>=-3 & x<=z], 0)
panel.polygon(xx,yy, ..., col='red')
})
}else{
xyplot(dt2 ~ dt1,
type = "l",
main = "Standard Normal Distribution",
panel = function(x, ...){
panel.xyplot(x, ...)
panel.abline(v = c(z, 0), lty = 2)
})
}
})
output$z = renderPrint({
my_mean <- input$mean
my_sd <- input$sd
my_x <- input$x
z <- (my_x - my_mean)/my_sd
z
})
output$p1 <- renderPrint({
if(input$p1){
my_mean <- input$mean
my_sd <- input$sd
my_x <- input$x
p1 <- 1- pnorm(my_x, my_mean, my_sd)
p1
} else {
p1 <- NULL
}
})
}
)
This should work:
library(shiny)
library(lattice)
shinyApp(
ui = {
pageWithSidebar(
headerPanel("Standard Normal"),
sidebarPanel(
numericInput('mean', 'Your mean', 80),
numericInput('sd', 'Your standard deviation', 2),
numericInput('x', 'Your score', 250),
checkboxInput("zScoreArea", label = "Area under z-score", value = TRUE)
),
mainPanel(
h3('Standard Normal'),
plotOutput('sdNorm'),
h4('Your z-score is:'),
verbatimTextOutput('z_score')
))
},
server = {
function(input, output){
#data
dt1 <- seq(60, 170, length = 10000)
dt2 <- dnorm(dt1, 110, 15)
#xyplot panel= function()
myfunc <- reactive({
if(input$zScoreArea){
function(x,y, ...){
panel.xyplot(x,y, ...)
panel.abline( v = c(z_score(), 110), lty = 2)
xx <- c(60, x[x >= 60 & x <= z_score()], z_score())
yy <- c(0, y[x >= 60 & x <= z_score()], 0)
panel.polygon(xx,yy, ..., col='red')
}
}else{
function(x, ...){
panel.xyplot(x, ...)
panel.abline(v = c(z_score(), 110), lty = 2)}
}
})
#reactive z_score for plotting
z_score <- reactive({
my_mean <- input$mean
my_sd <- input$sd
my_x <- input$x
#return z score
(my_x - my_mean)/my_sd
})
output$sdNorm <- renderPlot({
xyplot(dt2 ~ dt1,
type = "l",
main = "Plot 4",
scales = list(x = list(at = seq(60, 170, 10)), rot = 45),
panel = myfunc()
)
})
output$z_score = renderPrint({ z_score() })
}
}
)

R Shiny. "Error: no applicable method for 'xtable' applied to an object of class "c('double', 'numeric')"

I am trying to create an interactive data set and I need to subset it for calculations. When I try to extract certain rows and columns I get this error message about xtable being applied object of class "C('double','numeric')". Here is my code.
ui.r
library(shiny)
require(ggplot2)
shinyUI(fluidPage(
titlePanel("Vasicek Model Example"),
sidebarLayout(
sidebarPanel(
numericInput("sim", "Simulations", value = 100),
numericInput("loans", "Loans", value = 10),
numericInput("M", "Systemic Risk Factor", value = 0),
numericInput("rho", "Firm Correlation", value = 0),
sliderInput("bins", "Number of Bins:", min = 1, max = 50, value = 30),
submitButton("Submit")
),
mainPanel(
tabsetPanel(
tabPanel("Debug", tableOutput("probs"), tableOutput("dftable")),
tabPanel(plotOutput("distPlot"), tableOutput("sumtable"),
tableOutput("tabs"))
)
)
)))
server.r
library(shiny)
require(ggplot2)
shinyServer(function(input,output){
TMo <- reactive({
matrix(c(.90, .05, .04, .01,
.05, .80, .10, .05,
.05, .25, .60, .10,
.00, .00, .00, 1.0), nrow=4, ncol=4, byrow=T)
})
Pprob <- reactive({
TMo()[1:3, 4]
})
output$probs <- renderTable({
Pprob()
})
plotdata <- reactive({
R <- vector()
c <- vector()
DefRate <- vector()
groups <- vector()
ctr <- 0
for(group in 1:3){
c[group] <- qnorm(Pprob()[group])
for(i in 1:input$sim){
e <- matrix(data = rnorm(n = input$loans, mean = 0, sd = 1))
ctr <- ctr + 1
default <- 0
for(j in 1:input$loans){
R[j] <- sqrt(input$rho) * M + sqrt(1 - input$rho) * e[j]
if(R[j] <= c[group]){
default + 1
}
if(j == input$loans){
DefRate[ctr] <- default/input$loans
if(group == 1){
groups[ctr] = 'A'
}
else if(group == 2){
groups[ctr] = 'B'
}
else{
groups[ctr] = 'C'
}
}
if(group == 3 & i == input$sims & j == input$loans){
DefData <- cbind(DefRate,groups)
as.data.frame(DefData)
}
}
}
}
})
output$dftable <- renderTable({
head(plotdata())
})
#output$distPlot <- renderPlot({
#bins <- seq(min(x), max(x), length.out = input$bins + 1)
#DR_plots <- ggplot(DData, aes(x=DData$Default_Rate, fill=DData$Credit_Rating))
#DR_Hist_options <- geom_histogram(binwidth = .01, alpha=.5, position = "identity")
#DR_Hist <- DR_plots + DR_Hist_options
#DR_Hist
#hist(x, breaks = bins, col = 'darkgray', border = 'white',
#main = "Default Rate Distribution", xlab = "Default Rates",
#ylab = "Frequency")
#})
#output$tabs <- renderTable({
#x <- DR_Data
#head(x)
#})
})
excuse the commented out sections. I'm was debugging to try to figure out the source of the problem. Thank you for the help.

Resources