My form automatically updates the output before I press the Submit button. I read the description of "Submit" button and it says "Forms that include a submit button do not automatically update their outputs when inputs change, rather they wait until the user explicitly clicks the submit button". I am not sure if there's anything wrong.
For your information, here is my code. Data is from UCI (adult data)
Server.R
library(shiny)
library(caret)
predictSalary <- function(input){
adultData <- read.table("adult.data", header = FALSE, sep = ",", strip.white = TRUE)
adultName <- read.csv("adult.name.csv", header = FALSE, sep = ",", stringsAsFactors = FALSE)
names(adultData) <- adultName[, 1]
#Only select several attributes
selected <- c("age", "education", "marital.status", "relationship", "sex", "hours.per.week", "salary")
#selected <- c("age", "hours.per.week", "salary")
adultData <- subset(adultData, select = selected)
#The data is big, we only take 20% for the training
trainIndex = createDataPartition(adultData$salary, p=0.20, list=FALSE)
training = adultData[ trainIndex, ]
set.seed(33833)
modFit <- train(salary ~ ., method = "rpart", data=training)
predict(modFit, newdata = input)
}
shinyServer(
function(input, output) {
dataInput <- reactive({
age <- input$age
edu <- as.factor(input$edu)
marritalstat <- input$marritalstat
relationship <- input$relationship
sex <- input$sex
hours <- input$hours
data.frame(age = age,
education = edu,
marital.status = marritalstat,
relationship = relationship,
sex = sex,
hours.per.week = hours)
# age <- input$age
# hours <- input$hours
# data.frame(age = age, hours.per.week = hours)
})
# dat <- c(input$age, input$edu, input$marritalstat,
# input$relationship, input$sex, input$hours)
output$prediction <- renderPrint({predictSalary(dataInput())})
}
)
Ui.R
library(shiny)
shinyUI(
pageWithSidebar(
# Application title
headerPanel("Salary prediction"),
sidebarPanel(
numericInput('age', 'Age', 40, min = 17, max = 90, step = 1),
selectInput('edu', 'Education',
c("Bachelors"="Bachelors",
"Some-college"="Some-college",
"11th"="11th",
"HS-grad"="HS-grad",
"Prof-school"="Prof-school",
"Assoc-acdm"="Assoc-acdm",
"Assoc-voc"="Assoc-voc",
"9th"="9th",
"7th-8th"="7th-8th",
"12th"="12th",
"Masters"="Masters",
"1st-4th"="1st-4th",
"10th"="10th",
"Doctorate"="Doctorate",
"5th-6th"="5th-6th",
"Preschool"="Preschool")),
radioButtons('marritalstat', 'Marrital Status',
c("Married-civ-spouse" = "Married-civ-spouse",
"Divorced" = "Divorced",
"Never-married" = "Never-married",
"Separated" = "Separated",
"Widowed" = "Widowed",
"Married-spouse-absent" = "Married-spouse-absent",
"Married-AF-spouse" = "Married-AF-spouse")),
radioButtons('relationship', 'Relationship',
c("Wife" = "Wife",
"Own-child" = "Own-child",
"Husband" = "Husband",
"Not-in-family" = "Not-in-family",
"Other-relative" = "Other-relative",
"Unmarried" = "Unmarried")),
radioButtons('sex', 'Sex', c("Male", "Female")),
numericInput('hours', 'Hours per week', 40, min = 1, max = 99, step = 1),
submitButton('Submit')
),
mainPanel(
h3('Results of prediction'),
h4('The predicted salary is '),
verbatimTextOutput("prediction"),
h3('Prediction of salary'),
p('The application is designed to predict whether somebodys salary is greater or smaller than 50k.
The data is extracted from the adult data, provided by UCI database. In order to predict a salary, users need to
provide information of the person whom they would like to make prediction on. After filling in necessary information,
users will press "Submit". The information includes:'),
p(' - Age: must be from 17 to 90'),
p(' - Education'),
p(' - Marital status'),
p(' - Relationship'),
p(' - Gender'),
p(' - Total work hours per week: must be from 1 to 99')
)
)
)
I found the solution by using actionButton in replacement of submitButton. However, I think that there must be an ideal solution with using submitButton.
Related
I tried to achieve when with a chosen split percentage, it returns the train set and then with a sampling method to resample train set and calculate its class freq and perc.
The error I got: object 'split.df' not found when I choose check box 'over'.
Should I use eventReactive or other syntax to achieve? The final return the table with either freq or perc should be dependent on 'split', 'sample' and dropdown 'freq' or 'perc'.
Here is portion that relates in ui:
sidebarLayout(
sidebarPanel(
h3("Train/test set"),
tags$br(),
selectInput(
"trainset",
"Select train component",
choices = list('freq'='freq', 'percentage'='perc'),
),
sliderInput(
"split",
label = "split percentage",
min = 0,
max = 1,
value = 0,
step = 0.1
),
h3("resampling train set"),
checkboxGroupInput('sample', label = "sampling method",
choices = list('original'='original','over'='over', 'under'='under', 'both'='both','ROSE'='ROSE'),
selected = list('original'='original'))
),
Here is a code relates for server:
split.df <- reactive({
index <- createDataPartition(df$class, p=input$split, list=FALSE)
Training_Data <- df[index,]
return(Training_Data)
})
train_set <- reactive({
if(input$sample == 'original')
Training_Data_class <- data.frame(class = split.df()$class)
return(Training_Data_class)
})
over_train_set <- reactive({
split.df <- split.df()
if(input$sample == 'over'){
over <- ovun.sample(class~., data = split.df, method = 'over')$data
Training_Data_class_over <- data.frame(class = over$class)
return(Training_Data_class_over)}
})
trainset_df <- reactive({
freq.df.train <- data.frame(table(train_set()))
colnames(freq.df.train) <- c('class', 'freq')
perc.df.train.=data.frame(prop.table(table(train_set()))*100)
colnames(perc.df.train) <- c('class','perc')
if(input$trainset == 'freq')
return(freq.df.train)
if(input$trainset == 'perc')
return(perc.df.train)
})
over_trainset_df <- reactive({
freq.df.train.over <- data.frame(table(over_train_set()))
colnames(freq.df.train.over) <- c('class', 'freq')
perc.df.train.over=data.frame(prop.table(table(over_train_set()))*100)
colnames(perc.df.train.over) <- c('class','perc')
if(input$trainset == 'freq')
return(freq.df.train.over)
if(input$trainset == 'perc')
return(perc.df.train.over)
})
output$trainsetdistr <- DT::renderDataTable({
if(input$sample == 'over'){
return(over_trainset_df())
}
if(input$sample == 'original'){
return(trainset_df())
}
}
)
I'm building a Shiny Application using R , basically it takes a dataset and runs it through several models - Classification / Regression.
The problem i am facing now is , I take inputs from the user with some being numeric and some being factors. The Factor inputs always have one level since we are using Radiobuttons to select a value.
radioButtons("HomeOwner", "Does the Customer own a home?", choiceNames=c('Yes', 'No'), choiceValues = c(1,0)),
radioButtons("Debt", "Does the Customer has existing debt?", choiceNames=c('Yes', 'No'), choiceValues = c(1,0)),
So my dataframe from the building the model has Factors for 3 variables and so does my input data frame from the user but the levels are one since i need to know if they select Yes or No.
Below is the Dataframe :
When i try to predict using the model created , i get the contrast error because of my input dataframe having factor of 1 in three variables , i need them to be factors or is there any way to solve this?
Edit 1 : Whole App
# Application Start
# Initiating Library
source("Functions.R")
library(shiny)
library(shinythemes)
#########################Start of ShinyApp Code#######################################
# Install the shiny and shinythemes packages
# install.packages('shiny')
# install.packages('shinythemes')
# Create the user interface (ui) where you will take the input and display the output
#ui <- fluidpage()
ui <- fluidPage(shinythemes::themeSelector(),
titlePanel("Assignment-AIPM"),
sidebarLayout(
sidebarPanel(
selectInput("selectds","Select the dataset to work with",
choices = c("Boston Housing Dataset"=1,
"Customer Profit Dataset"=2,
"Financial Dataset"=3,
"Education Tech Dataset"=4)
),
br(),
actionButton("runmodels","Run Models"),
),
mainPanel(
navbarPage("Information",
tabPanel("Input",uiOutput("myInput")),
tabPanel("Output",tableOutput("myOutput")),
tabPanel("Plots",plotOutput("myPlot"))
)
)
)
) # fluidPage
# https://stackoverflow.com/questions/30906325/shiny-use-column-headers-from-read-in-file-as-selectinput-choices - To select
# Input from a datapath using the columns
# https://stackoverflow.com/questions/54205476/how-to-execute-a-function-in-the-shiny-server-depending-on-the-inputid-value-of/54220548
# Function Execution
# Define server function
server <- function(input, output, session)
{
observeEvent(input$runmodels,
{
############################# Boston House Prediction
if(input$selectds == 1 )
{
print("Entering Boston House Prediction Input")
output$myInput <- renderUI({
tagList(tags$h3("Enter the details of the Land:"),
radioButtons("CHAS", "Near Charles River or Not", choiceNames=c('Yes', 'No'), choiceValues = c('1','0')),
numericInput("CRIM", "Criminal Rate 1 - 5", 1, min=1, max=5),
numericInput("ZN", "Proportion of Land Zone over 25,000 SQFT", 1),
numericInput("INDUS", "Proportion of Industrial Business in the town", 1),
numericInput("RM", "Average Number of Rooms Per Dwelling", 1),
numericInput("NOX", "Tenure in No. of Years", 1),
numericInput("AGE", "Proportion of Owner Occupied Buildings prior 1940", 1),
numericInput("DIS", "Weighted Distances to Boston Employment Centre", 1),
numericInput("RAD", "Radial Access to highways", 1),
numericInput("TAX", "Full Value Property rate per 10,000$", 1),
numericInput("PTRATIO", "Pupil - Teacher Ratio in Town", 1),
numericInput("B", "Proportion of Black Population in Town", 1),
numericInput("LSTAT", "Percentage of Lower Status Population", 1),
HTML("<br> <br>")
)
})
data_input = reactive({
data.frame(CHAS = factor(input$CHAS),
CRIM = input$CRIM,
ZN = input$ZN,
INDUS = input$INDUS,
NOX = input$NOX,
RM = input$RM,
AGE = input$AGE,
DIS = input$DIS,
RAD = input$RAD,
TAX = input$TAX,
PTRATIO = input$PTRATIO,
B = input$B,
LSTAT = input$LSTAT)
})
regressor_linear <- boston_linear_reg()
data_output = reactive({
data.frame(Logistic_regression = predict(regressor_linear,type='response',data_input())
)
})
output$myOutput <- renderTable({data_output()})
}
############################################### Customer Profit
if(input$selectds == 2 )
{
print("Entering Customer Profit User Input")
output$myInput <- renderUI({
tagList(tags$h3("Enter the details of the customer:"),
radioButtons("Online", "Online Customer?", choiceNames=c('Yes', 'No'), choiceValues = c('1','0')),
radioButtons("Age", "Whats your Customer Age Group?", choiceNames=c('0-10','10-20','20-30','30-40','40-50','50-60','60-70'), choiceValues = c('1','2','3','4','5','6','7')),
radioButtons("Income", "Whats your Customer Income Group?", choiceNames=c('5k-10k','10k-15k','15k-20k','20k-25k','25k-30k','30k-35k','35k-40k','40k-50k','50k+'), choiceValues = c('1','2','3','4','5','6','7','8','9')),
numericInput("Tenure", "Tenure in No. of Years", 1),
HTML("<br> <br>"))
})
data_input = reactive({
data.frame(Online = as.integer(input$Online),
Age = as.integer(input$Age),
Inc = as.integer(input$Income),
Tenure = as.numeric(input$Tenure))
})
regressor_linear <- customer_linear_reg()
classifier_Rforest <- customer_RForest_Regression()
classifier_NNet <- customer_NeuralNet()
data_output = reactive({
data.frame(Linear_regression = predict(regressor_linear,data_input()),
Random_Forest_Prediction = predict(classifier_Rforest,data_input()),
Neural_Net_Prediction = as.data.frame(h2o.predict(classifier_NNet, newdata = as.h2o(data_input())))
)
})
output$myOutput <- renderTable({data_output()})
}
########################## Financial set
if(input$selectds == 3 )
{
print("Entering Finanical User Input")
output$myInput <- renderUI({
tagList(numericInput("Age", "Please enter the Customer Age(1-100)", 25, min=1, max=100),
numericInput("Income", "Please enter Customer monthly Income(0-100000$)", 3500, min=0, max=100000),
radioButtons("HomeOwner", "Does the Customer own a home?", choiceNames=c('Yes', 'No'), choiceValues = c(1,0)),
radioButtons("Debt", "Does the Customer has existing debt?", choiceNames=c('Yes', 'No'), choiceValues = c(1,0)),
numericInput("EmpPeriod", "Please enter the Customer employement period in months", 45),
numericInput("AccPeriod", "Please enter Customer Account Age in months",45),
numericInput("Amount", "Please enter Amount Requested($)",1000),
radioButtons("PaySchedule", "Please enter Pay Schedule", choiceNames=c('bi-weekly', 'weekly', 'semi-monthly','monthly'), choiceValues = c(1,2,3,4)),
numericInput("CurrAddress", "Please enter the Customer currnt address period in months", 45),
numericInput("RiskScore", "Please enter Customer Risk Score (1-100000",40000),
numericInput("Enquiry", "Please enter Customer enquiries last month",5),
actionButton("Predict", "Predict Sanction"))
})
observeEvent(input$Predict, {
data_input = reactive({
data.frame(
home_owner = factor(input$HomeOwner),
age = as.numeric(input$Age),
income = as.numeric(input$Income),
has_debt = factor(input$Debt),
amount_requested = input$Amount,
employment_period = input$EmpPeriod,
personal_account_period = input$AccPeriod,
pay_schedule = factor(input$PaySchedule),
current_address_period = input$CurrAddress,
inquiries_last_month = as.integer(input$Enquiry),
risk_score = input$RiskScore
)
})
logistic_regressor = financial_logistic_regression()
Single_DT = financial_DT()
#classifier_svm = financial_svm()
str(data_input())
data_output = reactive({
data.frame(Logistic_regression = predict(logistic_regressor,type='response',newdata=data_input()),
#Support_vector_machine = predict(classifier_svm, type = 'response', newdata = data_input())
Single_Decision_Tree = predict(Single_DT$classifier, type = 'class', newdata = data_input())
)
})
output$myPlot <- renderPlot({rpart.plot::rpart.plot(Single_DT$classifier)})
output$myOutput <- renderTable({data_output()})
})
}
Functions.R
#Functions for Shiny Assignement
library(caret)
library(ROCR)
library(Metrics)
library(dplyr)
library(caTools)
library(e1071)
library(zoo)
library(car)
library(rpart)
library(randomForest)
library(rpart.plot)
library(h2o)
library(data.table)
# Global Datasets
bostonds <- read.csv('Datasets/02_Boston.csv')
customerds <- read.csv('Datasets/01_CustomerProfit_Regression.csv')
financialds <- read.csv('Datasets/04_P39_Financial_Data.csv')
edtechds <- read.csv('Datasets/05_Lead_Scoring.csv')
boston_linear_reg <- function()
{
set.seed(1234)
data_nomiss = bostonds %>% select(CRIM,ZN,INDUS,CHAS,NOX,RM,AGE,DIS,RAD,
TAX,PTRATIO,B,LSTAT,MEDV) %>% na.omit()
data_nomiss$CHAS = factor(data_nomiss$CHAS)
regressor_lm = lm(formula = MEDV ~ .,data=data_nomiss)
return(regressor_lm)
#medv_predict = predict(regressor,test_ds)
}
customer_linear_reg <- function()
{
data_nomiss = customerds %>% select(Profit,Online,Age,Inc,Tenure) %>% na.omit()
#data_nomiss$Online = factor(data_nomiss$Online)
set.seed(123)
regressor_lm = lm(formula = Profit ~ Online + Inc + Age + Tenure
, data = data_nomiss,na.action = na.omit)
str(data_nomiss)
return(regressor_lm)
#profit_predict = predict(regressor, newdata=test_set)
}
customer_RForest_Regression <- function()
{
######## Data Processing and Cleanup starts here
dataset = customerds
# Creating a new dataset called 'data_nomiss' which will have no missing data
data_nomiss = dataset %>%
select(Profit,Online,Age,Inc,Tenure) %>%
na.omit()
#data_nomiss$Online = factor(data_nomiss$Online)
#data_nomiss$Age = factor(data_nomiss$Age, labels = c('0-10','10-20','20-30','30-40','40-50','50-60','60-70'),levels = c('1','2','3','4','5','6','7'))
#data_nomiss$Inc = factor(data_nomiss$Inc, labels = c('5k-10k','10k-15k','15k-20k','20k-25k','25k-30k','30k-35k','35k-40k','40k-50k','50k+'),levels = c('1','2','3','4','5','6','7','8','9'))
# Factor Variables
#data_nomiss[,1] = scale(data_nomiss[,1])
#data_nomiss[,5] = scale(data_nomiss[,5])
########### Data Processing and Cleanup ends here
set.seed(123)
classifier = randomForest(Profit ~ .,data=data_nomiss,na.action = na.omit,ntree=100)
return(classifier)
}
customer_NeuralNet <- function()
{
dataset = customerds
data_nomiss = dataset %>%
select(Profit,Online,Age,Inc,Tenure) %>%
na.omit()
set.seed(123)
h2o.init(nthreads = -1)
classifier = h2o.deeplearning(y = 'Profit',
training_frame = as.h2o(data_nomiss),
activation = 'Tanh',
hidden = c(10),
epochs = 100,
train_samples_per_iteration = -2)
return(classifier)
}
############################### Financial Dataset
financial_pre_process <- function(ds)
{
####################Data Processing and Clean up Start#############################
data_nomiss = ds %>% select(age,pay_schedule,home_owner,income,
months_employed,years_employed,current_address_year,
personal_account_m,personal_account_y,has_debt,
amount_requested,risk_score,risk_score_2,
risk_score_3,risk_score_4,risk_score_5,
ext_quality_score,ext_quality_score_2,
inquiries_last_month,e_signed) %>% na.omit()
data_nomiss$e_signed = factor(data_nomiss$e_signed)
data_nomiss$home_owner = factor(data_nomiss$home_owner)
data_nomiss$has_debt = factor(data_nomiss$has_debt)
data_nomiss$pay_schedule = factor(data_nomiss$pay_schedule,
levels = c('weekly','bi-weekly','monthly','semi-monthly'),
labels = c(1,2,3,4))
data_nomiss$employment_period = data_nomiss$months_employed + (data_nomiss$years_employed * 12)
data_nomiss$personal_account_period = data_nomiss$personal_account_m + (data_nomiss$personal_account_y * 12)
data_nomiss$current_address_period = data_nomiss$current_address_year * 12
data_nomiss = select(data_nomiss,-c(months_employed,years_employed,personal_account_m,personal_account_y,current_address_year))
data_nomiss[,1] = scale(data_nomiss[,1]) # Age
data_nomiss[,4] = scale(data_nomiss[,4]) # Income
data_nomiss[,6:14] = scale(data_nomiss[,6:14]) # Amount Requested -> Risk score
data_nomiss[,16:18] = scale(data_nomiss[,16:18]) # Created Columns
data_nomiss[,1] = apply(data_nomiss[,1], 1, as.numeric)
data_nomiss[,4] = apply(data_nomiss[,4], 1, as.numeric)
return(data_nomiss)
####################Data Processing and Clean up End#############################
}
financial_logistic_regression <- function()
{
ds = financialds
set.seed(1234)
data_nomiss = financial_pre_process(ds)
str(data_nomiss)
classifier_log = glm(formula = e_signed ~ age+pay_schedule+current_address_period+home_owner+income+employment_period+has_debt+amount_requested+personal_account_period+risk_score+inquiries_last_month,
family = binomial,
data = data_nomiss)
return(classifier_log)
}
financial_svm <- function()
{
ds = financialds
set.seed(1234)
data_nomiss = financial_pre_process(ds)
classifier_svm = svm(formula = e_signed ~ age+pay_schedule+current_address_period+home_owner+income+employment_period+has_debt+amount_requested+personal_account_period+risk_score+inquiries_last_month,
data = data_nomiss,
type = 'C-classification',
kernel = 'radial')
return(classifier_svm)
}
financial_DT <- function()
{
ds = financialds
set.seed(1234)
data_nomiss = financial_pre_process(ds)
classifier_DT = rpart(formula = e_signed ~ age+pay_schedule+current_address_period+home_owner+income+employment_period+has_debt+amount_requested+personal_account_period+risk_score+inquiries_last_month,
data = data_nomiss)
result <- list()
result$classifier <- classifier_DT
result$plot <- rpart.plot::rpart.plot(classifier_DT)
return(result)
}
financial_RForest <- function()
{
ds = financialds
set.seed(1234)
data_nomiss = financial_pre_process(ds)
classifier_RForest = randomForest(x= training_set[-15],
y= training_set$e_signed,
ntree=1500)
result <- list()
result$classifier <- classifier_RForest
result$plot <- rpart.plot::rpart.plot(classifier_RForest)
return(result)
}
}
I assume this is a duplicate question (sorry in advance), but I seem not able to resolve this issue. I created a shiny app, which implements a random forest model (party package) returning results with the caret package and visualizing a conditional interference tree with the ctree function. The app works fine locally. However, when I try the publish it no output gets displayed and I get the error "An error has occurred. Check your logs or contact the app author for clarification." What am I missing here?
The data I use for the model comes from a csv file stored on a dropbox account perhaps this might be the issue? I first used RData and switched to csv file, since this seems to be more often used with shiny.
I followed the steps described on: https://support.rstudio.com/hc/en-us/articles/229848967-Why-does-my-app-work-locally-but-not-on-shinyapps-io-, to see if this resoveld the issue. I restarted R and the computer. This did not work.
There is no code or data stored in the local environment when running locally.
All packages are loaded via library().
I load the data via a relative path df <- read.csv("data/df.csv"). All files are stored in a map called shinyapp as app.R and the df.csv in the file data.
The dataset is relatively large so I cannot display it here, but I created a dummy dataset which can be used to run the app.
library(shiny)
library(party)
library(caret)
#==============================================================================
#Use dummy dataset in stead of original data
#df <- read.csv("data/df.csv")
#df <- df[df$Taxon %in% names(table(df$Taxon))[table(df$Taxon) >= 50],]
#Create dummy dataset
df <- data.frame(Sample = 1:500, Taxon = paste0("spec", rbinom(n = 500, 2, 0.5)), SO4 = rnorm(500, 300, 50), pH = rnorm(500, 7, 1), NO3 = rnorm(500, 10, 3))
ui <- fluidPage(
titlePanel("Random Forest classification"),
sidebarPanel(
selectInput(inputId = "Spec", label = "Select species:", unique(df$Taxon)),
selectInput(inputId = "NAN", label = "Select how to use data:", c("All data (Also NAs)", "Complete data (No NAs)")),
numericInput(inputId = "SO4", label = "Choose value for SO4 (mg/l)", value = median(df$SO4, na.rm = T), min = 0, max = 15000),
numericInput(inputId = "pH", label = "Choose value for pH", value = median(df$pH, na.rm = T), min = 5, max = 10),
numericInput(inputId = "NO3", label = "Choose value for NO3 (mg/l)", value = median(df$NO3, na.rm = T), min = 0, max = 50),
h3("Validation parameters"),
textOutput("Validation"),
h3("Voting percentage"),
textOutput("Votingperc"),
h3("Remarks"),
h5("Note that every time the output of the model is different from
the previous. Samples with the absence of species are more
prevalent. Therefore, Every time the code is run, samples where a species
was present are the same. However, samples with absences are randomly
selected in equall amount and combines this with samples where the.
species was present Further, the random forest model randomly creates
trees by bootstrapping the dataset a 100 times. Each time a different
model is created. This model is a course estimation, since many more
important factors are absent. Validation of the model is performed by
training the model on 75% of the dataset and validating on the other 25%.
The predicting model is based on the total dataset. The Error:
replacement has 1 row, data has 0, occurs when the data for a species
has no measurements if complete data (without NAs) is used.")),
mainPanel(plotOutput("Imp"),
plotOutput("Tree")))
server <- function(input,output){
#Create model dataset
modpred <- reactive({
present <- df[df$Taxon == input$Spec,]
present$Spec <- 1
df1 <- df[!duplicated(df$Sample),]
df1 <- df1[!df1$Sample %in% present$Sample,]
if(input$NAN == "Complete data (No NAs)"){
present <- na.omit(present)
df1 <- na.omit(df1)}
if((nrow(df)-nrow(present)) > nrow(present)){
absent <- df1[sample(1:nrow(df1), nrow(present), replace = F),]}
else{
absent <- df1[sample(1:nrow(df1), nrow(present), replace = T),]}
absent$Spec <- 0
model.data <- rbind(present, absent)
model.data$Spec <- as.factor(model.data$Spec)
#Select 75% as training data
prestrain <- present[sample(1:nrow(present), floor(nrow(absent)*0.75), replace = F),]
abstrain <- absent[sample(1:nrow(absent), floor(nrow(present)*0.75), replace = F),]
train.data <- rbind(prestrain, abstrain)
train.data$Spec <- as.factor(train.data$Spec)
#Select the other 25% as validation data
val.data <- model.data[!rownames(model.data) %in% rownames(train.data),]
#Create nice conditional interference tree on all data
ct <- party::ctree(Spec~SO4+pH+NO3, data = model.data)
#Train and validate model
train.model <- party::cforest(Spec~SO4+pH+NO3, data=train.data, controls = party::cforest_classical(mtry = 1, ntree = 100))
validation.mod <- predict(train.model, newdata = val.data)
conf.mat.val <- table(val.data$Spec, predict(train.model, newdata = val.data))
val.results <- caret::confusionMatrix(conf.mat.val)
sumval <- paste0("AUC=", round(val.results$overall[1],2), " (LCI=", round(val.results$overall[3],2),"; ",
"HCI=", round(val.results$overall[4],2), "), ",
"Cohen's kappa=", round(val.results$overall[2],2), ", ",
"n-validation=", nrow(val.data), ", ", "n-training=", nrow(train.data), ", ", "n-total (model)=", nrow(model.data))
#Extract relative importance parameters
relimp <- as.data.frame(party::varimp(train.model))
relimp <- cbind.data.frame(rownames(relimp), relimp)
colnames(relimp)<-c("Parameter", "Relative importance")
rownames(relimp)<- NULL
relimp[,2] <- relimp$`Relative importance`/sum(relimp$`Relative importance`)*100
relimp <- relimp[order(-relimp$`Relative importance`),]
#Apply model on data input user interface
model <- party::cforest(Spec~SO4+pH+NO3, data=model.data, controls = party::cforest_classical(mtry = 1, ntree = 100))
pred.data <- setNames(data.frame(as.numeric(input$SO4), as.numeric(input$pH), as.numeric(input$NO3)), c("SO4", "pH", "NO3"))
pred <- predict(model, newdata = pred.data, type = "prob")
prob <- paste0("Voting percentage (Probability of presence) = ", round(pred$`1`[2]*100,0),"%", ",",
" Majority vote indicates = ", ifelse(pred$`1`[2] > 0.5, "Present", "Absent"))
combo <- list(Probability = prob, Validation = sumval, Tree = ct, Importance = relimp)})
output$Votingperc <- renderText({
combo <- modpred()
combo$Probability})
output$Validation <- renderText({
combo <- modpred()
combo$Validation})
output$Imp <- renderPlot({
combo <- modpred()
bar <- combo$Imp
barplot(bar$`Relative importance`,
names.arg = bar$Parameter, ylab = "Relative importance (%)")})
output$Tree <- renderPlot({
combo <- modpred()
plot(combo$Tree, inner_panel=node_inner(combo$Tree, pval = FALSE))})
}
shinyApp(ui,server)
Thank you in advance for your help.
Here is my code - creating a dashboard that will filter by date. One tab will show our wellness survey data, the other will show post-practice loading data. I am pulling in the first 3 columns from "post.csv" which are Date, Name, Daily. Then I am looking to create and add the next 3 columns with the math.
Where I am first stuck is that I need my Daily_Load to aggregate data for a specific athlete on the given Date. Then I need to create a rolling 7-day sum for each athlete using the Daily load data from the last 7 days (including Date selected). A 28-Day Rolling Sum/4 and 7-Day/28-Rolling is the last piece.
Thanks again for all of the help!
library(shiny)
library(dplyr)
library(lubridate)
library(ggplot2)
library(DT)
library(zoo)
library(tidyr)
library(tidyverse)
library(data.table)
library(RcppRoll)
AM_Wellness <- read.csv("amwell.csv", stringsAsFactors = FALSE)
Post_Practice <- read.csv("post.csv", stringsAsFactors = FALSE)
Post_Data <- Post_Practice[, 1:3]
Daily_Load <- aggregate(Daily~ ., Post_Data, sum)
Acute_Load <- rollsum(Post_Data$Daily, 7, fill = NA, align = "right")
Chronic_Load <- rollsum(Post_Data$Daily, 28, fill = NA, align = "right")/4
Post_Data['Day Load'] <- aggregate(Daily~ ., Post_Data, sum)
Post_Data['7-Day Sum'] <- Acute_Load
Post_Data['28-Day Rolling'] <- Chronic_Load
Post_Data['Ratio'] <- Acute_Load/Chronic_Load
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
dateInput('date',
label = "Date",
value = Sys.Date()
),
selectInput("athleteInput", "Athlete",
choices = c("All"))
),
mainPanel(tabsetPanel(type = "tabs",
tabPanel("AM Wellness", tableOutput("amwell")),
tabPanel("Post Practice", tableOutput("post"))
)
)
)
)
server <- function(input, output) {
output$amwell <- renderTable({
datefilter <- subset(AM_Wellness, AM_Wellness$Date == input$date)
}, hover = TRUE, bordered = TRUE, spacing = "xs", align = "c")
output$post <- renderTable({
datefilter <- subset(Post_Data, Post_Data$Date == input$date)
}, hover = TRUE, bordered = TRUE, spacing = "xs", align = "c")
}
shinyApp(ui = ui, server = server)
Hey I am trying to build a shiny app for the purpose of calculating per cent chance of defaulting and I thought I fixed all my issues until I hit
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
but whenever I try to build something reactive I get
Error in RET#get_where(newdata = newdata, mincriterion = mincriterion) :
object 'loanfilev3' not found
I've looked over stackoverflow and tutorials and none seem to really help
Here is my UI and Server code for the first error, if someone could please highlight my issue that would be greatly appreciated.
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select the random distribution type ----
numericInput("loan_amnt",
"Loan Amount:",
value = 5000,
min = 0,
max = NA),
numericInput("int_rate",
"Interest Rate:",
value = 10.5,
min = 0,
max = NA),
selectInput("term",
"Loan Term:",
c("36 months" = " 36 months",
"60 months" = " 60 months")),
numericInput("installment",
"Installment:",
value = 100,
min = 0,
max = NA),
textInput("grade", "Grade:", "B"),
textInput("emp_length", "Employment Length:", "5 years"),
numericInput("annual_inc",
"Annual Income:",
value = 40000,
min = 0,
max = NA),
numericInput("dti",
"Debt to Income Ratio:",
value = 5.4,
min = NA,
max = NA),
textInput("sub_grade", "SubGrade:", "B2"),
textInput("verification_status", "Verification Status:", "Verified"),
textInput("home_ownership", "Home Ownership:", "RENT"),
radioButtons("pymnt_plan", "Payment Plan:",
c("Yes" = "y",
"No" = "n"))
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Decision Tree", verbatimTextOutput("ct")),
tabPanel("Generlized Linear Model", verbatimTextOutput("dl")),
tabPanel("K-Nearest Neighbour", verbatimTextOutput("kn"))
)
)
)
)
)
Server:
library(shiny)
library(pscl)
library(ROCR)
library(plyr)
library(dplyr)
library(ggplot2)
library(pROC)
library(caret)
library(e1071)
library(RMySQL)
library(reshape2)
USER <- 'inft216'
PASSWORD <- 'rosemary'
HOST <- 'bruce3.dc.bond.edu.au'
DBNAME <- 'inft216'
db <- dbConnect(MySQL(), user = USER, password = PASSWORD, host = HOST, dbname = DBNAME)
loanfile <- dbGetQuery(db, statement = "select * from lendingClub;")
dbDisconnect(db)
library(party)
colnames(loanfile) = tolower(colnames(loanfile))
bad_indicators = c("Charged Off",
"Default",
"Does not meet the credit policy. Status:Charged Off",
"Default Receiver",
"Late (16-30 days)",
"Late (31-120 days)")
loanfile$default = ifelse(loanfile$loan_status %in% bad_indicators, 1,
ifelse(loanfile$loan_status=="", NA, 0))
loanfile$loan_status = as.factor(loanfile$default)
loanfilev2 = dplyr::select(.data = loanfile,loan_status,loan_amnt,int_rate,term,installment,grade,emp_length,annual_inc,dti,sub_grade,verification_status,home_ownership,pymnt_plan)
loanfilev2$grade = as.factor(loanfilev2$grade)
loanfilev2$sub_grade <- as.factor(loanfilev2$sub_grade)
loanfilev2$term <- as.factor(loanfilev2$term)
loanfilev2$emp_length <- as.factor(loanfilev2$emp_length)
loanfilev2$verification_status <- as.factor(loanfilev2$verification_status)
loanfilev2$home_ownership <- as.factor(loanfilev2$home_ownership)
loanfilev2$pymnt_plan <- as.factor(loanfilev2$pymnt_plan)
loanfilev2$loan_status <- as.factor(loanfilev2$loan_status)
loanfilev2$grade <- as.numeric(loanfilev2$grade)
loanfilev2$sub_grade <- as.numeric(loanfilev2$sub_grade)
loanfilev2$term <- as.numeric(loanfilev2$term)
loanfilev2$emp_length <- as.numeric(loanfilev2$emp_length)
loanfilev2$verification_status <- as.numeric(loanfilev2$verification_status)
loanfilev2 <- loanfilev2[complete.cases(loanfilev2),]
set.seed(69)
train_index <- sample(seq_len(nrow(loanfilev2)), size = 5000)
TrainData<- loanfilev2[train_index, ]
ct = ctree(loan_status ~ ., data = TrainData)
dl <- glm(formula = loan_status ~ .,data = loanfilev2, family = binomial)
kn <- train(form = loan_status ~.,data = TrainData, method = 'knn')
shinyServer(function(input, output) {
loan_status <- c(0)
loan_amnt <- input$loan_amnt
int_rate <- input$int_rate
term <- input$term
installment <- input$installment
grade <- input$grade
emp_length <- input$emp_length
annual_inc <- input$annual_inc
dti <- input$dti
sub_grade <- input$sub_grade
verification_status <- input$verification_status
home_ownership <- input$home_ownership
pymnt_plan <- input$pymnt_plan
temp2 <- cbind(loan_status, loan_amnt, int_rate, term, installment, grade, emp_length, annual_inc, dti, sub_grade, verification_status, home_ownership, pymnt_plan)
loanfilev3 = dplyr::select(.data = loanfile,loan_status,loan_amnt,int_rate,term,installment,grade,emp_length,annual_inc,dti,sub_grade,verification_status,home_ownership,pymnt_plan)
loanfilev3 = rbind(loanfilev3, temp2, deparse.level = 0)
loanfilev3$grade = as.factor(loanfilev3$grade)
loanfilev3$sub_grade <- as.factor(loanfilev3$sub_grade)
loanfilev3$term <- as.factor(loanfilev3$term)
loanfilev3$emp_length <- as.factor(loanfilev3$emp_length)
loanfilev3$verification_status <- as.factor(loanfilev3$verification_status)
loanfilev3$home_ownership <- as.factor(loanfilev3$home_ownership)
loanfilev3$pymnt_plan <- as.factor(loanfilev3$pymnt_plan)
loanfilev3$loan_status <- as.factor(loanfilev3$loan_status)
loanfilev3$grade <- as.numeric(loanfilev3$grade)
loanfilev3$sub_grade <- as.numeric(loanfilev3$sub_grade)
loanfilev3$term <- as.numeric(loanfilev2$term)
loanfilev3$emp_length <- as.numeric(loanfilev3$emp_length)
loanfilev3$verification_status <- as.numeric(loanfilev3$verification_status)
loanfilev3 <- loanfilev3[complete.cases(loanfilev3),]
prediction1 = c(predict(object = ct, newdata = loanfilev3[886508], type = "prob"))
output$ct <- renderPrint({
as.data.frame(prediction1)[2,]*100
})
})
All input bindings (input$whatever) need to be used in reactive context for example: inside reactive() or observe or renderXXX etc. In your case you are doing stuff like loan_amnt <- input$loan_amnt outside of reactive context and that's what the error is about. See my update below. I have added your prediction model to an eventReactive that is triggered by some action button input$predict.
# add this button somewhere in your ui.R -
actionButton("predict", "Predict!")
update to server.R -
shinyServer(function(input, output) {
prediction <- eventReactive(input$predict, {
loan_status <- c(0)
loan_amnt <- input$loan_amnt
int_rate <- input$int_rate
term <- input$term
installment <- input$installment
grade <- input$grade
emp_length <- input$emp_length
annual_inc <- input$annual_inc
dti <- input$dti
sub_grade <- input$sub_grade
verification_status <- input$verification_status
home_ownership <- input$home_ownership
pymnt_plan <- input$pymnt_plan
temp2 <- cbind(loan_status, loan_amnt, int_rate, term, installment, grade, emp_length, annual_inc, dti, sub_grade, verification_status, home_ownership, pymnt_plan)
loanfilev3 = dplyr::select(.data = loanfile,loan_status,loan_amnt,int_rate,term,installment,grade,emp_length,annual_inc,dti,sub_grade,verification_status,home_ownership,pymnt_plan)
loanfilev3 = rbind(loanfilev3, temp2, deparse.level = 0)
loanfilev3$grade = as.factor(loanfilev3$grade)
loanfilev3$sub_grade <- as.factor(loanfilev3$sub_grade)
loanfilev3$term <- as.factor(loanfilev3$term)
loanfilev3$emp_length <- as.factor(loanfilev3$emp_length)
loanfilev3$verification_status <- as.factor(loanfilev3$verification_status)
loanfilev3$home_ownership <- as.factor(loanfilev3$home_ownership)
loanfilev3$pymnt_plan <- as.factor(loanfilev3$pymnt_plan)
loanfilev3$loan_status <- as.factor(loanfilev3$loan_status)
loanfilev3$grade <- as.numeric(loanfilev3$grade)
loanfilev3$sub_grade <- as.numeric(loanfilev3$sub_grade)
loanfilev3$term <- as.numeric(loanfilev2$term)
loanfilev3$emp_length <- as.numeric(loanfilev3$emp_length)
loanfilev3$verification_status <- as.numeric(loanfilev3$verification_status)
loanfilev3 <- loanfilev3[complete.cases(loanfilev3),]
predict(object = ct, newdata = loanfilev3[886508], type = "prob"))
})
output$ct <- renderPrint({
as.data.frame(prediction())[2,]*100
})
})