Hi Rstudio community,
I am stuck on a problem for a while. I try to do a more complex app and I continually get the message:
Reading from shinyoutput object is not allowed.
Any tip to unlock the issue would be welcome
I structured my App in 4 R files:
ui.R
server.R
function.R (helper functions)
data.R
UI BLOCK reprex()
library(ggplot2)
library(plotly)
#> Warning: le package 'plotly' a été compilé avec la version R 3.6.2
#>
#> Attachement du package : 'plotly'
#> The following object is masked from 'package:ggplot2':
#>
#> last_plot
#> The following object is masked from 'package:stats':
#>
#> filter
#> The following object is masked from 'package:graphics':
#>
#> layout
library(shinyjs)
#> Warning: le package 'shinyjs' a été compilé avec la version R 3.6.3
#>
#> Attachement du package : 'shinyjs'
#> The following objects are masked from 'package:methods':
#>
#> removeClass, show
library(tibble)
library(knitr)
library(kableExtra)
#> Warning: le package 'kableExtra' a été compilé avec la version R 3.6.2
library(leaflet)
#> Warning: le package 'leaflet' a été compilé avec la version R 3.6.2
library(ggpubr)
#> Le chargement a nécessité le package : magrittr
library(measurements)
library(Hmisc)
#> Warning: le package 'Hmisc' a été compilé avec la version R 3.6.2
#> Le chargement a nécessité le package : lattice
#> Le chargement a nécessité le package : survival
#> Warning: le package 'survival' a été compilé avec la version R 3.6.2
#> Le chargement a nécessité le package : Formula
#>
#> Attachement du package : 'Hmisc'
#> The following object is masked from 'package:shinyjs':
#>
#> html
#> The following object is masked from 'package:plotly':
#>
#> subplot
#> The following objects are masked from 'package:base':
#>
#> format.pval, units
library(PerformanceAnalytics)
#> Warning: le package 'PerformanceAnalytics' a été compilé avec la version R 3.6.2
#> Le chargement a nécessité le package : xts
#> Warning: le package 'xts' a été compilé avec la version R 3.6.2
#> Le chargement a nécessité le package : zoo
#> Warning: le package 'zoo' a été compilé avec la version R 4.0.0
#>
#> Attachement du package : 'zoo'
#> The following objects are masked from 'package:base':
#>
#> as.Date, as.Date.numeric
#>
#> Attachement du package : 'xts'
#> The following object is masked from 'package:leaflet':
#>
#> addLegend
#>
#> Attachement du package : 'PerformanceAnalytics'
#> The following object is masked from 'package:graphics':
#>
#> legend
library(shinydashboard)
#> Warning: le package 'shinydashboard' a été compilé avec la version R 3.6.2
#>
#> Attachement du package : 'shinydashboard'
#> The following object is masked from 'package:graphics':
#>
#> box
library(shiny)
#> Warning: le package 'shiny' a été compilé avec la version R 4.0.0
#>
#> Attachement du package : 'shiny'
#> The following object is masked from 'package:shinyjs':
#>
#> runExample
library(readxl)
library(tidyverse)
#> Warning: le package 'dplyr' a été compilé avec la version R 3.6.2
library(maps)
#>
#> Attachement du package : 'maps'
#> The following object is masked from 'package:purrr':
#>
#> map
library(rintrojs)
#> Warning: le package 'rintrojs' a été compilé avec la version R 3.6.3
ui <- dashboardPage(skin="blue",title="Obesity",
# HEADER ------------------------------------------------------------------
dashboardHeader(
title=img(src="analysis.svg", height = 50, align = "center")
),
# SIDEBAR -----------------------------------------------------------------
dashboardSidebar(
sidebarMenu(id="tab",
menuItem("Introduction",tabName = "raw",icon=icon("database")),
menuSubItem(tabName="sub_item_1",selectInput("gender", "Gender",
c("All", "female", "male"))),
menuSubItem(tabName="sub_item_2",selectInput("obesity", "Obesity status",
c("All","Underweight", "Normal","Overweight","obese"))),
menuSubItem(tabName="sub_item_3",selectInput("diabetic", "Diabetic status",
c("All", "normal", "prediabetes","diabetes","extremely obese")))
)),
# BODY -----------------------------------------------------------------
dashboardBody(
tabItems(
tabItem(tabName = "raw",
fluidRow(
column(
width=6,
leafletOutput("mymap")),
column(
width=6,
dataTableOutput("drjohnschorling_dt")
)),
fluidRow(tags$h4("Parameters"),
column(
width = 6,
sliderInput("slider_sample_size", "Sample size",
min = 0, max = 403, value = 80, step = 1
),
sliderInput("slider_age", "Age",
min = 18, max = 100, value = c(0,10), step = 1
),
sliderInput("slider_BMI", "BMI",
min = 15, max = 60, value = c(15,60), step = 1
),
sliderInput("slider_hba1c", "HbA1c level",
min = 2.5, max = 16.5 , value = c(2.68,16.11), step = 0.5
),
sliderInput("slider_stabilizedglucose", "Stabilized glucose",
min = 48, max = 386, value = c(48,386), step = 5
)),
column(
width = 6,
sliderInput("slider_cholesterol", "Cholesterol level",
min = 78, max = 445, value = c(78,445), step = 10
),
sliderInput("slider_HDL", "HDL level",
min = 12, max = 120, value = c(12,120), step = 5
)
,sliderInput("slider_BPS", "Blood pressure systolic (1st measure)",
min = 90, max = 250, value = c(90,250), step = 10
),
sliderInput("slider_BPD", "Blood pressure diastolic (1st measure)",
min = 48, max = 124, value = c(48,124), step = 10
)
)
)
)
)
)
)
SERVER BLOCK reprex()
server <- function(input, output) {
####--SERVER BLOCK-----------------------------------------------------------------------------------------
# Server modules
source('function.R', local = TRUE)
source('data.R', local = TRUE)
--### SERVER ###--
#--BLOCK PANEL DATA INTRODUCTION--------------------------------------------------------------------------------------
# Display the dataset table (filtered or no)
output$drjohnschorling_dt<-renderDataTable({
my_data<-my_data_filtered() #function coming from DATA BLOCK
dataTable(my_data)
})
#Display the map of patients
output$mymap<-renderLeaflet({
map<-readRDS("gadm36_USA_2_sp.rds")
map %>%
filter(NAME_1=="Virginia")->virginia
county1<-virginia[virginia$NAME_2=="Buckingham",]
county2<-virginia[virginia$NAME_2=="Louisa",]
county<-rbind(county1,county2)
sum1<-sum(my_data$location=="Louisa")
sum2<-sum(my_data$location=="Buckingham")
content1<-paste(sep="<br/>",
"<b><a href='https://www.google.com/search?sxsrf=ALeKk00Z8pT3cLC0yuQKhGn98p9YupIIhw%3A1582717831754&ei=h1tWXvDALYHAa6fUnfAP&q=hree+Rivers+Medical+Center&oq=hree+Rivers+Medical+Center&gs_l=psy-ab.3..0i13l10.1563.1563..1829...0.1..0.79.79.1......0....1..gws-wiz.......0i71.rXosrOCu6hA&ved=0ahUKEwiwoJCxk-_nAhUB4BoKHSdqB_4Q4dUDCAs&uact=5'>Louisa Hospital</a></b>","203 patients screened for diabetes","and included in the study")
content2<-paste(sep="<br/>",
"<b><a href='https://www.google.com/maps/search/hospital/@26.6607163,-81.8055767,12z/data=!3m1!4b1'>Buckingham Hospitals</a></b>","200 patients screened for diabetes","and included in the study")
leaflet(county) %>%
addTiles() %>%
addPolygons() %>%
addPopups(lng=c(-78.003433,-78.524219),lat=c(38.025070,37.593907),popup = c(content1,content2))
})
}
DATA BLOCK reprex()
###Function to filter data with the inputs widgets
my_data_filtered<-reactive({
my_data<-read_my_data() #FUNCTION COMING FROM FUNCTION BLOCK
#We temp variables for input values
samplesize<-input$slider_sample_size
minage<-input$slider_age[1]
maxage<-input$slider_age[2]
minBMI<-input$slider_BMI[1]
maxBMI<-input$slider_BMI[2]
minHbA1c<-input$slider_hba1c[1]
maxHbA1c<-input$slider_hba1c[2]
minstabilizedglucose<-input$slider_stabilizedglucose[1]
maxstabilizedglucose<-input$slider_stabilizedglucose[2]
mincholesterol<-input$slider_cholesterol[1]
maxcholesterol<-input$slider_cholesterol[2]
minHDL<-input$slider_HDL[1]
maxHDL<-input$slider_HDL[2]
minbloodpressuresystolic<-input$slider_BPS[1]
maxbloodpressuresystolic<-input$slider_BPS[2]
minbloodpressurediastolic<-input$slider_BPD[1]
maxbloodpressurediastolic<-input$slider_BPD[2]
#Apply filters sample size, BMI,Cholesterol,HbA1c,stabilized glucose,age,blood pressure systolic, blood pressure diastolic
my_data<- my_data %>%
filter(
n<=samplesize,
age>=minage,
age<=maxage,
BMI>=minBMI,
BMI<=maxBMI,
glyhb>=minHbA1c,
glyhb<=maxHbA1c,
stab.glu>=minstabilizedglucose,
stab.glu<=maxstabilizedglucose,
chol>=mincholesterol,
chol<=maxcholesterol,
hdl>=minHDL,
hdl<=maxHDL,
bp.1s>=minbloodpressuresystolic,
bp.1s<=maxbloodpressuresystolic,
bp.1d>=minbloodpressurediastolic,
bp.1d<=maxbloodpressurediastolic
)
#filter by gender
if (input$gender != "All") {
my_gender <- paste0("%", input$gender, "%")
my_data <- my_data %>% filter(gender %like% my_gender)
}
#filter by obesity status
if (input$obesity != "All") {
obesity <- paste0("%", input$obesity, "%")
my_data <- my_data %>% filter(obcat %like% obesity)
}
#filter by diabetic status
if (input$diabetic != "All") {
diabetic <- paste0("%", input$diabetic, "%")
my_data <- my_data %>% filter(glyhbcat %like% diabetic)
}
# Rename variables and remove column "frame"
my_data<-rename(my_data,'Obesity status'=obcat, 'Diabetic status'=glyhbcat,'Subject id'=id,'Cholesterol'=chol,'Stabilized Glucose'=stab.glu,'HDL'=hdl,'Cholesterol/HDL Ratio'=ratio,HbA1c=glyhb,Location=location,Age=age,Gender=gender,'Height (inches)'=height,'Weight (pounds)'=weight,frame=frame,'First Systolic Blood Pressure'=bp.1s,'First Diastolic Blood Pressure'=bp.1d,'Second Systolic Blood Pressure'=bp.2s,'Second Diastolic Blood Pressure'=bp.2d,'Waist (inches)'=waist,'Hip (inches)'=hip,'Postprandial time (minutes)'=time.ppn)
df<-select(my_data,-frame,-'Subject id')
df<-select(df,n,Gender, Age,Location,BMI,'Obesity status','Diabetic status',HbA1c,everything())
df
})
#> Error in reactive({: can't find the "reactive" function
FUNCTION BLOCK reprex()
Functions for connecting, loading, saving data
read_my_data<-function(){
#load data from Dr John Schorling
my_data<-read.csv("C:/Users/fxcha/OneDrive/Documents/R/Exercices/Shiny apps/App-Diabetes/diabetes.csv")
#load data on variables
my_variables<-read_excel("C:/Users/fxcha/OneDrive/Documents/R/Exercices/Shiny apps/App-Diabetes/variables.xlsx",range="B1:C20")
#Compute the BMI and add a column for BMI
my_data<-my_data%>%
mutate(BMI=round(703*(weight/height^2),1))
# Add a column with numeric values to filter the number of patient
my_data<-my_data %>% mutate(n=1:403) %>% select(n,everything())
#Add columns obesity and diabetes categories
my_data<-my_data%>% mutate(obcat=case_when(
BMI < 18.5~"Underweight",
BMI>=18.5 & BMI<25~"Normal",
BMI>=25 & BMI<30~"Overweight",
BMI>=30 & BMI<40~"obese",
BMI>40~"extremely obese",
)) %>%
mutate(glyhbcat=case_when(
glyhb<5.7~"normal",
glyhb>=5.7 & glyhb<6.5~"prediabetes",
glyhb>=6.5~"diabetes"
))
my_data<-as.data.frame(my_data)
return(my_data)
}