Nothing
# load data and libraries here: some for all users and sessions
library(png)
library(xtable)
library(data.table)
library(ROCR)
library(hexbin)
library(ggplot2)
library(kernlab)
data(iris)
levels(iris$Species)[levels(iris$Species)=="setosa"] <- "other"
levels(iris$Species)[levels(iris$Species)=="virginica"] <- "other"
mydata=iris
names(mydata)[names(mydata)=="Species"] <- "y"
names(mydata)[names(mydata)=="Sepal.Length"] <- "SL"
names(mydata)[names(mydata)=="Sepal.Width"] <- "SW"
names(mydata)[names(mydata)=="Petal.Length"] <- "PL"
names(mydata)[names(mydata)=="Petal.Width"] <- "PW"
indy=length(names(mydata))
mydata$y=as.factor(as.integer(mydata$y=="versicolor"))
mysig=0.03125
myC=46.41589
risklabel="Predicted chance on versicolor"
myxmin=apply(mydata[,-indy],2,min)
myxmax=apply(mydata[,-indy],2,max)
shinyServer(function(input, output, clientData, session) {
# define user specific objects here: same for all sessions of one user
coloroptions <- eventReactive(input$analyse, {
coloroptions <- switch(input$coloroptions,
"Rainbow" = 1,
"Sequential" = 2,
"Diverging" = 3,
"Black-White" = 4,
"Viridis" = 5)
})
kernel <- eventReactive(input$analyse, {
kernel <- switch(input$kernel,
"linear"="linear",
"polynomial"="poly",
"RBF"="rbf")
})
zerolevel <- eventReactive(input$analyse, {
zerolevel <- input$zerolevel
})
obs <- eventReactive(input$analyse, {
validate(
need(input$sl != "", "Please specify the sepal length."),
need(input$sw != "", "Please specify the sepal width."),
need(input$pl != "", "Please specify the petal length."),
need(input$pw != "", "Please specify the petal width.")
)
obs=data.frame(SL=input$sl,SW=input$sw,PL=input$pl,PW=input$pw)
})
xmin <- eventReactive(input$analyse, {
temp=myxmin
temp[1]=input$slRange[1]
temp[2]=input$swRange[1]
temp[3]=input$plRange[1]
temp[4]=input$pwRange[1]
temp
})
xmax <- eventReactive(input$analyse, {
temp=myxmax
temp[1]=input$slRange[2]
temp[2]=input$swRange[2]
temp[3]=input$plRange[2]
temp[4]=input$pwRange[2]
temp
})
output$value<- eventReactive(input$godisclaimer, {
# reset tab to disclaimer
updateNavbarPage(session, "righttabs", selected = "Disclaimer")
""
})
pars <- eventReactive(input$analyse, {
pars <- switch(input$kernel,
"linear"=c(input$par_1),
"RBF"=c(input$par_1,input$par_2),
"polynomial"=c(input$par_1,input$par_2,input$par_3))
})
output$input_ui <- renderUI({
num <- switch(input$kernel,
"linear"=1,
"RBF"=2,
"polynomial"=3)
names <- switch(input$kernel,
"linear"=c("regularization constant"),
"RBF"=c("regularization constant","inverse kernel width"),
"polynomial"=c("regularization constant","scale","degree"))
value <- switch(input$kernel,
"linear"=c(1),
"RBF"=c(myC,mysig),
"polynomial"=c(1,1,2))
lapply(1:num, function(i) {
numericInput(paste0("par_", i), label = names[i], value = value[i])
}
)
})
mymodel<- eventReactive(input$analyse, {
if (input$accepted == FALSE)
return()
# reset tab to colplot
updateNavbarPage(session, "righttabs", selected = "Colorplot")
withProgress(message = 'Making plot', value = 0, {
# train the model
set.seed(100)
if(kernel()=="rbf"){
model <-ksvm(y ~ ., data = mydata,prob.model=TRUE,
kpar=list(pars()[2]),
C=pars()[1])
} else if (kernel()=="poly"){
if (!pars()[3]==round(pars()[3]) | pars()[3]<0) {
stop("The degree of the polynomial kernel should be a positive integer.")
}
model <-ksvm(y ~ ., data = mydata,prob.model=TRUE,kernel="polydot",
kpar=list(degree=pars()[3], scale=pars()[2], offset=1),
C=pars()[1])
} else if (kernel()=="linear"){
model <-ksvm(y ~ ., data = mydata,prob.model=TRUE,kernel="polydot",
kpar=list(degree=1, scale=1, offset=0),
C=pars()[1])
}
# from model to list to be able to plot
tempmodel=preplotperf(model,mydata,indy,zerolevel=zerolevel(),risklabel=risklabel,adverse=FALSE)
colplot(tempmodel, zerolevel=zerolevel(),filename="colplot",coloroptions=coloroptions(),
risklabel=risklabel,obs=obs(),xmin=xmin(),xmax=xmax())
cchart(tempmodel,obs=obs(),filename="cchart", zerolevel=zerolevel(),
risklabel=risklabel,xmin=xmin(),xmax=xmax())
ccchart(tempmodel,obs=obs(),filename="ccchart", zerolevel=zerolevel(),
risklabel=risklabel,xmin=xmin(),xmax=xmax())
plotperf(tempmodel,mydata, indy=indy)
# Increment the progress bar, and update the detail text.
incProgress(1, detail = paste("Done"))
})
return<-list(tempmodel,1)
})
output$image <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "colplot.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 700,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$cchart <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "cchart.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 560,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$ccchart <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "ccchart.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$lp <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "lps.png",
contentType = "image/png",
width = input$GetScreenWidth/4,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$lp2 <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "lps.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$p <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "probs.png",
contentType = "image/png",
width = input$GetScreenWidth/4,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$p2 <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "probs.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$outcomes <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "outcomes.png",
contentType = "image/png",
width = input$GetScreenWidth/4,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$outcomes2 <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "outcomes.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$contributions <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "contributions2.png",
contentType = "image/png",
width = input$GetScreenWidth/4,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$contributions2 <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "contributions2.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$roc <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "ROC.png",
contentType = "image/png",
width = input$GetScreenWidth/4,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$roc2 <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "ROC.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$correlations <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "corrplot.png",
contentType = "image/png",
width = input$GetScreenWidth/4,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$correlations2 <- renderImage({
mymodel()
if (sum(mymodel()[[2]]) == 0){
list(src = "www/empty.png",
contentType = "image/png",
width = "0",
# height = 700,
alt = "Error: Unable to display plot!")
} else {
# Return a list containing information about the image
list(src = "corrplot.png",
contentType = "image/png",
width = input$GetScreenWidth/3,
# height = 900,
alt = "Error: Unable to display plot!")
}
}, deleteFile = FALSE)
output$acctrainSVM <- renderText({
mymodel()[[1]]$acctrainSVM
})
output$acctrainAPPROX <- renderText({
mymodel()[[1]]$acctrainAPPROX
})
output$myaccwrtSVMtrain <- renderText({
mymodel()[[1]]$myaccwrtSVMtrain
})
output$corrtable <- renderTable({
cor(cbind(mymodel()[[1]]$fall))
})
output$temp <- renderText({
if (sum(mymodel()[[2]]) == 0){
updateNavbarPage(session, "righttabs", selected = "Disclaimer")
return("Disclaimer needs to be accepted before calculations can proceed.")
} else{
return("")
}
})
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.