STAT651_MIDTERM
BK
2022-11-30
###1
1 Non interactive onluy plot
library(shiny)## Warning: package 'shiny' was built under R version 4.1.3library(pheatmap)## Warning: package 'pheatmap' was built under R version 4.1.3ui = fluidPage("Test",
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE)
),
tabPanel('map',
sidebarLayout(
sidebarPanel('side',
actionButton('getHmap', 'get heatmap')
),
mainPanel('main',
plotOutput("themap"),
tableOutput("table.output")
)
))
)
server = function(input, output, session) {
a <- reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
tbl <- read.csv(inFile$datapath, header=input$header) #, sep=input$sep, dec = input$dec)
return(tbl)
})
output$table.output <- renderTable({
a()
})
plotdata <- eventReactive(input$getHmap, {
a <- as.matrix(a()[-1])
row.names(a) <- a()$Name
a[is.na(a)] <- 0
a
})
output$themap = renderPlot({
pheatmap(plotdata())
})
}
shinyApp(ui, server)## PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.Shiny applications not supported in static R Markdown documents
###Final3.csv###1 Working
if (!requireNamespace("BiocManager", quietly=TRUE))
install.packages("BiocManager")
BiocManager::install("InteractiveComplexHeatmap")## Bioconductor version 3.14 (BiocManager 1.30.19), R 4.1.2 (2021-11-01)## Warning: package(s) not installed when version(s) same as or greater than current; use
## `force = TRUE` to re-install: 'InteractiveComplexHeatmap'## Installation paths not writeable, unable to update packages
## path: C:/Program Files/R/R-4.1.2/library
## packages:
## arm, boot, brew, bslib, callr, class, cli, clipr, cluster, colorspace,
## colourpicker, commonmark, cpp11, crayon, curl, data.table, dbplyr, desc,
## devtools, digest, dplyr, dtplyr, emmeans, evaluate, Exact, fansi, farver,
## fontawesome, forcats, foreign, gargle, generics, gert, ggExtra, ggplot2,
## gh, gitcreds, gld, glue, googlesheets4, gtable, haven, Hmisc, hms,
## htmlTable, htmltools, httpuv, httr, isoband, jpeg, knitr, latticeExtra,
## lifecycle, lmom, lubridate, magrittr, mapdata, mapproj, maps, markdown,
## Matrix, mgcv, mice, modelr, nlme, nnet, openintro, openssl, pillar,
## pkgbuild, pkgload, png, processx, ps, purrr, randomForest, RColorBrewer,
## readr, readxl, reprex, rlang, rmarkdown, roxygen2, rpart, rprojroot,
## rstudioapi, rversions, rvest, scales, shiny, spatial, stringi, stringr,
## survival, sys, testthat, tibble, tidyselect, tidyverse, tinytex, tzdb,
## usethis, vctrs, viridisLite, vroom, waldo, withr, yaml, zip## Old packages: 'bit', 'jsonlite', 'lme4', 'MASS', 'minqa', 'nloptr', 'plyr',
## 'sass', 'xfun', 'XML'library(devtools)## Loading required package: usethisinstall_github("jokergoo/InteractiveComplexHeatmap")## Downloading GitHub repo jokergoo/InteractiveComplexHeatmap@HEAD## jsonlite (1.8.2 -> 1.8.3) [CRAN]
## sass (0.4.2 -> 0.4.4) [CRAN]
## xfun (0.34 -> 0.35 ) [CRAN]## Installing 3 packages: jsonlite, sass, xfun## Installing packages into 'C:/Users/charan/Documents/R/win-library/4.1'
## (as 'lib' is unspecified)## package 'jsonlite' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'jsonlite'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\charan\Documents\R\win-library\4.1\00LOCK\jsonlite\libs\x64\jsonlite.dll
## to C:\Users\charan\Documents\R\win-library\4.1\jsonlite\libs\x64\jsonlite.dll:
## Permission denied## Warning: restored 'jsonlite'## package 'sass' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'sass'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\charan\Documents\R\win-library\4.1\00LOCK\sass\libs\x64\sass.dll to
## C:\Users\charan\Documents\R\win-library\4.1\sass\libs\x64\sass.dll: Permission
## denied## Warning: restored 'sass'## package 'xfun' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'xfun'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\charan\Documents\R\win-library\4.1\00LOCK\xfun\libs\x64\xfun.dll to
## C:\Users\charan\Documents\R\win-library\4.1\xfun\libs\x64\xfun.dll: Permission
## denied## Warning: restored 'xfun'##
## The downloaded binary packages are in
## C:\Users\charan\AppData\Local\Temp\Rtmp2TVQK8\downloaded_packages
##
checking for file 'C:\Users\charan\AppData\Local\Temp\Rtmp2TVQK8\remotes7bc8e621e73\jokergoo-InteractiveComplexHeatmap-d44d285/DESCRIPTION' ...
v checking for file 'C:\Users\charan\AppData\Local\Temp\Rtmp2TVQK8\remotes7bc8e621e73\jokergoo-InteractiveComplexHeatmap-d44d285/DESCRIPTION'
##
- preparing 'InteractiveComplexHeatmap': (1.6s)
## checking DESCRIPTION meta-information ...
checking DESCRIPTION meta-information ...
v checking DESCRIPTION meta-information
##
- checking for LF line-endings in source and make files and shell scripts
##
- checking for empty or unneeded directories
##
- looking to see if a 'data/datalist' file should be added
##
- building 'InteractiveComplexHeatmap_1.5.2.tar.gz'
##
## ## Installing package into 'C:/Users/charan/Documents/R/win-library/4.1'
## (as 'lib' is unspecified)## Warning in i.p(...): installation of package
## 'C:/Users/charan/AppData/Local/Temp/Rtmp2TVQK8/file7bc8657568f/InteractiveComplexHeatmap_1.5.2.tar.gz'
## had non-zero exit statuslibrary(ComplexHeatmap)## Loading required package: grid## ========================================
## ComplexHeatmap version 2.10.0
## Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
## Github page: https://github.com/jokergoo/ComplexHeatmap
## Documentation: http://jokergoo.github.io/ComplexHeatmap-reference
##
## If you use it in published research, please cite:
## Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional
## genomic data. Bioinformatics 2016.
##
## The new InteractiveComplexHeatmap package can directly export static
## complex heatmaps into an interactive Shiny app with zero effort. Have a try!
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(ComplexHeatmap))
## ========================================
## ! pheatmap() has been masked by ComplexHeatmap::pheatmap(). Most of the arguments
## in the original pheatmap() are identically supported in the new function. You
## can still use the original function by explicitly calling pheatmap::pheatmap().##
## Attaching package: 'ComplexHeatmap'## The following object is masked from 'package:pheatmap':
##
## pheatmaplibrary(InteractiveComplexHeatmap)
m = matrix(rnorm(100*100), nrow = 100)
ht = Heatmap(m)
ht = draw(ht) # not necessary, but recommended
htShiny(ht)Shiny applications not supported in static R Markdown documents
###1 In Base R
library(wesanderson)## Warning: package 'wesanderson' was built under R version 4.1.3library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.1.3# Discrete color
bp <- ggplot(iris, aes(Species, Sepal.Length))
bp + scale_fill_manual(values = wes_palette("GrandBudapest1", n = 3))
# Gradient color
pal <- wes_palette("Zissou1", 100, type = "continuous")
ggplot(heatmap, aes(x = X2, y = X1, fill = value)) +
geom_tile() +
scale_fill_gradientn(colours = pal) +
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
coord_equal() 
###1 IN Base R
df <- scale(mtcars)
heatmap(df, scale = "none")
col<- colorRampPalette(c("red", "white", "blue"))(256)
library("RColorBrewer")## Warning: package 'RColorBrewer' was built under R version 4.1.3col <- colorRampPalette(brewer.pal(10, "RdYlBu"))(256)
heatmap(df, scale = "none", col = col,
RowSideColors = rep(c("blue", "pink"), each = 16),
ColSideColors = c(rep("purple", 5), rep("orange", 6)))
library("gplots")## Warning: package 'gplots' was built under R version 4.1.3##
## Attaching package: 'gplots'## The following object is masked from 'package:stats':
##
## lowessheatmap.2(df, scale = "none", col = bluered(100),
trace = "none", density.info = "none")
library("pheatmap")
pheatmap(df, cutree_rows = 4)
###2
# Load packages
library(shiny)
library(shinythemes)## Warning: package 'shinythemes' was built under R version 4.1.3library(dplyr)## Warning: package 'dplyr' was built under R version 4.1.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(readr)
# Load data
trend_data <- read_csv("D:/charan/Documents/FIFA 18/STAT651/trend_data.csv")## Rows: 454 Columns: 3## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (1): type
## dbl (1): close
## dttm (1): date
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.trend_description <- read_csv("D:/charan/Documents/FIFA 18/STAT651/trend_description.csv")## Rows: 5 Columns: 2
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (2): type, text
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.# Define UI
ui <- fluidPage(theme = shinytheme("lumen"),
titlePanel("Google Trend Index"),
sidebarLayout(
sidebarPanel(
# Select type of trend to plot
selectInput(inputId = "type", label = strong("Trend index"),
choices = unique(trend_data$type),
selected = "Travel"),
# Select date range to be plotted
dateRangeInput("date", strong("Date range"), start = "2007-01-01", end = "2017-07-31",
min = "2007-01-01", max = "2017-07-31"),
# Select whether to overlay smooth trend line
checkboxInput(inputId = "smoother", label = strong("Overlay smooth trend line"), value = FALSE),
# Display only if the smoother is checked
conditionalPanel(condition = "input.smoother == true",
sliderInput(inputId = "f", label = "Smoother span:",
min = 0.01, max = 1, value = 0.67, step = 0.01,
animate = animationOptions(interval = 100)),
HTML("Higher values give more smoothness.")
)
),
# Output: Description, lineplot, and reference
mainPanel(
plotOutput(outputId = "lineplot", height = "300px"),
textOutput(outputId = "desc"),
tags$a(href = "https://www.google.com/finance/domestic_trends", "Source: Google Domestic Trends", target = "_blank")
)
)
)
# Define server function
server <- function(input, output) {
# Subset data
selected_trends <- reactive({
req(input$date)
shiny::validate(need(!is.na(input$date[1]) & !is.na(input$date[2]), "Error: Please provide both a start and an end date."))
shiny::validate(need(input$date[1] < input$date[2], "Error: Start date should be earlier than end date."))
trend_data %>%
filter(
type == input$type,
date > as.POSIXct(input$date[1]) & date < as.POSIXct(input$date[2]
))
})
# Create scatterplot object the plotOutput function is expecting
output$lineplot <- renderPlot({
color = "#434343"
par(mar = c(4, 4, 1, 1))
plot(x = selected_trends()$date, y = selected_trends()$close, type = "l",
xlab = "Date", ylab = "Trend index", col = color, fg = color, col.lab = color, col.axis = color)
# Display only if smoother is checked
if(input$smoother){
smooth_curve <- lowess(x = as.numeric(selected_trends()$date), y = selected_trends()$close, f = input$f)
lines(smooth_curve, col = "#E6553A", lwd = 3)
}
})
# Pull in description of trend
output$desc <- renderText({
trend_text <- filter(trend_description, type == input$type) %>% pull(text)
paste(trend_text, "The index is set to 1.0 on January 1, 2004 and is calculated only for US search traffic.")
})
}
# Create Shiny object
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents