我正在使用 R、RStudio 和leaflet软件包来可视化地图。
我想获取传单对象边界框的最小和最大经纬度。我认为这可以使用 Shiny 来完成(通过使用类似的东西input$mapobj_bounds),但是有没有一种非闪亮的方法可以做到这一点。
m <- leaflet(width=500,height=400) %>%
addTiles() %>%
setView(lng = -0.106831, lat = 51.515328, zoom = 18) %>%
addCircleMarkers(lng = -0.106831, lat = 51.515328)
Run Code Online (Sandbox Code Playgroud)
我需要的是一个使用输入参数获取边界框的函数m。
这可以做到吗?
此外,查看对象时的参数值m看起来不正确。
例如
> m$x$limits
$lat
[1] 51.51533 51.51533
$lng
[1] -0.106831 -0.106831
Run Code Online (Sandbox Code Playgroud)
编辑
我认为 javascript 函数map.getBounds()可能在这里有帮助...正如这里所建议的(获取可见传单地图的边界框?),但不知道如何将其应用于我们的问题。对此的任何帮助将不胜感激。
这是一个简单的问题,但它开始让我烦恼,我找不到解决方案....
我希望能够在使用paste或paste0时将它作为输出保留0.0,所以如果我有以下内容:
y <- c(-1.5,-1.0,-0.5,0.0,0.5,1.0,1.5)
> y
[1] -1.5 -1.0 -0.5 0.0 0.5 1.0 1.5
paste0("x",y,"x")
Run Code Online (Sandbox Code Playgroud)
我明白了:
[1] "x-1.5x" "x-1x" "x-0.5x" "x0x" "x0.5x" "x1x" "x1.5x"
Run Code Online (Sandbox Code Playgroud)
但想要:
[1] "x-1.5x" "x-1.0x" "x-0.5x" "x0.0x" "x0.5x" "x1.0x" "x1.5x"
Run Code Online (Sandbox Code Playgroud) 与我之前的问题类似:最接近路径
我希望能够找到最接近路径的所有中心.然而,路径中缺少一些数据,我想做线性段来在点之间进行插值以"估计"可能的路径,并且仍然找到可能接近该"估计路径"的中心.
set.seed(1)
n <- 10000
x <- 100*cumprod(1 + rnorm(n, 0.0001, 0.002))
y <- 50*cumprod(1 + rnorm(n, 0.0001, 0.002))
# original path
path <- data.frame(cbind(x=x, y=y))
# path with missing points/points every hundred
path.w.missing <- path[seq(1,n,by=100),]
centers <- expand.grid(x=seq(0, 500,by=0.5) + rnorm(1001),
y=seq(0, 500, by=0.2) + rnorm(2501))
centers$id <- seq(nrow(centers))
Run Code Online (Sandbox Code Playgroud)
没有模拟路径中给定点之间的数百万个线性点......我不确定如何做到这一点......
对我来说,它有点像找到一条线和一个细胞矩阵......各种......但也许我距离......
任何帮助将不胜感激.
我在s3中有很多(数百万)个小日志文件,其名称(日期/时间)有助于定义它,即servername-yyyy-mm-dd-HH-MM.例如
s3://my_bucket/uk4039-2015-05-07-18-15.csv
s3://my_bucket/uk4039-2015-05-07-18-16.csv
s3://my_bucket/uk4039-2015-05-07-18-17.csv
s3://my_bucket/uk4039-2015-05-07-18-18.csv
...
s3://my_bucket/uk4339-2015-05-07-19-23.csv
s3://my_bucket/uk4339-2015-05-07-19-24.csv
...
etc
Run Code Online (Sandbox Code Playgroud)
从EC2,使用AWS CLI,我想同时下载2015年所有分钟等于16的文件,仅适用于所有服务器uk4339和uk4338
有一个聪明的方法来做到这一点?
另外,如果这是s3中查询数据的可怕文件结构,我将非常感谢有关如何更好地设置它的任何建议.
我可以将相关aws s3 cp ...命令放入shell/bash脚本的循环中,以便顺序下载相关文件,但是,想知道是否有更高效的东西.
作为一个额外的奖励,我想将结果排在一起作为一个csv.
可以使用此R代码行在R中生成模拟csv文件的快速示例
R> write.csv(data.frame(cbind(a1=rnorm(100),b1=rnorm(100),c1=rnorm(100))),file='uk4339-2015-05-07-19-24.csv',row.names=FALSE)
Run Code Online (Sandbox Code Playgroud)
创建的csv是uk4339-2015-05-07-19-24.csv.仅供参考,我将在最后将组合数据导入R.
我正在使用h2o进行一些建模,并且已经调整了模型,我现在希望它用于执行大约6bln预测/行的大量预测,每个预测行需要80列数据
数据集我已经将输入数据集向下分解,因此它大约有500 x 12百万个行块,每个行块都有相关的80列数据.
然而,上传一个data.table1200万到80列到h2o需要相当长的时间,而对我来说这样做需要花费相当长的时间...我认为这是因为它在上传之前首先解析了对象.
预测部分比较快......
有什么建议加速这部分吗?改变核心数量有帮助吗?
以下是问题的可重现的例子......
# Load libraries
library(h2o)
library(data.table)
# start up h2o using all cores...
localH2O = h2o.init(nthreads=-1,max_mem_size="16g")
# create a test input dataset
temp <- CJ(v1=seq(20),
v2=seq(7),
v3=seq(24),
v4=seq(60),
v5=seq(60))
temp <- do.call(cbind,lapply(seq(16),function(y){temp}))
colnames(temp) <- paste0('v',seq(80))
# this is the part that takes a long time!!
system.time(tmp.obj <- as.h2o(localH2O,temp,key='test_input'))
#|======================================================================| 100%
# user system elapsed
#357.355 6.751 391.048
Run Code Online (Sandbox Code Playgroud) 在RStudio中,在全局选项->代码下有一个vim编辑模式。
但是我有一个通常使用的.vimrc文件,并希望提取这些首选项。
如何获得RStudio来取货?
提前致谢。
我正在Raddress()中使用pryr包中的函数,并且想知道是否可以预期以下结果...
x <- 1:10
add <- function(obj){address(obj)}
address(x)
# [1] "0x112d007b0"
add(x)
# [1] "0x11505c580"
Run Code Online (Sandbox Code Playgroud)
即 0x112d007b0 != 0x11505c580
我希望它们的值相同……有没有办法调整add上面的函数以确保它得到相同的值?即获取父环境中的地址?
在 R 闪亮和数据表 (DT) 中想要将控件文本的颜色更改为蓝色,因为它表明它可以在这里:
https://datatables.net/manual/styling/theme-creator
通过调整Control text:值,#0000ff这似乎改变文本的分页按钮的颜色是蓝色,以及在网页上搜索文本等,但我想这对于一个闪亮的应用程序与datatable已呈现。任何帮助将非常感激。
请参阅下面的示例,其中文本的文本颜色未更改为蓝色...
library(DT)
library(shiny)
ui=shinyUI(
fluidPage(
tags$head(tags$style(HTML("table.dataTable.hover tbody tr:hover, table.dataTable.display tbody tr:hover {
background-color: #9c4242 !important;
} "))),
DT::dataTableOutput("tt")
)
)
server=shinyServer(function(input, output) {
output$tt=DT::renderDataTable(
DT:::datatable(
head(iris, 50),rownames = FALSE,options = list(dom='ptl',
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}")
),
container = tags$table(
class="compact",
tags$thead(tags$tr(lapply(colnames(iris), tags$th)))
)
) %>% formatStyle(columns=colnames(iris),color='white',background = 'black',target = 'row')
)
})
shinyApp(ui=ui,server=server)
Run Code Online (Sandbox Code Playgroud) 我想构建一个闪亮的应用程序,当鼠标悬停在一个形状/圆形而不是标准单击上时,会弹出一个弹出窗口
特别是我试图在鼠标悬停时弹出窗口...随着鼠标移离它而消失。
此页面(https://rstudio.github.io/leaflet/shiny.html)建议我需要类似observeEvent({input$mymap_shape_mouseover},{showPopup()})
但不确定在哪里输入或如何使用它,因此将不胜感激。
以下是一个简单的随机示例...
library(shiny)
library(leaflet)
library(data.table)
uu <- data.table(row_num=seq(100),
Latitude=c(52+cumsum(runif(100,-0.001,0.001))),
Longitude=c(1+cumsum(runif(100,-0.001,0.001)))
)
ui <- fluidPage(
leafletOutput("mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addCircles(lng=uu$Longitude,
lat=uu$Latitude,
radius=2)
})
# Show a popup at the given location
show_popup_on_mouseover <- function(id, lat, lng) {
selected_point <- uu[row_num == id,]
content <- as.character(selected_point$row_num)
leafletProxy("mymap") %>%
addPopups(lng, lat, content)
}
# When circle is hovered over...show a popup
observe({
leafletProxy("mymap") %>% clearPopups()
event …Run Code Online (Sandbox Code Playgroud) 我shinyjs在 R 中使用包来允许onclick类型事件在选项卡集中的选项卡之间导航。每个选项卡都有一个特定的侧边栏,并且在每个选项卡之间有多种(两种)方式(即通过单击选项卡本身或单击 valueBoxes)。我想确保无论您以何种方式进入特定选项卡,都会加载正确的侧边栏。
# load libraries
require(shiny)
require(shinydashboard)
require(shinyjs)
# create a simple app
ui <- dashboardPage(
title='Loading graphs',
dashboardHeader(
title = 'Loading Graphs'
),
dashboardSidebar(
div(id='tab1_sidebar',
sliderInput('tab1_slider', 'tab1 slider', min=2,max=7,value=2)),
shinyjs::hidden(
div(id='tab2_sidebar',
sliderInput('tab2_slider', 'tab2 slider', min=2,max=7,value=2))
)
),
dashboardBody(
useShinyjs(),
tabsetPanel(
id = "navbar",
tabPanel(title="tab1 title",id="tab1",value='tab1_val',
valueBoxOutput('tab1_valuebox')),
tabPanel(title="tab2 title",id="tab2",value='tab2_val',
valueBoxOutput('tab2_valuebox'))
)
)
)
server <- shinyServer(function(input, output, session) {
output$tab1_valuebox <- renderValueBox({
valueBox('1000',subtitle = "blah blah",icon = icon("car"),
color = "blue"
)
})
output$tab2_valuebox …Run Code Online (Sandbox Code Playgroud)