Nothing
Binary Logistic Regression Modelling"
In BLRShiny: Interactive Document for Working with Binary Logistic Regression Analysis
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
library(caret)
library(e1071)
library(rhandsontable)
library(ggplot2)
library(datasets)
```r
sidebarPanel(
checkboxInput("ex","Uncheck for using your own file",value = TRUE),
fileInput("file", "Upload the *.csv file with headers"),
sliderInput("train_num", label = "Enter the proportion of training dataset:",
min = 0.6, max = 1, value = 0.6, step = 0.01),
sliderInput("cut_offprob", label = "Enter cutoff probability",
min = 0, max = 1, value = 0.5, step = 0.01),
uiOutput("vx"),
uiOutput("vy"),
tableOutput("convertd"),
uiOutput("vxi"),
downloadButton("downloadPlot", "Download LR Plot(Quantitative Predictors)")
)
mainPanel(
tabsetPanel(type = "tab",
tabPanel("Model Summary", verbatimTextOutput("AD") ),
tabPanel("Model Visualization", plotOutput("MV") ),
tabPanel("Model Evaluation", verbatimTextOutput("ME") ),
tabPanel("Model Deployment",verbatimTextOutput("MD"))
),
h6("Edit the test data record"),
rHandsontableOutput("testdata"),
h6("", tags$img(src ="K.JPG", height= 400, width=400))
)
output$AD<-renderPrint({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds =data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
model = glm(formula = as.formula(mod),data = dataframet,family = "binomial")
print(summary(model))
})
output$MV<-renderPlot({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
attach(dataframet)
if(class(get(input$variablexi)) == "factor")
{
assocplot(table(get(input$variablexi),get(input$variabley)),col = c("green","red"),xlab = input$variablexi, ylab = input$variabley)
}
else
{
ggplot(dataframet,aes(get(input$variablexi),get(input$variabley)))+
geom_point() + geom_smooth(method ="glm",se = FALSE,method.args=list(family = "binomial")) +
labs(title= "Logistic model visualization", x= input$variablexi,y=input$variabley)
}
})
output$ME<-renderPrint({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
model = glm(formula = as.formula(mod),data = dataframet,family = "binomial")
if(prop <1 )
{ cat(sprintf("\nValidation data is used\n"))
prediction = ifelse(predict(model,newdata = dataframev,type= "response") > input$cut_offprob,1,0)
attach(dataframev)
}
else
{
cat(sprintf("\nTraining data is used\n"))
prediction = ifelse(predict(model,newdata = dataframet,type= "response") > input$cut_offprob,1,0)
attach(dataframet)
}
print(confusionMatrix(as.factor(prediction),as.factor(get(input$variabley))))
})
output$MD<-renderPrint({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
model = glm(formula = as.formula(mod),data = dataframet,family = "binomial")
# print(summary(model))
test_data = data.frame(hot_to_r(input$testdata))
prediction = ifelse(predict(model,newdata = test_data ,type= "response") > input$cut_offprob,1,0)
test_data$predictedvalue = prediction
print(test_data)
})
output$vx <- renderUI({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
checkboxGroupInput("variablex","Select the variables",choices = colnames(data),selected = colnames(data))
})
output$vxi <- renderUI({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
ds = select(ds,c(-input$variabley))
selectInput("variablexi","Select the variable x for the plot",choices = colnames(ds),selected = "")
})
output$vy <- renderUI({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
ds = select_if(ds,is.factor)
d = data.frame(count=t( data.frame((lapply(ds,nlevels)))))
d$varname =row.names(d)
d= filter(d,count==2)
selectInput("variabley","Select the dependent variable",choices = d$varname ,selected = d$varname)
})
output$testdata <- renderRHandsontable({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
ds = select(ds,c(-input$variabley))
row.names(ds)= 1:NROW(ds)
rhandsontable(data.frame(ds[1,]))
})
output$convertd <- renderTable({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,c(input$variabley))
df = ds
ds = model.matrix(~0 + get(input$variabley),data = ds)
dnew = data.frame(cbind(df,ds))
df = data.frame(dcat =unique(dnew))
row.names(df)= 1:NROW(df)
df[,3]= NULL
colnames(df)=c("ActualValues","BinaryValues")
print(data.frame(df))
})
plotInput = function() {
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
attach(dataframet)
if(class(get(input$variablexi)) != "factor")
{
ggplot(dataframet,aes(get(input$variablexi),get(input$variabley)))+
geom_point() + geom_smooth(method ="glm",se = FALSE,method.args=list(family = "binomial")) + labs(title= "Logistic model visualization", x= input$variablexi,y=input$variabley)
}
}
output$downloadPlot = downloadHandler(
filename = 'LR.png',
content = function(file) {
device <- function(..., width, height) {
grDevices::png(..., width = width, height = height,
res = 300, units = "in")
}
ggsave(file, plot = plotInput(), device = device)
dev.off
})
Try the BLRShiny package in your browser
Any scripts or data that you put into this service are public.
BLRShiny documentation built on May 9, 2019, 5:05 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = TRUE) library(dplyr) library(caret) library(e1071) library(rhandsontable) library(ggplot2) library(datasets)
```r sidebarPanel( checkboxInput("ex","Uncheck for using your own file",value = TRUE), fileInput("file", "Upload the *.csv file with headers"), sliderInput("train_num", label = "Enter the proportion of training dataset:", min = 0.6, max = 1, value = 0.6, step = 0.01), sliderInput("cut_offprob", label = "Enter cutoff probability", min = 0, max = 1, value = 0.5, step = 0.01), uiOutput("vx"), uiOutput("vy"), tableOutput("convertd"), uiOutput("vxi"), downloadButton("downloadPlot", "Download LR Plot(Quantitative Predictors)")
) mainPanel( tabsetPanel(type = "tab", tabPanel("Model Summary", verbatimTextOutput("AD") ), tabPanel("Model Visualization", plotOutput("MV") ), tabPanel("Model Evaluation", verbatimTextOutput("ME") ), tabPanel("Model Deployment",verbatimTextOutput("MD")) ), h6("Edit the test data record"), rHandsontableOutput("testdata"), h6("", tags$img(src ="K.JPG", height= 400, width=400)) ) output$AD<-renderPrint({ if(input$ex == TRUE) { data("iris") data = iris[1:100,1:4] data$Species = "setosa" data[51:100,5] = "versicolor" data$Species =factor(data$Species) set.seed(1) gp= runif(nrow(data)) data = data[order(gp),]
}
else{ file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()} }
ds =data
ds = select(ds,input$variablex) mod = paste(input$variabley,"~.") indexdependent= grep(input$variabley, colnames(ds)) df = data.frame(model.matrix(~0 + get(input$variabley),data = ds)) df[,2]= NULL ds[,indexdependent] = df[,1] options(scipen = 999) prop = input$train_num set.seed(1) dataframe = ds train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop) dataframet = dataframe[train.rows,] valid.rows = setdiff(row.names(dataframe),train.rows) dataframev = dataframe[valid.rows,]
model = glm(formula = as.formula(mod),data = dataframet,family = "binomial") print(summary(model))
})
output$MV<-renderPlot({ if(input$ex == TRUE) { data("iris") data = iris[1:100,1:4] data$Species = "setosa" data[51:100,5] = "versicolor" data$Species =factor(data$Species) set.seed(1) gp= runif(nrow(data)) data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
attach(dataframet)
if(class(get(input$variablexi)) == "factor")
{
assocplot(table(get(input$variablexi),get(input$variabley)),col = c("green","red"),xlab = input$variablexi, ylab = input$variabley)
}
else
{
ggplot(dataframet,aes(get(input$variablexi),get(input$variabley)))+
geom_point() + geom_smooth(method ="glm",se = FALSE,method.args=list(family = "binomial")) +
labs(title= "Logistic model visualization", x= input$variablexi,y=input$variabley)
}
}) output$ME<-renderPrint({ if(input$ex == TRUE) { data("iris") data = iris[1:100,1:4] data$Species = "setosa" data[51:100,5] = "versicolor" data$Species =factor(data$Species) set.seed(1) gp= runif(nrow(data)) data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
model = glm(formula = as.formula(mod),data = dataframet,family = "binomial") if(prop <1 ) { cat(sprintf("\nValidation data is used\n")) prediction = ifelse(predict(model,newdata = dataframev,type= "response") > input$cut_offprob,1,0) attach(dataframev) } else { cat(sprintf("\nTraining data is used\n")) prediction = ifelse(predict(model,newdata = dataframet,type= "response") > input$cut_offprob,1,0) attach(dataframet) }
print(confusionMatrix(as.factor(prediction),as.factor(get(input$variabley))))
}) output$MD<-renderPrint({ if(input$ex == TRUE) { data("iris") data = iris[1:100,1:4] data$Species = "setosa" data[51:100,5] = "versicolor" data$Species =factor(data$Species) set.seed(1) gp= runif(nrow(data)) data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
valid.rows = setdiff(row.names(dataframe),train.rows)
dataframev = dataframe[valid.rows,]
model = glm(formula = as.formula(mod),data = dataframet,family = "binomial")
# print(summary(model))
test_data = data.frame(hot_to_r(input$testdata))
prediction = ifelse(predict(model,newdata = test_data ,type= "response") > input$cut_offprob,1,0)
test_data$predictedvalue = prediction
print(test_data)
})
output$vx <- renderUI({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
checkboxGroupInput("variablex","Select the variables",choices = colnames(data),selected = colnames(data))
})
output$vxi <- renderUI({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
ds = select(ds,c(-input$variabley))
selectInput("variablexi","Select the variable x for the plot",choices = colnames(ds),selected = "")
}) output$vy <- renderUI({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
ds = select_if(ds,is.factor)
d = data.frame(count=t( data.frame((lapply(ds,nlevels)))))
d$varname =row.names(d)
d= filter(d,count==2)
selectInput("variabley","Select the dependent variable",choices = d$varname ,selected = d$varname)
})
output$testdata <- renderRHandsontable({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex)
ds = select(ds,c(-input$variabley)) row.names(ds)= 1:NROW(ds) rhandsontable(data.frame(ds[1,]))
})
output$convertd <- renderTable({
if(input$ex == TRUE)
{
data("iris")
data = iris[1:100,1:4]
data$Species = "setosa"
data[51:100,5] = "versicolor"
data$Species =factor(data$Species)
set.seed(1)
gp= runif(nrow(data))
data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,c(input$variabley))
df = ds ds = model.matrix(~0 + get(input$variabley),data = ds)
dnew = data.frame(cbind(df,ds))
df = data.frame(dcat =unique(dnew))
row.names(df)= 1:NROW(df) df[,3]= NULL colnames(df)=c("ActualValues","BinaryValues")
print(data.frame(df))
}) plotInput = function() { if(input$ex == TRUE) { data("iris") data = iris[1:100,1:4] data$Species = "setosa" data[51:100,5] = "versicolor" data$Species =factor(data$Species) set.seed(1) gp= runif(nrow(data)) data = data[order(gp),]
}
else{
file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
}
ds = data
ds = select(ds,input$variablex) mod = paste(input$variabley,"~.")
indexdependent= grep(input$variabley, colnames(ds))
df = data.frame(model.matrix(~0 + get(input$variabley),data = ds))
df[,2]= NULL
ds[,indexdependent] = df[,1]
options(scipen = 999)
prop = input$train_num
set.seed(1)
dataframe = ds
train.rows = sample(row.names(dataframe),dim(dataframe)[1]*prop)
dataframet = dataframe[train.rows,]
attach(dataframet)
if(class(get(input$variablexi)) != "factor")
{
ggplot(dataframet,aes(get(input$variablexi),get(input$variabley)))+ geom_point() + geom_smooth(method ="glm",se = FALSE,method.args=list(family = "binomial")) + labs(title= "Logistic model visualization", x= input$variablexi,y=input$variabley)
} }
output$downloadPlot = downloadHandler( filename = 'LR.png', content = function(file) { device <- function(..., width, height) { grDevices::png(..., width = width, height = height, res = 300, units = "in") }
ggsave(file, plot = plotInput(), device = device)
dev.off
})
Try the BLRShiny package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.