…
2024-12-09
# Install shiny (if not already installed)
if (!requireNamespace("shiny", quietly = TRUE)) {
install.packages("shiny")
}
library(shiny)## Warning: package 'shiny' was built under R version 4.3.3## starting httpd help server ... done## No vignettes found by browseVignettes("shiny")## [1] "a" "absolutePanel"
## [3] "actionButton" "actionLink"
## [5] "addResourcePath" "animationOptions"
## [7] "appendTab" "as.shiny.appobj"
## [9] "basicPage" "bindCache"
## [11] "bindEvent" "bookmarkButton"
## [13] "bootstrapLib" "bootstrapPage"
## [15] "br" "browserViewer"
## [17] "brushedPoints" "brushOpts"
## [19] "busyIndicatorOptions" "callModule"
## [21] "captureStackTraces" "checkboxGroupInput"
## [23] "checkboxInput" "clickOpts"
## [25] "code" "column"
## [27] "conditionalPanel" "conditionStackTrace"
## [29] "conditionStackTrace<-" "createRenderFunction"
## [31] "createWebDependency" "dataTableOutput"
## [33] "dateInput" "dateRangeInput"
## [35] "dblclickOpts" "debounce"
## [37] "devmode" "dialogViewer"
## [39] "diskCache" "div"
## [41] "downloadButton" "downloadHandler"
## [43] "downloadLink" "em"
## [45] "enableBookmarking" "eventReactive"
## [47] "exportTestValues" "exprToFunction"
## [49] "ExtendedTask" "fileInput"
## [51] "fillCol" "fillPage"
## [53] "fillRow" "fixedPage"
## [55] "fixedPanel" "fixedRow"
## [57] "flowLayout" "fluidPage"
## [59] "fluidRow" "freezeReactiveVal"
## [61] "freezeReactiveValue" "get_devmode_option"
## [63] "getCurrentOutputInfo" "getCurrentTheme"
## [65] "getDefaultReactiveDomain" "getQueryString"
## [67] "getShinyOption" "getUrlHash"
## [69] "h1" "h2"
## [71] "h3" "h4"
## [73] "h5" "h6"
## [75] "headerPanel" "helpText"
## [77] "hideTab" "hoverOpts"
## [79] "hr" "HTML"
## [81] "htmlOutput" "htmlTemplate"
## [83] "httpResponse" "icon"
## [85] "imageOutput" "img"
## [87] "in_devmode" "includeCSS"
## [89] "includeHTML" "includeMarkdown"
## [91] "includeScript" "includeText"
## [93] "incProgress" "inputPanel"
## [95] "insertTab" "insertUI"
## [97] "installExprFunction" "invalidateLater"
## [99] "is.key_missing" "is.reactive"
## [101] "is.reactivevalues" "is.shiny.appobj"
## [103] "is.singleton" "isolate"
## [105] "isRunning" "isTruthy"
## [107] "key_missing" "loadSupport"
## [109] "mainPanel" "makeReactiveBinding"
## [111] "markdown" "markRenderFunction"
## [113] "maskReactiveContext" "memoryCache"
## [115] "MockShinySession" "modalButton"
## [117] "modalDialog" "moduleServer"
## [119] "navbarMenu" "navbarPage"
## [121] "navlistPanel" "nearPoints"
## [123] "need" "NS"
## [125] "ns.sep" "numericInput"
## [127] "observe" "observeEvent"
## [129] "onBookmark" "onBookmarked"
## [131] "onFlush" "onFlushed"
## [133] "onReactiveDomainEnded" "onRestore"
## [135] "onRestored" "onSessionEnded"
## [137] "onStop" "onUnhandledError"
## [139] "outputOptions" "p"
## [141] "pageWithSidebar" "paneViewer"
## [143] "parseQueryString" "passwordInput"
## [145] "plotOutput" "plotPNG"
## [147] "pre" "prependTab"
## [149] "printError" "printStackTrace"
## [151] "Progress" "quoToFunction"
## [153] "radioButtons" "reactive"
## [155] "reactiveConsole" "reactiveFileReader"
## [157] "reactivePoll" "reactiveTimer"
## [159] "reactiveVal" "reactiveValues"
## [161] "reactiveValuesToList" "reactlog"
## [163] "reactlogAddMark" "reactlogReset"
## [165] "reactlogShow" "register_devmode_option"
## [167] "registerInputHandler" "registerThemeDependency"
## [169] "removeInputHandler" "removeModal"
## [171] "removeNotification" "removeResourcePath"
## [173] "removeTab" "removeUI"
## [175] "renderCachedPlot" "renderDataTable"
## [177] "renderImage" "renderPlot"
## [179] "renderPrint" "renderTable"
## [181] "renderText" "renderUI"
## [183] "repeatable" "req"
## [185] "resourcePaths" "restoreInput"
## [187] "runApp" "runExample"
## [189] "runGadget" "runGist"
## [191] "runGitHub" "runTests"
## [193] "runUrl" "safeError"
## [195] "selectInput" "selectizeInput"
## [197] "serverInfo" "setBookmarkExclude"
## [199] "setProgress" "setSerializer"
## [201] "shinyApp" "shinyAppDir"
## [203] "shinyAppFile" "shinyAppTemplate"
## [205] "shinyOptions" "shinyServer"
## [207] "shinyUI" "showBookmarkUrlModal"
## [209] "showModal" "showNotification"
## [211] "showTab" "sidebarLayout"
## [213] "sidebarPanel" "singleton"
## [215] "sizeGrowthRatio" "sliderInput"
## [217] "snapshotExclude" "snapshotPreprocessInput"
## [219] "snapshotPreprocessOutput" "span"
## [221] "splitLayout" "stopApp"
## [223] "strong" "submitButton"
## [225] "suppressDependencies" "tableOutput"
## [227] "tabPanel" "tabPanelBody"
## [229] "tabsetPanel" "tag"
## [231] "tagAppendAttributes" "tagAppendChild"
## [233] "tagAppendChildren" "tagGetAttribute"
## [235] "tagHasAttribute" "tagList"
## [237] "tags" "tagSetChildren"
## [239] "testServer" "textAreaInput"
## [241] "textInput" "textOutput"
## [243] "throttle" "titlePanel"
## [245] "uiOutput" "updateActionButton"
## [247] "updateActionLink" "updateCheckboxGroupInput"
## [249] "updateCheckboxInput" "updateDateInput"
## [251] "updateDateRangeInput" "updateNavbarPage"
## [253] "updateNavlistPanel" "updateNumericInput"
## [255] "updateQueryString" "updateRadioButtons"
## [257] "updateSelectInput" "updateSelectizeInput"
## [259] "updateSliderInput" "updateTabsetPanel"
## [261] "updateTextAreaInput" "updateTextInput"
## [263] "updateVarSelectInput" "updateVarSelectizeInput"
## [265] "urlModal" "useBusyIndicators"
## [267] "validate" "validateCssUnit"
## [269] "varSelectInput" "varSelectizeInput"
## [271] "verbatimTextOutput" "verticalLayout"
## [273] "wellPanel" "with_devmode"
## [275] "withLogErrors" "withMathJax"
## [277] "withProgress" "withReactiveDomain"
## [279] "withTags"## Valid examples in {shiny}: "01_hello", "02_text", "03_reactivity", "04_mpg", "05_sliders", "06_tabsets", "07_widgets", "08_html", "09_upload", "10_download", "11_timer"# app.R
library(shiny)
# Define UI
ui <- fluidPage(
titlePanel("Interactive Histogram"),
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "num",
label = "Choose Number of Points",
min = 10,
max = 1000,
value = 500
)
),
mainPanel(
plotOutput("histogram")
)
)
)
# Define Server
server <- function(input, output) {
output$histogram <- renderPlot({
hist(rnorm(input$num), main = "Histogram of Random Numbers", col = "steelblue", border = "white")
})
}
# Run the App
shinyApp(ui = ui, server = server)# Define Module UI
histogramModuleUI <- function(id) {
ns <- NS(id)
tagList(
sliderInput(ns("num"), "Number of Points", min = 10, max = 1000, value = 500),
plotOutput(ns("histogram"))
)
}
# Define Module Server
histogramModuleServer <- function(id) {
moduleServer(id, function(input, output, session) {
output$histogram <- renderPlot({
hist(rnorm(input$num), main = "Histogram of Random Numbers", col = "darkgreen", border = "white")
})
})
}library(shiny)
# Define UI
ui <- fluidPage(
titlePanel("Interactive Histogram with Modules"),
sidebarLayout(
sidebarPanel(),
mainPanel(
histogramModuleUI("hist1") # Add the custom module
)
)
)
# Define Server
server <- function(input, output, session) {
histogramModuleServer("hist1") # Use the custom module
}
# Run the App
shinyApp(ui = ui, server = server)#onclusion
# this exercise, we:
#Explored the shiny package and its documentation.
#Created a basic interactive app using shiny.
#Extended functionality by creating and applying a reusable custom module.
#This approach highlights the modularity and flexibility of shiny, making it ideal for building dynamic and scalable web applications.#Introduction
#In this exercise, we will explore the functionality of the caret package, create a machine learning model using its functions, and extend its functionality with a custom function. The caret package is part of the tidyverse ecosystem and is widely used for machine learning in R.# Install caret (if not already installed)
if (!requireNamespace("caret", quietly = TRUE)) {
install.packages("caret")
}
library(caret)## Warning: package 'caret' was built under R version 4.3.3## Loading required package: ggplot2## Loading required package: lattice## No documentation for 'caret' in specified packages and libraries:
## you could try '??caret'## [1] "anovaScores" "avNNet" "bag"
## [4] "bagControl" "bagEarth" "bagEarthStats"
## [7] "bagFDA" "best" "BoxCoxTrans"
## [10] "calibration" "caretFuncs" "caretGA"
## [13] "caretSA" "caretSBF" "caretTheme"
## [16] "cforestStats" "checkConditionalX" "checkInstall"
## [19] "checkResamples" "class2ind" "classDist"
## [22] "cluster" "compare_models" "confusionMatrix"
## [25] "confusionMatrix.train" "contr.dummy" "contr.ltfr"
## [28] "createDataPartition" "createFolds" "createModel"
## [31] "createMultiFolds" "createResample" "createTimeSlices"
## [34] "ctreeBag" "defaultSummary" "dotPlot"
## [37] "downSample" "dummyVars" "expandParameters"
## [40] "expoTrans" "extractPrediction" "extractProb"
## [43] "F_meas" "featurePlot" "filterVarImp"
## [46] "findCorrelation" "findLinearCombos" "flatTable"
## [49] "gafs" "gafs.default" "gafs_initial"
## [52] "gafs_lrSelection" "gafs_raMutation" "gafs_rwSelection"
## [55] "gafs_spCrossover" "gafs_tourSelection" "gafs_uCrossover"
## [58] "gafsControl" "gamFormula" "gamFuncs"
## [61] "gamScores" "getModelInfo" "getSamplingInfo"
## [64] "getTrainPerf" "ggplot.gafs" "ggplot.safs"
## [67] "groupKFold" "hasTerms" "icr"
## [70] "index2vec" "ipredStats" "knn3"
## [73] "knn3Train" "knnreg" "knnregTrain"
## [76] "ldaBag" "ldaFuncs" "ldaSBF"
## [79] "learning_curve_dat" "lift" "lmFuncs"
## [82] "lmSBF" "LPH07_1" "LPH07_2"
## [85] "lrFuncs" "MAE" "maxDissim"
## [88] "MeanSD" "minDiss" "mnLogLoss"
## [91] "modelCor" "modelLookup" "multiClassSummary"
## [94] "nbBag" "nbFuncs" "nbSBF"
## [97] "nearZeroVar" "negPredValue" "nnetBag"
## [100] "nullModel" "nzv" "oneSE"
## [103] "outcome_conversion" "panel.calibration" "panel.lift"
## [106] "panel.lift2" "panel.needle" "pcaNNet"
## [109] "pickSizeBest" "pickSizeTolerance" "pickVars"
## [112] "plot.gafs" "plot.rfe" "plot.safs"
## [115] "plot.train" "plotClassProbs" "plotObsVsPred"
## [118] "plsBag" "plsda" "posPredValue"
## [121] "postResample" "precision" "predict.bagEarth"
## [124] "predict.gafs" "predict.train" "predictionFunction"
## [127] "predictors" "preProcess" "print.train"
## [130] "probFunction" "progress" "prSummary"
## [133] "R2" "recall" "resampleHist"
## [136] "resamples" "resampleSummary" "resampleWrapper"
## [139] "rfe" "rfeControl" "rfeIter"
## [142] "rfFuncs" "rfGA" "rfSA"
## [145] "rfSBF" "rfStats" "RMSE"
## [148] "safs" "safs_initial" "safs_perturb"
## [151] "safs_prob" "safsControl" "sbf"
## [154] "sbfControl" "sbfIter" "sensitivity"
## [157] "SLC14_1" "SLC14_2" "sortImp"
## [160] "spatialSign" "specificity" "splsda"
## [163] "sumDiss" "summary.bagEarth" "svmBag"
## [166] "thresholder" "tolerance" "train"
## [169] "trainControl" "treebagFuncs" "treebagGA"
## [172] "treebagSA" "treebagSBF" "twoClassSim"
## [175] "twoClassSummary" "upSample" "var_seq"
## [178] "varImp" "well_numbered"# Split the dataset into training and testing sets
set.seed(123)
trainIndex <- createDataPartition(mtcars$mpg, p = 0.8, list = FALSE)
trainData <- mtcars[trainIndex, ]
testData <- mtcars[-trainIndex, ]
# Train a linear regression model
model <- train(
mpg ~ .,
data = trainData,
method = "lm"
)## Warning in predict.lm(modelFit, newdata): prediction from rank-deficient fit;
## attr(*, "non-estim") has doubtful cases##
## Call:
## lm(formula = .outcome ~ ., data = dat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.2742 -1.3609 -0.2707 1.1921 4.9877
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.81069 22.93545 -0.123 0.904
## cyl 0.75593 1.21576 0.622 0.542
## disp 0.01172 0.01674 0.700 0.494
## hp -0.01386 0.02197 -0.631 0.536
## drat 2.24007 1.77251 1.264 0.223
## wt -2.73273 1.87954 -1.454 0.164
## qsec 0.53957 0.71812 0.751 0.463
## vs 1.21640 2.02623 0.600 0.556
## am 1.73662 2.08358 0.833 0.416
## gear 2.95127 1.88459 1.566 0.136
## carb -1.19910 0.98232 -1.221 0.239
##
## Residual standard error: 2.431 on 17 degrees of freedom
## Multiple R-squared: 0.8861, Adjusted R-squared: 0.8191
## F-statistic: 13.23 on 10 and 17 DF, p-value: 3.719e-06# Predict on test data
predictions <- predict(model, testData)
# Compare predictions with actual values
results <- data.frame(
Actual = testData$mpg,
Predicted = predictions
)
print(results)## Actual Predicted
## Mazda RX4 Wag 21.0 20.88336
## Duster 360 14.3 14.09782
## Toyota Corolla 33.9 28.88019
## Ford Pantera L 15.8 24.00074evaluate_model <- function(actual, predicted) {
rmse <- sqrt(mean((actual - predicted)^2))
rsquared <- cor(actual, predicted)^2
list(
RMSE = rmse,
R2 = rsquared
)
}
# Applying the custom function
metrics <- evaluate_model(results$Actual, results$Predicted)
print(metrics)## $RMSE
## [1] 4.808981
##
## $R2
## [1] 0.6297763#Conclusion
#this exercise, we:
#Explored the caret package and its documentation.
#Built a linear regression model using caret.
#Developed and applied a custom function to evaluate the model's performance.
#This process showcases the versatility of the caret package for machine learning and the ability to create additional functionality tailored to specific analytical needs.