调整闪亮代码中计算两点之间距离的方式

2024-07-04

下面的闪亮代码使用以下命令生成两点之间的路线googleway功能。请注意,此外,还计算了两点之间的距离,但这是欧氏距离,而不是使用googleway功能。计算距离的正确方法是执行以下操作:

test<-google_directions(origin = c(-24.872139, -50.038787), destination = c(-24.9062992895515, -50.0125745903862), mode = "driving", alternatives = TRUE)

Distance<-sum(as.numeric(direction_steps(test)$distance$value)) 
[1] 6153

但是,我希望在下面的闪亮代码中使用这种计算形式,以便正确计算路线。因此,你能帮我调整闪亮的代码吗?

闪亮的代码

library(shiny)
library(dplyr)
library(geosphere)
library(shinythemes)
library(googleway)

set_key( "YOUR_API_KEY")

k=3

function.cl<-function(df,k,Filter1,Filter2){
  
 df<-structure(list(Properties = c(1, 2, 3, 4, 5, 6, 7), Latitude = c(-23.8, 
 -23.8, -23.9, -23.9, -23.9, -23.4, -23.5), Longitude = c(-49.6, 
  -49.3, -49.4, -49.8, -49.6, -49.4, -49.2), 
  cluster = c(1L, 2L, 2L, 1L, 1L, 3L,3L)), row.names = c(NA, -7L), class = "data.frame")
  

  df1<-structure(list(Latitude = c(-23.8666666666667, -23.85, -23.45
  ), Longitude = c(-49.6666666666667, -49.35, -49.3), cluster = c(1, 
  2, 3)), class = "data.frame", row.names = c(NA, -3L))
  
 
  #specific cluster and specific propertie
  df_spec_clust <- df1[df1$cluster == Filter1,]
  df_spec_prop<-df[df$Properties==Filter2,]
  
  #Table to join
  data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
  data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
  

  # Map for route
  if(nrow(df_spec_clust>0) & nrow(df_spec_prop>0)) {
  df2<-google_directions(origin = df_spec_clust[,1:2], 
   destination = df_spec_prop[,2:3], mode = "driving")
          
    df_routes <- data.frame(polyline = direction_polyline(df2))
            
    m1<-google_map() %>%
      add_polylines(data = df_routes, polyline = "polyline")
    
    plot1<-m1 
  } else {
    plot1 <- NULL
  }
  
  
  DISTANCE<- merge(df,df1,by = c("cluster"), suffixes = c("_df","_df1"))
  
  (DISTANCE$distance <- purrr::pmap_dbl(.l = list(DISTANCE$Longitude_df,
                                                    DISTANCE$Latitude_df,
                                                    DISTANCE$Longitude_df1,
                                                    DISTANCE$Latitude_df1),
                                          .f = ~distm(c(..1,..2),c(..3,..4))))
  
  

  return(list(
    "Plot1" = plot1,
    "DIST" = DISTANCE,
    "Data" = data_table_1,
    "Data1" = data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          
                          selectInput("Filter1", label = h4("Select just one cluster to show"),""),
                          selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
                          h4("The distance is:"),
                          textOutput("dist"),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Gmaps", (google_mapOutput("Gmaps",width = "95%", height = "600")))
                        
                      ))))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,k,input$Filter1,input$Filter2)
  })
  

  output$Gmaps <- renderGoogle_map({
    Modelcl()[[1]]
  })
  
  observeEvent(k, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(c(k,input$Filter1),{
    abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Properties)))})
  
  output$dist <- renderText({
    DIST <- data.frame(Modelcl()[[2]])
    DIST$distance[DIST$cluster == input$Filter1 & DIST$Properties == input$Filter2]
  })
  
  
}

shinyApp(ui = ui, server = server)

您可以首先简化欧氏距离的计算:purrr::map这里不需要,因为计算仅在两点之间。

然后,使用您提供的代码即可直接计算道路距离:

library(shiny)
library(dplyr)
library(geosphere)
library(shinythemes)
library(googleway)

set_key( "YOUR_API_KEY")

k=3

function.cl<-function(Filter1,Filter2){
  
  df<-structure(list(Properties = c(1, 2, 3, 4, 5, 6, 7), Latitude = c(-23.8, 
                                                                       -23.8, -23.9, -23.9, -23.9, -23.4, -23.5), Longitude = c(-49.6, 
                                                                                                                                -49.3, -49.4, -49.8, -49.6, -49.4, -49.2), 
                     cluster = c(1L, 2L, 2L, 1L, 1L, 3L,3L)), row.names = c(NA, -7L), class = "data.frame")
  
  
  df1<-structure(list(Latitude = c(-23.8666666666667, -23.85, -23.45
  ), Longitude = c(-49.6666666666667, -49.35, -49.3), cluster = c(1, 
                                                                  2, 3)), class = "data.frame", row.names = c(NA, -3L))
  
  
  #specific cluster and specific propertie
  df_spec_clust <- df1[df1$cluster == Filter1,]
  df_spec_prop<-df[df$Properties==Filter2,]
  
  #Table to join
  data_table <- df[order(df$cluster, as.numeric(df$Properties)),]
  data_table_1 <- aggregate(. ~ cluster, df[,c("cluster","Properties")], toString)
  
  
  # Map for route
  if(nrow(df_spec_clust>0) & nrow(df_spec_prop>0)) {
    df2<-google_directions(origin = df_spec_clust[,1:2], 
                           destination = df_spec_prop[,2:3], mode = "driving")
    
    df_routes <- data.frame(polyline = direction_polyline(df2))
    
    m1<-google_map() %>%
      add_polylines(data = df_routes, polyline = "polyline")
    
    plot1<-m1 
    # Euclidian distance
    distance_road <- sum(as.numeric(direction_steps(df2)$distance$value)) 
    # Road distance
    distance_straight <- distm(df_spec_clust[,2:1],df_spec_prop[,3:2])
  } else {
    plot1 <- NULL
    distance_road <- NA
    distance_straight <- NA
  }
  

  # Not needed?
  DISTANCE<- merge(df,df1,by = c("cluster"), suffixes = c("_df","_df1"))
  
  (DISTANCE$distance <- purrr::pmap_dbl(.l = list(DISTANCE$Longitude_df,
                                                  DISTANCE$Latitude_df,
                                                  DISTANCE$Longitude_df1,
                                                  DISTANCE$Latitude_df1),
                                        .f = ~distm(c(..1,..2),c(..3,..4))))
  
  
  
  return(list(
    "Plot1" = plot1,
    "DIST" = DISTANCE,
    "distance_road" = distance_road,
    "distance_straight" = distance_straight,
    "Data" = data_table_1,
    "Data1" = data_table
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          
                          selectInput("Filter1", label = h4("Select just one cluster to show"),""),
                          selectInput("Filter2",label=h4("Select the cluster property designated above"),""),
                          h4("The distance is:"),
                          textOutput("dist"),
                          textOutput("distance_straight"),
                          textOutput("distance_road")
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Gmaps", (google_mapOutput("Gmaps",width = "95%", height = "600")))
                            
                          ))))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(input$Filter1,input$Filter2)
  })
  
  
  output$Gmaps <- renderGoogle_map({
    Modelcl()[[1]]
  })
  
  observeEvent(k, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
  observeEvent(c(k,input$Filter1),{
    abc <- req(Modelcl()$Data1) %>% filter(cluster == as.numeric(input$Filter1))
    updateSelectInput(session,'Filter2',
                      choices=sort(unique(abc$Properties)))})
  
  # Original calculation
  output$dist <- renderText({
    DIST <- data.frame(Modelcl()[[2]])
    paste0("Original distance calculation: ",round(DIST$distance[DIST$cluster == input$Filter1 & DIST$Properties == input$Filter2])," meters")
  })
  
  # Simplified version
  output$distance_straight <- renderText({
    paste0("Simplified distance calculation: ",round(Modelcl()$distance_straight)," meters")
  })
  
  output$distance_road <- renderText({
    paste0("Road distance calculation: ",Modelcl()$distance_road," meters")
    })
  

  
  
}

shinyApp(ui = ui, server = server)
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

调整闪亮代码中计算两点之间距离的方式 的相关文章

  • r - 按每天变化的日期过滤行

    该数据集为 1 列 包含数千行 其中包含日期 2021 09 23T06 38 53 458Z 使用以下代码 我可以对昨天的行进行子集化 rows from yesterday lt df df timestamp like 2021 09
  • R Markdown 水平规则也适用于 LaTeX pdf?

    我知道 是 Pandoc 的 Markdown 水平线 这条水平线在 HTML 上看起来不错 但如果我将 Markdown 编织成 pdf 则水平线仅占 pdf 宽度的一半 并且居中 这种组合只会让水平尺看起来很丑 如何在 R Markdo
  • 带有实心点符号和图例的绘图函数

    我想用不同的颜色和点样式绘制两个函数并带有相应的图例 简单的R 我有几个问题 我在用pch 21 and pch 22 我的理解是它们是 填充 符号 它们确实按照图例中的预期填充 但在图表本身上却显得空心 怎么了 我可以在不手动指定网格的情
  • Tidyr 的 Gather() 与 NA

    我在用tidyr and lubridate将宽表转换为长表 以下效果很好 gt df lt data frame hh id 1 2 bday 01 ymd 20150309 bday 02 ymd 19850911 bday 03 ym
  • RODBC 查询错误地返回零行

    我遇到过类似的帖子 但我的问题看起来不同 我无法使用 rows at time 1 或 believeNRows False 修复这些查询的结果 我正在尝试使用 R 中的 RODBC 连接到 Oracle 数据库 我能够连接到数据库 但除了
  • 如何将两列因子合并为一列而不将因子级别更改为数字[重复]

    这个问题在这里已经有答案了 我正在尝试找到一种方法将两列因子合并为一列 而不将因子级别更改为数字 例如 考虑以下两个 data frame 数据集 dataset 1 dataset 2 Number Student Number Stud
  • 使用 jekyll、rmarkdown 和 github 写博客:如何显示图像

    我尝试使用三重奏 jekyll rmarkdown 和 github 制作一个博客 如下所示 http yihui name knitr jekyll http yihui name knitr jekyll 我的所有 Rmd 都在 sou
  • 在片段中添加 Google Maps API V2

    我正在尝试以片段形式显示 Google Maps API V2 中的地图 我尝试使用 SupportMapFragment 但无法获得预期的输出 我也是这个平台的初学者 我真正想要的只是一种将 Android 版 Google Maps A
  • RSelenium:连接被拒绝错误

    我正在尝试使用最新版本的 RSelenium 连接到 Selenium 服务器 这是我使用的代码 install packages RSelenium library RSelenium remDr lt remoteDriver remo
  • 如何找到循环矩阵何时收敛

    我得到了一个矩阵 P lt matrix c 0 0 0 0 5 0 0 5 0 1 0 1 0 0 4 0 0 4 0 0 2 0 2 0 3 0 0 3 0 0 0 3 0 5 0 0 2 0 0 0 0 4 0 6 0 0 0 0 0
  • 用 R 中的 ggplot2 填充两条线之间的区域

    这是一个玩具数据集 xa lt c 4 5 4 5 4 3 1 5 ya lt c 1 2 4 5 5 5 6 xb lt c 3 8 4 5 4 3 5 2 5 1 yb lt c 1 2 3 4 5 5 8 toyset lt as d
  • gc() 和 rm() 有什么区别

    我定期使用调用来清理 R 中的内存rm list ls 我需要调用垃圾收集器吗gc 在那之后 这2个函数有什么区别 做gc call rm 对于某些变量 首先 需要注意的是 两者有很大不同gc不删除any您仍在使用的变量 它只会为您不再有权
  • 在javascript中解压缩字符串[关闭]

    Closed 这个问题正在寻求书籍 工具 软件库等的推荐 不满足堆栈溢出指南 help closed questions 目前不接受答案 有人知道一个实现 UNZIP 算法的简单 JavaScript 库吗 没有磁盘文件访问 仅压缩和解压缩
  • 创建半甜甜圈或议会席位图表

    我想在 ggplot2 中创建一个显示议会席位大小的图表 如下图所示 我的主要问题本质上是如何将圆环图转换为半圆环图 半圆弧 以上面的图片为例 我不知道从这里到哪里 df lt data frame Party c GUE NGL S D
  • 让所有街道在 Google 地图视口中可见

    我正在尝试使用以下算法构建地图 等待平移或缩放发生 查询视口中可见的所有街道 范围 使用预定义的颜色为每条可见街道着色 Example 我想显示每条街道上的企业数量 或者每条街道上发生的犯罪数量 我有一个数据库 其中包含此类信息 街道名称
  • 将 data.table 转换为数据框而不复制[重复]

    这个问题在这里已经有答案了 本问答集 https stackoverflow com questions 20345022 convert a data frame to a data table without copy询问如何在不复制的
  • 在 docker 文件中安装私有 R 包

    我第一次尝试使用 Docker 和 ShinyProxy 在这个过程的一开始我遇到了很多困难 我开发了一些在本地运行良好的闪亮应用程序 我正在考虑将它们部署在我网站的一些文章中 这些闪亮的应用程序使用了 2 个我自己编码的包 它们位于我的计
  • 检查纬度和经度是否在谷歌地图圆内

    以下是我正在寻找的期望结果 我想知道的是 我使用中心点纬度和周围半径创建了圆 现在我想知道 如何检查 计算 纬度和经度是否在该区域之内或之外 如果您能给我 JavaScript 代码示例 我将不胜感激 我正在使用 Google 地图 API
  • 查找数据框中前 n 行的总和

    我想找到前面的总和n数据框中的行 例如 id 1 10 vals c 4 7 2 9 7 0 4 6 1 8 test data frame id vals So for n 3 我想将下一列计算为 test sum c NA NA 13
  • 使用深度名称向量作为索引替换嵌套列表

    采取一个简单的嵌套列表L L lt list lev1 list lev2 c bit1 bit2 other list yep 1 L lev1 lev1 lev2 1 bit1 bit2 other other yep 1 1 一个向量

随机推荐

  • 导航栏标题视图对齐

    我希望我的导航栏在中间显示两件事 其中之一是列表名称 另一个是用户名称 用户名将放置在列表名称下 到目前为止我所做的是 我以编程方式创建了两个标签和一个超级视图 并设置titleView of navigationItem override
  • 如何检查Python中的列表列表中是否存在某个元素?

    我有一个与文件中的行相对应的列表列表 具有多列 col1 col2 col3 elem1 elem2 elem3 elem4 elem5 elem6 我想检查是否 例如 elem3位于任意列表中 如果在 则进入该列表 实际上我有一个需要检查
  • 超过 1 列具有 string_agg 的唯一值

    我正在尝试分组并获取多列的值列表 这是一个例子 City State Income Salem OH 40000 Salem OH 45000 Mason OH 50000 Dayton OH 60000 Salem MA 40000 Ma
  • VueJS:缓存http响应数据的最佳方法

    我正在寻找一个在 VueJS 中缓存 http 响应数据的最佳方法 现在我使用 Vuex Store 来我的博客 我想在请求到服务器时缓存所有响应数据 具体来说 这是我的博客 当我通过路由器请求数据到博客详细信息时1 3 4 我有响应数据
  • PowerShell - 从 .csproj 文件获取版本

    我正在学习 PowerShell 现在 我正在努力获得Version csproj 文件中的元素值 csproj 文件的 XML 如下所示
  • 讨论小 n 的计算复杂性的正确方法

    当讨论计算复杂度时 似乎每个人都会直接谈到 Big O 举例来说 我有一个混合算法 例如合并排序 它对较小的子数组使用插入排序 我相信这称为平铺合并排序 最终仍然是合并排序O n log n 但我想讨论小型算法的行为 特征n 在实际没有发生
  • 在 C# 中使用匿名类型创建对象文字时出现问题

    我正在尝试构建 JavaScript 对象文字的 C 近似值 以传递给 asp net MVC 中的视图模型 var obj new dynamic new name Id index Id width 40 align left new
  • 在控制器的 RequestMapping 中启用 ConditionalOnProperty

    我有一段代码 PropertySource value classpath securityConfig properties ignoreResourceNotFound true Controller public class Inde
  • 关于注释代码,您的“硬性规则”是什么? [关闭]

    Closed 这个问题是基于意见的 help closed questions 目前不接受答案 我看过其他问题但我仍然对这个主题的涵盖方式不满意 我想提取一份精简的列表 以便在代码检查时检查注释 我确信人们会说出一些只会互相抵消的话 但是
  • 检测用于构建 OSX 框架的 SDK 版本

    我需要检测哪个 SDK 版本用于构建 OSX 框架 任何有用的提示将不胜感激 弗洛里安 感谢您的提示解决了我的问题 我需要验证框架是否确实是使用 10 6 SDK 构建的 谢谢你的提示 我用otool解决了这个问题 如果链接到 10 6 S
  • 从 Tableau Public 仪表板中抓取数据

    我对从网站上抓取数据还很陌生 并且不知道如何从使用 Tableau Public 的网站上抓取数据 网站 https showmestrong mo gov data public health https showmestrong mo
  • 如何使用 pyav 或 opencv 解码原始 H.264 数据的实时流?

    数据是通过套接字接收的 没有更多的外壳 它们是纯IP B帧 以NAL标头 类似于00 00 00 01 开头 我现在使用 pyav 来解码帧 但我只能在收到第二个 pps 信息 在关键帧中 后解码数据 因此我发送到解码线程的数据块可以以 p
  • 显示工具提示时 d3.event 的 x 和 y 坐标不正确

    我正在尝试在水平条形图上显示工具提示 如果我稍微向下滚动页面 此工具提示将无法正常工作 如果条形图在视图中且无需滚动 则此方法效果很好 但是 如果我在图表上方添加更多元素 当我向下滚动时 工具提示会从鼠标指针处移至更高位置 请帮助我解决这个
  • SharePoint REST 查询 SP.UserProfiles.PeopleManager 特殊字符

    这个问题是我作为起点发现的这个问题的延伸 无需特殊字符即可工作 SharePoint REST 查询 SP UserProfiles PeopleManager https stackoverflow com questions 23340
  • asp.net mvc web api 使用 OData 补丁进行部分更新

    我正在使用 HttpPatch 部分更新对象 为了实现这一点 我使用 OData 中的 Delta 和 Patch 方法 此处提到 目前推荐使用 Web API 执行部分更新的方法是什么 https stackoverflow com qu
  • 将符号限制为 Linux 可执行文件的本地范围

    任何人都可以建议我们限制将符号导出到全局符号表的某种方法吗 提前致谢 Hi 感谢回复 实际上 我有一个可执行文件 它静态链接到第三方库 例如 ver1 a 并且还使用第三方 so 文件 该文件再次与相同的库链接 但不同版本 例如 ver2
  • 从Python3中的base64编码字符串中删除新行“\n”?

    我正在尝试在 Python3 中建立 HTTPS 连接 当我尝试对我的用户名和密码进行编码时base64 encodebytes方法返回编码值 并在末尾带有一个新行字符 n 因此当我尝试连接时出现错误 有没有办法告诉base64库在编码时不
  • 将命名函数存储在具有不同名称的变量中

    考虑这段代码 var x function z console log called x x will print out called x z ReferenceError 因此 可以在变量中存储命名函数 但我们仍然只能通过变量名来调用该
  • SqlAlchemy:case 语句(case - if - then -else)

    我想知道是否有办法创建case使用 SqlAlchemy 的语句 例如这PostgreSQL 版本 http www postgresql org docs current static functions conditional html
  • 调整闪亮代码中计算两点之间距离的方式

    下面的闪亮代码使用以下命令生成两点之间的路线googleway功能 请注意 此外 还计算了两点之间的距离 但这是欧氏距离 而不是使用googleway功能 计算距离的正确方法是执行以下操作 test lt google directions