MDS and PCA"

Here Metric Multi-dimensional Scaling and Principal Component Analysis are implemented. One can also understand the difference between these techniques and also the connection between them easily

knitr::opts_chunk$set(echo = TRUE)
library(MASS)
library(psych)
library(dplyr)
sidebarPanel(

     checkboxInput("ex","Uncheck for using your own file",value = TRUE),
  fileInput("file", "Upload the *.csv file with headers"),
  selectInput("tech","Choose MDS or PCA",choices = c("MDS","PCA"),selected = "MDS"),
  uiOutput("vx"),
   uiOutput("vy"),

   uiOutput("nf"),

    uiOutput("rot"),

   uiOutput("dd"),

  downloadButton("downloadPlot", "Download Plot") 


)


mainPanel(
  tabsetPanel(type = "tab",
                tabPanel("Visual", plotOutput("mds") ),
                tabPanel("Summary",verbatimTextOutput("pca"))
                ),
  h6("", tags$img(src ="K.JPG", height= 400, width=400))


)

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()}

     }

  ds = data
   if(input$tech == "PCA")
   {ds = select_if(ds,is.numeric)}

     checkboxGroupInput("variablex","Select the variables",choices = colnames(ds),selected = colnames(ds))



  })

output$mds<-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()}

     } 
    ds = data

    if(input$tech == "MDS")
 { ds = select(ds,input$variablex)
  mydata = ds
  d = dist(mydata)
  fit = cmdscale(d,eig = TRUE,k=2)
  x = fit$points[,1]
  y = fit$points[,2]
  plot(x,y)
  attach(mydata)
  text(x,y,labels = get(input$variabley),cex = 0.9)
    }
    if(input$tech == "PCA")
    {

      ds = select(ds,input$variablex)
  dataframe = ds
      pc= principal(scale(dataframe),nfactors = as.numeric(input$n_factors),rotate = input$rotation)
    plot(pc)
    }


})

output$pca<-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()}

     } 
    ds = data

    if(input$tech == "MDS")
 { ds = select(ds,input$variablex)
  mydata = ds
  d = dist(mydata)
  fit = cmdscale(d,eig = TRUE,k=2)
  print(summary(fit))
  print(fit)
    }
    if(input$tech == "PCA")
    {

      ds = select(ds,input$variablex)
  dataframe = ds
      pc= principal(scale(dataframe),nfactors = as.numeric(input$n_factors),rotate = input$rotation)
     print(summary(pc))
     print(pc)
    }


})

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()}
     }
    ds = data
    if(input$tech == "MDS")
 {   ds = select_if(ds,is.factor)

    selectInput("variabley","Select the qualitative variable to be mapped",choices = colnames(ds),selected = "" )

}
  })


output$nf <- 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()}

     }

  ds = data
   if(input$tech == "PCA")
   {ds = select(ds,input$variablex)

     sliderInput("n_factors", label = "Enter the number of factors/components:",
              min = 1, max = NCOL(ds), value = 2, step = 1)

   }
  })

output$rot <- 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()}

     }

  ds = data
   if(input$tech == "PCA")
   {ds = select(ds,input$variablex)

    selectInput("rotation", label = "Select the rotaton type for PCA:",
              choices = c("none","varimax","oblimin","Promax"), selected = "varimax")
   }
  })

output$dd <- 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()}

     }

  ds = data
   if(input$tech == "PCA")
   {ds = select(ds,input$variablex)

    downloadButton("downloaddata", "Download PCAData")
   }
  })

output$downloadPlot<- downloadHandler(
    filename = function() {

      if(input$tech == "PCA")
    {  paste("PCAplot", ".png", sep = "")}
      else
     { paste("MDSplot", ".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()}

     } 
    ds = data

    if(input$tech == "MDS")
 { ds = select(ds,input$variablex)
  mydata = ds
  d = dist(mydata)
  fit = cmdscale(d,eig = TRUE,k=2)
  x = fit$points[,1]
  y = fit$points[,2]
  plot(x,y)
  attach(mydata)
  text(x,y,labels = get(input$variabley),cex = 0.9)
    }
  else
    {

      ds = select(ds,input$variablex)
  dataframe = ds
      pc= principal(scale(dataframe),nfactors = as.numeric(input$n_factors),rotate = input$rotation)
    plot(pc)
    }

      dev.off()
    })


datasetInput1 <- reactive({

    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()}
     }

     ds = data

    dataframe = select(ds,input$variablex)
     pc= principal(scale(dataframe),nfactors = as.numeric(input$n_factors),rotate= input$rotation,scores = TRUE)
ds2= data.frame(pc$scores)
 ds = cbind(ds,ds2)
 ds = ds



})
output$downloaddata <- downloadHandler(
    filename = function() {
      filetitle = paste("dataset")
      paste(filetitle, ".csv", sep = "")
    },
    content = function(file) {

      write.csv(datasetInput1(), file, row.names = FALSE)
    }
  )


Try the MDSPCAShiny package in your browser

Any scripts or data that you put into this service are public.

MDSPCAShiny documentation built on May 24, 2019, 9:02 a.m.