pipi

Assign10/.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

Assign10/Assignment10.Rproj

@@ -0,0 +1,13 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX

Assign10/global.R

@@ -0,0 +1,21 @@
+library(xgboost)
+library(tidyverse)
+
+DiamondClass <-xgb.load("iris.model")
+load("SpeciesClassInfo.rda")
+
+
+generatePreds<- function (Sepal_length = 5,Sepal_width = 3, Petal_length = 1, Petal_width = 1){
+
+  testDF<- as.matrix(Sepal_length,Sepal_width, Petal_length, Petal_width)
+
+
+
+  preds<- predict(SpeciesClass, as.matrix(testDF))
+
+  data.frame(
+    Species = SpeciesClassInfo$var.levels
+    , preds
+  )%>%
+    arrange(desc(preds))
+}

Assign10/model.R

@@ -0,0 +1,72 @@
+library(xgboost)
+library(mlogit)
+library(tidyverse)
+library(data.table)
+library(DT)
+
+Iris<-iris
+
+
+y1<- Iris$Species
+var.levels <- levels(y1)
+y = as.numeric(y1) -1 
+
+
+noOutcome<-Iris[,-5]
+
+x = noOutcome[,c( 'Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width')]
+var.names <- names(noOutcome)
+
+
+x = as.matrix(x)
+
+
+params <-list(
+  "objective" = "multi:softprob"
+  ,"eval_metric" = "mlogloss"
+  , "num_class" = length(table(y))
+  , "eta" = .5
+  , "max_depth" = 3
+  , "nthread" = 8
+)
+
+cv.nround = 250
+
+bst.cv <- xgb.cv(param = params, data = x, label = y, nfold = 5, nrounds = cv.nround
+                 ,missing = NA, prediction = TRUE)
+
+nrounds= which.min(bst.cv$evaluation_log$test_mlogloss_mean)
+bst.cv$evaluation_log[nrounds,]
+
+SpeciesClass<- xgboost(param = params, data = x, label = y,  nrounds = cv.nround
+                       ,missing = NA)
+
+xgb.importance(var.names, model = SpeciesClass)
+xgb.save(SpeciesClass, "iris.model")
+
+SpeciesClassInfo<-list(
+  var.names = var.names,
+  var.levels = var.levels
+)
+save(SpeciesClassInfo, file= "SpeciesClassInfo.rda")
+
+
+
+generatePreds<- function(Sepal_length = 5,Sepal_width = 3, Petal_length = 1, Petal_width = 1){
+
+  testDF<- as.matrix(Sepal_length,Sepal_width, Petal_length, Petal_width)
+}
+
+
+preds<- predict(SpeciesClass, as.matrix(Iris$Sepal.Length, Iris$Sepal.Width))
+
+
+data.frame(
+  Species = var.levels
+  , preds
+)%>%
+  arrange(desc(preds))
+
+
+
+

Assign10/rsconnect/shinyapps.io/nuzhatazra/Assignment10.dcf

@@ -0,0 +1,12 @@
+name: Assignment10
+title: Assignment10
+username:
+account: nuzhatazra
+server: shinyapps.io
+hostUrl: https://api.shinyapps.io/v1
+appId: 336179
+bundleId: 1352542
+url: https://nuzhatazra.shinyapps.io/Assignment10/
+when: 1525299537.35621
+asMultiple: FALSE
+asStatic: FALSE

Assign10/server.R

@@ -0,0 +1,46 @@
+server<-function(input, output){
+
+  Preds<-reactive({
+    generatePreds(
+      Sepal_length = input$Sepal_length,
+      Sepal_width = input$Sepal_width,
+      Petal_length =  input$Petal_length,
+      Petal_width =  input$Petal_width
+      )
+  })
+
+  # formatPercentage= function(columns, digits) {
+  #   round(columns,digits)
+  # }
+
+  output$pred_table <- DT::renderDataTable({
+    Preds() 
+      # datatable()%>%
+      # formatPercentage(columns= 'preds', digits =2)
+  }
+
+  )
+
+  output$ScatterPlot <- renderPlot({
+    ggplot(data=iris, aes(x = Sepal.Length, y = Sepal.Width))  + geom_point(aes(color=Species, shape=Species)) +
+      xlab("Sepal Length") +  ylab("Sepal Width") +
+      ggtitle("Sepal Length-Width")
+  })
+
+  output$DensityPlot1 <- renderPlot({
+    ggplot(data=iris, aes(x=Sepal.Length, fill=Species))+geom_density(stat="density", alpha=I(0.2)) +
+      xlab("Sepal Length") +  ylab("Density") + ggtitle("Density Curve of Sepal Length")
+  })
+  output$DensityPlot2 <- renderPlot({
+    ggplot(data=iris, aes(x=Sepal.Width, fill=Species))+geom_density(stat="density", alpha=I(0.2)) +
+      xlab("Sepal Width") +  ylab("Density") + ggtitle("Density Curve of Sepal Width")
+  })
+  output$DensityPlot3 <- renderPlot({
+    ggplot(data=iris, aes(x=Petal.Length, fill=Species))+geom_density(stat="density", alpha=I(0.2)) +
+      xlab("Petal Length") +  ylab("Density") + ggtitle("Density Curve of Petal Length")
+  })
+  output$DensityPlot4 <- renderPlot({
+    ggplot(data=iris, aes(x=Petal.Width, fill=Species))+geom_density(stat="density", alpha=I(0.2)) +
+      xlab("Petal Width") +  ylab("Density") + ggtitle("Density Curve of Petal Width")
+  })
+}

Assign10/ui.R

@@ -0,0 +1,24 @@
+ui <-fluidPage(
+  titlePanel("Predicting Species"),
+  sidebarLayout(
+    sidebarPanel(
+      sliderInput("Sepal_length", label = "Sepal_length:", value = 5.1, min = 0, max =10, step =.1)
+      ,sliderInput("Sepal_width", "Sepal_width", value = 3.2,
+                    min = 0, max = 5, step = .5)
+      ,sliderInput("Petal_length", "Petal_length", value = 1.2,
+                    min = 0, max = 5, step = .1)
+      ,sliderInput("Petal_width", "Petal_width", value = 1.2,
+                    min = 0, max = 5, step = .1)
+
+    ),
+
+  mainPanel(
+    DT::dataTableOutput("pred_table"),
+    plotOutput("ScatterPlot"),
+    plotOutput("DensityPlot1"),
+    plotOutput("DensityPlot2"),
+    plotOutput("DensityPlot3"),
+    plotOutput("DensityPlot4")
+  )
+)
+)

Assignment 10/.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

Assignment 10/Assignment 10.Rproj

@@ -0,0 +1,13 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX

Assignment 10/global.R

@@ -0,0 +1,21 @@
+library(xgboost)
+library(tidyverse)
+
+DiamondClass <-xgb.load("iris.model")
+load("SpeciesClassInfo.rda")
+
+
+generatePreds<- function (Sepal_length = 5,Sepal_width = 3, Petal_length = 1, Petal_width = 1){
+
+  testDF<- as.matrix(Sepal_length,Sepal_width, Petal_length, Petal_width)
+
+
+
+  preds<- predict(SpeciesClass, as.matrix(testDF))
+
+  data.frame(
+    Species = SpeciesClassInfo$var.levels
+    , preds
+  )%>%
+    arrange(desc(preds))
+}

Assignment 10/model.R

@@ -0,0 +1,73 @@
+library(xgboost)
+library(mlogit)
+library(tidyverse)
+library(data.table)
+library(DT)
+
+Iris<-iris
+
+
+y1<- Iris$Species
+var.levels <- levels(y1)
+y = as.numeric(y1) -1 
+
+
+noOutcome<-Iris[,-5]
+
+x = noOutcome[,c( 'Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width')]
+var.names <- names(noOutcome)
+
+
+x = as.matrix(x)
+
+
+params <-list(
+  "objective" = "multi:softprob"
+  ,"eval_metric" = "mlogloss"
+  , "num_class" = length(table(y))
+  , "eta" = .5
+  , "max_depth" = 3
+  , "nthread" = 8
+)
+
+cv.nround = 250
+
+bst.cv <- xgb.cv(param = params, data = x, label = y, nfold = 5, nrounds = cv.nround
+                 ,missing = NA, prediction = TRUE)
+
+nrounds= which.min(bst.cv$evaluation_log$test_mlogloss_mean)
+bst.cv$evaluation_log[nrounds,]
+
+SpeciesClass<- xgboost(param = params, data = x, label = y,  nrounds = cv.nround
+                       ,missing = NA)
+
+xgb.importance(var.names, model = SpeciesClass)
+
+xgb.save(SpeciesClass, "iris.model")
+
+SpeciesClassInfo<-list(
+  var.names = var.names,
+  var.levels = var.levels
+)
+save(SpeciesClassInfo, file= "SpeciesClassInfo.rda")
+
+
+
+generatePreds<- function(Sepal_length = 5,Sepal_width = 3, Petal_length = 1, Petal_width = 1){
+
+  testDF<- as.matrix(Sepal_length,Sepal_width, Petal_length, Petal_width)
+}
+
+
+preds<- predict(SpeciesClass, as.matrix(Iris$Sepal.Length, Iris$Sepal.Width))
+
+
+data.frame(
+  Species = var.levels
+  , preds
+)%>%
+  arrange(desc(preds))
+
+
+
+

Assignment 10/server.R

@@ -0,0 +1,24 @@
+server<-function(input, output){
+
+  Preds<-reactive({
+    generatePreds(
+      Sepal_length = input$Sepal_length,
+      Sepal_width = input$Sepal_width,
+      Petal_length =  input$Petal_length,
+      Petal_width =  input$Petal_width
+      )
+  })
+
+  # formatPercentage= function(columns, digits) {
+  #   round(columns,digits)
+  # }
+
+  output$pred_table <- DT::renderDataTable({
+    Preds() 
+      # datatable()%>%
+      # formatPercentage(columns= 'preds', digits =2)
+  }
+
+  )
+
+}

Assignment 10/ui.R

@@ -0,0 +1,18 @@
+ui <-fluidPage(
+  titlePanel("Predicting Species"),
+  sidebarLayout(
+    sidebarPanel(
+      sliderInput("Sepal_length", label = "Sepal_length:", value = 5.1, min = 0, max =10, step =.1)
+      ,sliderInput("Sepal_width", "Sepal_width", value = 3.2,
+                    min = 0, max = 5, step = .5)
+      ,sliderInput("Petal_length", "Petal_length", value = 1.2,
+                    min = 0, max = 5, step = .1)
+      ,sliderInput("Petal_width", "Petal_width", value = 1.2,
+                    min = 0, max = 5, step = .1)
+
+    ),
+    mainPanel(
+      DT::dataTableOutput("pred_table")
+    )
+  )
+)