Nothing
Discriminant Analysis Modelling"
In MLDAShiny2: Interactive Document for Working with Discriminant Analysis
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
library(caret)
library(e1071)
library(rhandsontable)
library(datasets)
library(DiscriMiner)
```r
options(shiny.maxRequestSize = 100 * 1024^2)
sidebarPanel(
checkboxInput("ex","Uncheck for using your own file",value = TRUE),
fileInput("file", "Upload the *.csv file with headers"),
selectInput("mt","Choose Type of model",choices = c("lda"),selected = "lda"),
sliderInput("train_num", label = "Enter the proportion of training dataset:",
min = 0.6, max = 1, value = 0.6, step = 0.01),
uiOutput("vx"),
uiOutput("vy"),
downloadButton("downloadPlot", "Download Plot")
)
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}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
#if(input$mt == "lda")
# {
model = MASS::lda(formula = as.formula(mod),data = dataframet)
print(model)
indexdependent= grep(input$variabley, colnames(dataframe))
if(prop<1 && ncol(dataframe)>2)
{
model2 = linDA(dataframe[,-indexdependent],dataframe[,indexdependent],validation = "learntest",learn = as.numeric(train.rows),test = as.numeric(valid.rows))
}
else
{ if(ncol(dataframe)>2)
{model2 = linDA(dataframe[,-indexdependent],dataframe[,indexdependent])}
}
if(ncol(dataframe)>2)
{cat(sprintf("\n Fishers linear discriminant function is as follows\n"))
print(model2$functions)}
# print(prediction)
# print(get(input$variabley))
# print(confusionMatrix(as.factor(prediction),as.factor(get(input$variabley))))
# }
})
output$MV<-renderPlot({
if(input$ex == TRUE)
{data("iris")
data = iris}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
if(input$mt == "lda")
# {
if(ncol(dataframet)>2)
{ klaR:: partimat(formula = as.formula(mod),data = dataframet,method="lda")}
else
{ df = select(dataframet,-c(input$variabley))
vx = colnames(df)
attach(dataframet)
boxplot(get(vx)~get(input$variabley),col ="red",ylab = vx,xlab = input$variabley)
}
}
})
output$ME<-renderPrint({
if(input$ex == TRUE)
{data("iris")
data = iris}
else
{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
#if(input$mt == "lda")
# {
model = MASS::lda(formula = as.formula(mod),data = dataframet)
if(prop <1 )
{ cat(sprintf("\nValidation data is used\n"))
prediction = predict(model,newdata = dataframev)
attach(dataframev)
}
else
{
cat(sprintf("\nTraining data is used\n"))
prediction = predict(model,newdata = dataframet)
attach(dataframet)
}
#print(prediction)
print(confusionMatrix(as.factor(prediction$class),as.factor(get(input$variabley))))
}
})
output$MD<-renderPrint({
if(input$ex == TRUE)
{data("iris")
data = iris}
else
{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
if(input$mt == "lda")
# {
model = MASS::lda(formula = as.formula(mod),data = dataframet)
test_data = data.frame(hot_to_r(input$testdata))
if(ncol(test_data)== 1)
{ df = select(dataframet,-c(input$variabley))
colnames(test_data)= colnames(df)
}
prediction = predict(model,newdata = test_data)
test_data$predictedvalue = prediction$class
print(test_data)
# }
})
output$vx <- renderUI({
if(input$ex == TRUE)
{data("iris")
data = iris}
else
{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
checkboxGroupInput("variablex","Select the variables",choices = colnames(data),selected = colnames(data))
})
output$vy <- renderUI({
if(input$ex == TRUE)
{data("iris")
data = iris}
else
{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
ds = select_if(ds,is.factor)
selectInput("variabley","Select the dependent variable",choices = colnames(ds),selected = "" )
})
output$testdata <- renderRHandsontable({
if(input$ex == TRUE)
{data("iris")
data = iris}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
ds = select(ds,-c(input$variabley))
rhandsontable(data.frame(ds[1,]))
})
output$downloadPlot<- downloadHandler(
filename = function() {
paste("Discriminantplot", ".png", sep = "")
},
content = function(file) {
png(file)
if(input$ex == TRUE)
{data("iris")
data = iris}
else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
if(input$mt == "lda")
# {
if(ncol(dataframet)>2)
{ klaR:: partimat(formula = as.formula(mod),data = dataframet,method="lda")}
else
{ df = select(dataframet,-c(input$variabley))
vx = colnames(df)
attach(dataframet)
boxplot(get(vx)~get(input$variabley),col ="red",ylab = vx,xlab = input$variabley)
}
}
dev.off()
})
Try the MLDAShiny2 package in your browser
Any scripts or data that you put into this service are public.
MLDAShiny2 documentation built on Aug. 28, 2020, 5:09 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(datasets) library(DiscriMiner)
```r options(shiny.maxRequestSize = 100 * 1024^2) sidebarPanel( checkboxInput("ex","Uncheck for using your own file",value = TRUE), fileInput("file", "Upload the *.csv file with headers"),
selectInput("mt","Choose Type of model",choices = c("lda"),selected = "lda"),
sliderInput("train_num", label = "Enter the proportion of training dataset:", min = 0.6, max = 1, value = 0.6, step = 0.01),
uiOutput("vx"), uiOutput("vy"), downloadButton("downloadPlot", "Download Plot")
) 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} else{ file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
#if(input$mt == "lda")
# {
model = MASS::lda(formula = as.formula(mod),data = dataframet)
print(model)
indexdependent= grep(input$variabley, colnames(dataframe))
if(prop<1 && ncol(dataframe)>2)
{
model2 = linDA(dataframe[,-indexdependent],dataframe[,indexdependent],validation = "learntest",learn = as.numeric(train.rows),test = as.numeric(valid.rows))
}
else
{ if(ncol(dataframe)>2)
{model2 = linDA(dataframe[,-indexdependent],dataframe[,indexdependent])}
}
if(ncol(dataframe)>2)
{cat(sprintf("\n Fishers linear discriminant function is as follows\n"))
print(model2$functions)}
# print(prediction) # print(get(input$variabley)) # print(confusionMatrix(as.factor(prediction),as.factor(get(input$variabley))))
# }
}) output$MV<-renderPlot({ if(input$ex == TRUE) {data("iris") data = iris} else{ file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
if(input$mt == "lda")
# { if(ncol(dataframet)>2) { klaR:: partimat(formula = as.formula(mod),data = dataframet,method="lda")} else { df = select(dataframet,-c(input$variabley)) vx = colnames(df) attach(dataframet) boxplot(get(vx)~get(input$variabley),col ="red",ylab = vx,xlab = input$variabley) }
}
})
output$ME<-renderPrint({ if(input$ex == TRUE) {data("iris") data = iris} else { file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
#if(input$mt == "lda") # { model = MASS::lda(formula = as.formula(mod),data = dataframet) if(prop <1 ) { cat(sprintf("\nValidation data is used\n")) prediction = predict(model,newdata = dataframev) attach(dataframev) } else { cat(sprintf("\nTraining data is used\n")) prediction = predict(model,newdata = dataframet) attach(dataframet) } #print(prediction)
print(confusionMatrix(as.factor(prediction$class),as.factor(get(input$variabley))))
}
})
output$MD<-renderPrint({ if(input$ex == TRUE) {data("iris") data = iris} else { file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
if(input$mt == "lda")
# {
model = MASS::lda(formula = as.formula(mod),data = dataframet)
test_data = data.frame(hot_to_r(input$testdata))
if(ncol(test_data)== 1)
{ df = select(dataframet,-c(input$variabley))
colnames(test_data)= colnames(df)
}
prediction = predict(model,newdata = test_data)
test_data$predictedvalue = prediction$class
print(test_data)
# }
})
output$vx <- renderUI({
if(input$ex == TRUE) {data("iris") data = iris} else {
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
checkboxGroupInput("variablex","Select the variables",choices = colnames(data),selected = colnames(data))
}) output$vy <- renderUI({
if(input$ex == TRUE) {data("iris") data = iris} else {
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
ds = select_if(ds,is.factor)
selectInput("variabley","Select the dependent variable",choices = colnames(ds),selected = "" )
})
output$testdata <- renderRHandsontable({
if(input$ex == TRUE) {data("iris") data = iris} else{
file1 = input$file
if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
ds = select(ds,-c(input$variabley))
rhandsontable(data.frame(ds[1,]))
})
output$downloadPlot<- downloadHandler( filename = function() { paste("Discriminantplot", ".png", sep = "") }, content = function(file) { png(file) if(input$ex == TRUE) {data("iris") data = iris} else{ file1 = input$file if(is.null(file1)){return()}
data = read.table(file = file1$datapath,sep =",",header = TRUE)
if(is.null(data())){return()}
quantdata = select_if(data,is.numeric)
qualdata = select_if(data,is.character)
qualdata = data.frame(lapply(qualdata,as.factor))
data = data.frame(cbind(quantdata,qualdata))
}
ds = data
ds = select(ds,input$variablex)
mod = paste(input$variabley,"~.")
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,]
if(input$mt == "lda")
# { if(ncol(dataframet)>2) { klaR:: partimat(formula = as.formula(mod),data = dataframet,method="lda")} else { df = select(dataframet,-c(input$variabley)) vx = colnames(df) attach(dataframet) boxplot(get(vx)~get(input$variabley),col ="red",ylab = vx,xlab = input$variabley) }
}
dev.off() })
Try the MLDAShiny2 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.