-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'main' of github.com:YONGHUNI/blog
- Loading branch information
Showing
1 changed file
with
15 additions
and
0 deletions.
There are no files selected for viewing
15 changes: 15 additions & 0 deletions
15
_freeze/posts/shinystandalone/index/execute-results/html.json
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,15 @@ | ||
{ | ||
"hash": "35cf05dcb05e09be8a72ec9ca020e07d", | ||
"result": { | ||
"engine": "knitr", | ||
"markdown": "---\ntitle: \"Quarto-shinylive & Quartolive Testdrive\"\nauthor: \"Yonghun Suh\"\ndate: \"Oct 17, 2024\"\ncategories: [Code]\n#image: \n#engine: knitr\nformat: \n live-html:\n #resources:\n # - ./data/shinylive-sw.js\n #page-layout: full\n ##https://quarto.org/docs/authoring/article-layout.html\n toc: false\n number_sections: true\n code-copy: true\n code-fold: show\n code-tools: true\n code-overflow: scroll\n code-link: true\n number-sections: true\n toc_depth: 3\n lightbox: true\n theme:\n light: cosmo #sketchy\n dark: [cosmo, ../../misc/theme-dark.scss]\n css: ../../misc/styles.css\n#webr: \n# show-startup-message: false\nfilters:\n #- webr\n - shinylive\n \n---\n\n::: {.cell}\n\n:::\n\n\n\n\n\n# Quarto-Shinylive\n\n## Locations of Earthquakes off Fiji\n\n> The data set give the locations of 1000 seismic events of MB > 4.0. The events occurred in a cube near Fiji since 1964. There are two clear planes of seismic activity. One is a major plate junction; the other is the Tonga trench off New Zealand. These data constitute a subsample from a larger dataset of containing 5000 observations.\n\nThis is one of the Harvard PRIM-H project data sets. They in turn obtained it from Dr. John Woodhouse, Dept. of Geophysics, Harvard University.\n\n\n:::{.column-screen-inset}\n\n\n```{shinylive-r}\n#| standalone: true\n#| viewerHeight: 1000\n\n\nlibrary(shiny)\nlibrary(leaflet)\nlibrary(RColorBrewer)\n\nui <- bootstrapPage(\n tags$style(type = \"text/css\", \"html, body {width:100%;height:100%}\"),\n leafletOutput(\"map\", width = \"100%\", height = \"100%\"),\n absolutePanel(top = 10, right = 10,\n sliderInput(\"range\", \"Magnitudes\", min(quakes$mag), max(quakes$mag),\n value = range(quakes$mag), step = 0.1\n ),\n selectInput(\"colors\", \"Color Scheme\",\n rownames(subset(brewer.pal.info, category %in% c(\"seq\", \"div\")))\n ),\n checkboxInput(\"legend\", \"Show legend\", TRUE)\n )\n)\n\nserver <- function(input, output, session) {\n\n # Reactive expression for the data subsetted to what the user selected\n filteredData <- reactive({\n quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]\n })\n\n # This reactive expression represents the palette function,\n # which changes as the user makes selections in UI.\n colorpal <- reactive({\n colorNumeric(input$colors, quakes$mag)\n })\n\n output$map <- renderLeaflet({\n # Use leaflet() here, and only include aspects of the map that\n # won't need to change dynamically (at least, not unless the\n # entire map is being torn down and recreated).\n leaflet(quakes) %>% addTiles() %>%\n fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))\n })\n\n # Incremental changes to the map (in this case, replacing the\n # circles when a new color is chosen) should be performed in\n # an observer. Each independent set of things that can change\n # should be managed in its own observer.\n observe({\n pal <- colorpal()\n\n leafletProxy(\"map\", data = filteredData()) %>%\n clearShapes() %>%\n addCircles(radius = ~10^mag/10, weight = 1, color = \"#777777\",\n fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag,\"진도\")\n )\n })\n\n # Use a separate observer to recreate the legend as needed.\n observe({\n proxy <- leafletProxy(\"map\", data = quakes)\n\n # Remove any existing legend, and only if the legend is\n # enabled, create a new one.\n proxy %>% clearControls()\n if (input$legend) {\n pal <- colorpal()\n proxy %>% addLegend(position = \"bottomright\",\n pal = pal, values = ~mag\n )\n }\n })\n}\n\nshinyApp(ui, server)\n\n```\nCredit: [Using Leaflet with Shiny](https://rstudio.github.io/leaflet/articles/shiny.html#modifying-existing-maps-with-leafletproxy){target=\"_blank\"}\n\n:::\n\n# Quarto-Live\n\n\n## Interactive R\n\n### Mergesort from scratch\n\nI coded this while teaching myself computer science.\n\n\nI think it is important to understand how the \"so-called\" the basis functions work when it comes to the programming.\n\nYou can play around with it. Plus, you can modify the code for a better understanding.\n\n\n\n\n::: {.cell}\n```{webr}\n### You can play ALL by YOURSELF!\n\n\nprint(\"Hello quarto-live world!\")\n\n\n\n{\n # set seed for reproducability\n set.seed(10)\n givne_num <- sample(1:999, 20)\n}\n\n\n\n\n# merge two sorted array\nmerge <- function(a, b) {\n \n # create temp array\n temp <- numeric(length(a) + length(b))\n \n \n # array a, array b, setting the init value of temp array index i \n a_i <- 1\n b_i <- 1\n temp_i <- 1\n \n \n # loop through till the index temp_i reaches length of the temp array\n for(temp_i in 1 : length(temp)) {\n \n # if\n # the index of `a` does not exceedes the length of `a`(a present)\n # a[a_i] < b[b_i] or,\n \n \n # the index of `b` does exceedes the length of `b`(i.e., b does not presnt)\n if((a_i <= length(a) &&\n a[a_i] < b[b_i]) ||\n b_i > length(b)) {\n \n \n # assign an element of `a[a_i]` into temp[a_i], then i++ the index of `a`\n temp[temp_i] <- a[a_i]\n a_i <- a_i + 1\n }\n \n # else\n else {\n \n\n # assign b[b_i] into temp[temp_i] then i++ the index\n temp[temp_i] <- b[b_i]\n b_i <- b_i + 1 \n }\n \n }\n \n # return the sorted array (part of the divided/splitted)\n return(temp)\n}\n\n\n\n\n# merge sort algorithm(splitting included) - recursive function\nmergesort <- function(arr) {\n \n\n # if length of the given array exceeds 1 then\n if(length(arr) > 1) {\n \n # 분할할 중간 지점\n # midpoint for the split\n # e.g., an array size of 5: celing(5/2) = 3\n half <- ceiling(length(arr)/2)\n \n \n # calling recursive function: split untill the single element then sort\n # 1 to midpoint\n a <- mergesort(arr[1:half])\n \n \n # midpoint+1 to last\n b <- mergesort(arr[(half+1):length(arr)])\n \n # merge two sorted array and return\n merge(a, b)\n }\n \n # if the size of the array is 1\n else {\n # just return\n return(arr)\n }\n}\n\n\n\n\nminmax <- function(arr){\n \n temp <- mergesort(arr)\n \n # mimicing Python's dictionary... then return\n return(list(\"max\" = temp[length(temp)], \"min\" = temp[1]))\n \n}\n\n# function call\noutput <- minmax(givne_num)\n\n\n\n# max\noutput$max\n\n# min\noutput$min\n\n\n\n# Use the R built-in function to check the answer\nmax(givne_num)\nmin(givne_num)\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n###\n```\n:::\n\n\n\n## Non-interactive\n\n\n\n::: {.cell}\n\n```{.r .cell-code}\ncat(\"And, this is a non-interactive cell\", fill = TRUE)\n```\n\n::: {.cell-output .cell-output-stdout}\n\n```\nAnd, this is a non-interactive cell\n```\n\n\n:::\n:::\n", | ||
"supporting": [], | ||
"filters": [ | ||
"rmarkdown/pagebreak.lua" | ||
], | ||
"includes": {}, | ||
"engineDependencies": {}, | ||
"preserve": {}, | ||
"postProcess": true | ||
} | ||
} |