new

Author: wulixin

Diff for: shiny_A.R

@@ -0,0 +1,35 @@
+
+
+library(devtools)
+library(shiny)
+library(fullPage)
+
+#demo("fullPage", package = "fullPage")
+#demo("pagePiling", package = "fullPage")
+#demo("multiPage", package = "fullPage")
+
+
+
+ui <- fullPage(
+  fullSection(
+    menu = "first",
+    center = TRUE,
+    h1("Callbacks")
+  ),
+  fullSection(
+    menu = "second",
+    center = TRUE,
+    h3("Slice"),
+    verbatimTextOutput("slide")
+  )
+)
+
+server <- function(input, output){
+  
+  output$slide <- renderPrint({
+    input$slide_origin # returns menu
+  })
+  
+}
+
+shinyApp(ui, server)

Diff for: shiny_AA.R

@@ -0,0 +1,55 @@
+
+library(shiny)
+library(shinybulma)
+
+shinyApp(
+  ui = bulmaPage(
+    bulmaHero(
+      fullheight = TRUE,
+      color = "primary",
+      bulmaHeroBody(
+        bulmaContainer(
+          bulmaTitle("Shiny meets Bulma!"),
+          bulmaSubtitle("A neat framework for your Shiny apps.")
+        )
+      )
+    ),
+    bulmaSection(
+      bulmaContainer(
+        bulmaTileAncestor(
+          bulmaTileParent(
+            vertical = TRUE,
+            bulmaTileChild(
+              bulmaTitle("Tile 1"),
+              p("Put some data here"),
+              color = "link"
+            ),
+            bulmaTileChild(
+              bulmaTitle("Tile 2"),
+              plotOutput("chart"),
+              color = "danger"
+            )
+          ),
+          bulmaTileParent(
+            vertical = TRUE,
+            bulmaTileChild(
+              bulmaTitle("Tile 3"),
+              p("Put some data here"),
+              color = "warning"
+            ),
+            bulmaTileChild(
+              bulmaTitle("Tile 3"),
+              ("Put some data here"),
+              color = "info"
+            )
+          )
+        )
+      )
+    )
+  ),
+  server = function(input, output) {
+    output$chart <- renderPlot({
+      plot(x = runif(20, 5, 10), y = runif(20, 10, 12))
+    })
+  }
+)

Diff for: shiny_AAA.R

@@ -0,0 +1,67 @@
+#R group
+require(shiny)
+nameList=as.character(rownames(mtcars))
+
+shinyUI <- fluidPage(
+  
+  sidebarPanel(
+    tags$head(tags$script(src="enterButton.js")),
+    fluidRow(selectInput("name",label = "Model",choices = c("",nameList))),
+    fluidRow(sliderInput("hp","Horsepower range",min =50 ,max=350,value=c(50,150))),
+    fluidRow(actionButton("submit",label = "Submit"))
+  ),
+  
+  mainPanel(
+    dataTableOutput("res"),
+    
+    conditionalPanel(
+      condition="output.res",fluidRow(downloadLink("resTable","Download table"),
+                                      fluidRow(downloadLink("priceList","Download price list")))
+    )
+  ))
+
+
+
+#R group
+require(shiny)
+
+
+
+shinyServer <- function(input, output) {
+  
+  res=eventReactive(input$submit,{
+    
+    name=as.character(input$name)
+    minHp=input$hp[1]
+    maxHp=input$hp[2]
+    
+    res=mtcars
+    if (name!="") {
+      res=mtcars[name,]
+    }
+    res=res[res$hp<maxHp & res$hp>minHp,]
+    
+    validate(need(nrow(res)>0, "No matches found"))
+    
+    return(res)
+    
+  })
+  
+  output$res=renderDataTable({
+    res=res()
+  },options=list(hover = T, bordered = T, align="c", colnames = T, rownames = T, na="NA"))
+  
+  output$resTable=downloadHandler(filename="data_table.csv", 
+                                  content = function(file) {
+                                    write.csv(res,file,row.names = F) 
+                                  }, contentType = "text/csv")
+  
+  output$priceList=downloadHandler(filename = "cars_prices.csv", 
+                                   content=function(file){
+                                     file.copy("price_list.csv")
+                                   },contentType = "text/csv")
+  
+}
+
+
+  

Diff for: spatial_data.R

@@ -0,0 +1,108 @@
+
+
+suppressPackageStartupMessages(library(dplyr))
+library(stars)
+# Loading required package: abind
+# Loading required package: sf
+# Linking to GEOS 3.5.0, GDAL 2.2.2, PROJ 4.8.0
+tif = system.file("tif/L7_ETMs.tif", package = "stars")
+read_stars(tif) %>%
+  slice(index = 1, along = "band") %>%
+  plot()
+
+
+prec_file = system.file("nc/test_stageiv_xyt.nc", package = "stars")
+(prec = read_ncdf(prec_file, curvilinear = c("lon", "lat"), ignore_bounds = TRUE))
+
+
+################
+sf::read_sf(system.file("gpkg/nc.gpkg", package = "sf"), "nc.gpkg") %>%
+  st_transform(st_crs(prec)) -> nc # transform from NAD27 to WGS84
+nc_outline = st_union(st_geometry(nc))
+plot_hook = function() plot(nc_outline, border = 'red', add = TRUE)
+prec %>%
+  slice(index = 1:12, along = "time") %>%
+  plot(downsample = c(5, 5, 1), hook = plot_hook)
+
+
+
+a = aggregate(prec, by = nc, FUN = max)
+# although coordinates are longitude/latitude, st_intersects assumes that they are planar
+# although coordinates are longitude/latitude, st_intersects assumes that they are planar
+plot(a, max.plot = 23, border = 'grey', lwd = .5)
+
+
+
+
+index_max = function(x) ifelse(all(is.na(x)), NA, which.max(x))
+st_apply(a, "geometry", index_max) %>%
+  mutate(when = st_get_dimension_values(a, "time")[.$index_max]) %>%
+  select(when) %>%
+  plot(key.pos = 1, main = "time of maximum precipitation")
+
+
+
+
+library(sf)
+library(leaflet)
+library(mapview)
+library(mapedit)
+library(leafpm)
+# make a contrived polygon with holes for testing
+outer1 = matrix(c(0,0,10,0,10,10,0,10,0,0),ncol=2, byrow=TRUE)
+hole1 = matrix(c(1,1,1,2,2,2,2,1,1,1),ncol=2, byrow=TRUE)
+hole2 = matrix(c(5,5,5,6,6,6,6,5,5,5),ncol=2, byrow=TRUE)
+outer2 = matrix(c(11,0,11,1,12,1,12,0,11,0),ncol=2, byrow=TRUE)
+pts1 = list(outer1, hole1, hole2)
+pts2 = list(outer2)
+pl1 = st_sf(geom = st_sfc(st_polygon(pts1)))
+pl2 = st_sf(geom = st_sfc(st_polygon(pts2)))
+mpl = st_sf(geom = st_combine(rbind(pl1, pl2)), crs=4326)
+tst = editFeatures(mpl, editor = "leafpm")
+# look at our creation
+mapview(tst)
+
+
+
+
+library(sp)
+grd = SpatialPoints(expand.grid(x=1:100, y=1:100))
+gridded(grd) = TRUE
+fullgrid(grd) = TRUE
+pts = spsample(grd, 50, "random")
+pts$z = rnorm(50)
+library(gstat)
+v = vgm(1, "Sph", 90)
+out = krige(z~1, pts, grd, v, nmax = 20, nsim = 4)
+
+## drawing 4 GLS realisations of beta...
+## [using conditional Gaussian simulation]
+
+out[[3]] = 0.5 * out[[3]] + 0.5 * rnorm(1e4)
+out[[4]] = rnorm(1e4)
+spplot(out, as.table = TRUE)
+
+
+
+library(tmap)
+budapest_df = data.frame(name = "Budapest", x = 19, y = 47.5)
+class(budapest_df)
+#> [1] "data.frame"
+budapest_sf = sf::st_as_sf(budapest_df, coords = c("x", "y"))
+class(budapest_sf)
+#> [1] "sf"         "data.frame"
+tmap_mode("view")
+#> tmap mode set to interactive viewing
+m = tm_shape(budapest_sf) + tm_dots() + tm_view(basemaps = "OpenStreetMap", 
+                                                set.view = 9)
+tmap_leaflet(m)
+
+
+
+
+library(tmap)
+tm_shape(nz) +
+  tm_polygons("Median_income", palette = "RdYlBu")
+
+
+