LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@yuhi62320

テスト

Posted at
a.r
library(tidyverse)
library(ggmap)
library(leaflet)

# VINを20種類生成
set.seed(123)
vin_list <- paste0("VIN", sprintf("%03d", 1:20))

# 3月3日の00:00:00から始まり、20秒間隔で10,000行のタイムスタンプを生成
start_time <- as.POSIXct("2025-03-03 00:00:00", tz="UTC")
gps_timestamps <- seq(from = start_time, by = 20, length.out = 10000)

# VINをランダムに割り当て
df <- data.frame(
  vin = sample(vin_list, 10000, replace = TRUE),
  gps_timestamp_20sec = gps_timestamps
)

# 兵庫県の緯度・経度範囲
base_locations <- data.frame(
  vin = vin_list,
  base_lat = runif(20, min = 34.5, max = 35.5),  # 兵庫県の緯度範囲
  base_lon = runif(20, min = 134.5, max = 135.5)  # 兵庫県の経度範囲
)

# 車ごとの経路を生成
df <- df %>%
  left_join(base_locations, by = "vin") %>%
  group_by(vin) %>%
  mutate(
    latitude = base_lat + cumsum(rnorm(n(), mean = 0.001, sd = 0.0005)),
    longitude = base_lon + cumsum(rnorm(n(), mean = 0.001, sd = 0.0005))
  ) %>%
  ungroup()

# スピード値（小数点第1位まで）をランダムに生成
df$sp1_value <- round(runif(10000, min = 0, max = 120), 1)

# b_dmode_value: 0, 1, 2, 6のいずれかをランダムに選択
df$b_dmode_value <- sample(c(0, 1, 2, 6), 10000, replace = TRUE)

# ACCのON/OFF情報（0または1）
df$acc_value <- sample(c(0, 1), 10000, replace = TRUE)

# VINを1つ選択
target_vin <- "VIN001"
df_vin <- df %>% filter(vin == target_vin)

# カラーマッピングの定義
color_palette <- colorFactor(c("red", "blue", "green", "purple"), 
                             levels = c(0, 1, 2, 6))

# インタラクティブマップの作成
leaflet(df_vin) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitude,
    lat = ~latitude,
    color = ~color_palette(b_dmode_value),
    popup = ~paste("Time:", gps_timestamp_20sec, "<br>Speed:", sp1_value, "km/h"),
    radius = 3,
    opacity = 0.8
  ) %>%
  addLegend("bottomright", 
            pal = color_palette, 
            values = ~b_dmode_value,
            title = "b_dmode_value")



library(dplyr)
library(leaflet)
library(ggplot2)

# データ準備
set.seed(123)
vin_list <- paste0("VIN", sprintf("%03d", 1:20))
start_time <- as.POSIXct("2025-03-03 00:00:00", tz="UTC")
gps_timestamps <- seq(from = start_time, by = 20, length.out = 10000)
df <- data.frame(
  vin = sample(vin_list, 10000, replace = TRUE),
  gps_timestamp_20sec = gps_timestamps
)
base_locations <- data.frame(
  vin = vin_list,
  base_lat = runif(20, min = 34.5, max = 35.5),
  base_lon = runif(20, min = 134.5, max = 135.5)
)
df <- df %>%
  left_join(base_locations, by = "vin") %>%
  group_by(vin) %>%
  mutate(
    latitude = base_lat + cumsum(rnorm(n(), mean = 0.001, sd = 0.0005)),
    longitude = base_lon + cumsum(rnorm(n(), mean = 0.001, sd = 0.0005))
  ) %>%
  ungroup()
df$sp1_value <- round(runif(10000, min = 0, max = 120), 1)
df$b_dmode_value <- sample(c(0, 1, 2, 6), 10000, replace = TRUE)
df$acc_value <- sample(c(0, 1), 10000, replace = TRUE)

# ACC使用率のタイル化
grid_size <- 0.01  # タイルサイズ

df_grid <- df %>%
  mutate(
    lat_bin = round(latitude / grid_size) * grid_size,
    lon_bin = round(longitude / grid_size) * grid_size
  ) %>%
  group_by(lat_bin, lon_bin) %>%
  summarise(acc_usage_rate = mean(acc_value), .groups = 'drop')

# マッピング
leaflet(df_grid) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~longitude,
    lat = ~latitude,
    color = ~color_palette(acc_value),
    popup = ~paste("Time:", gps_timestamp_20sec, "<br>Speed:", sp1_value, "km/h"),
    radius = 3,
    opacity = 0.8
  ) %>%
  addRectangles(
    lng1 = ~lon_bin - grid_size / 2, 
    lat1 = ~lat_bin - grid_size / 2, 
    lng2 = ~lon_bin + grid_size / 2, 
    lat2 = ~lat_bin + grid_size / 2,
    fillColor = ~colorNumeric("YlOrRd", df_grid$acc_usage_rate)(acc_usage_rate),
    fillOpacity = 0.6,
    color = "black",
    weight = 1
  ) %>%
  addLegend("bottomright", 
            pal = colorNumeric("YlOrRd", df_grid$acc_usage_rate), 
            values = df_grid$acc_usage_rate,
            title = "ACC Usage Rate")


library(dplyr)
library(leaflet)
library(ggplot2)

# データ準備
set.seed(123)
vin_list <- paste0("VIN", sprintf("%03d", 1:20))
start_time <- as.POSIXct("2025-03-03 00:00:00", tz="UTC")
gps_timestamps <- seq(from = start_time, by = 20, length.out = 10000)
df <- data.frame(
  vin = sample(vin_list, 10000, replace = TRUE),
  gps_timestamp_20sec = gps_timestamps
)
base_locations <- data.frame(
  vin = vin_list,
  base_lat = runif(20, min = 34.5, max = 35.5),
  base_lon = runif(20, min = 134.5, max = 135.5)
)
df <- df %>%
  left_join(base_locations, by = "vin") %>%
  group_by(vin) %>%
  mutate(
    latitude = base_lat + cumsum(rnorm(n(), mean = 0.001, sd = 0.0005)),
    longitude = base_lon + cumsum(rnorm(n(), mean = 0.001, sd = 0.0005))
  ) %>%
  ungroup()
df$sp1_value <- round(runif(10000, min = 0, max = 120), 1)
df$b_dmode_value <- sample(c(0, 1, 2, 6), 10000, replace = TRUE)
df$acc_value <- sample(c(0, 1), 10000, replace = TRUE)

# ACC使用率のタイル化
grid_size <- 0.01  # タイルサイズ

df_grid <- df %>%
  mutate(
    lat_bin = round(latitude / grid_size) * grid_size,
    lon_bin = round(longitude / grid_size) * grid_size
  ) %>%
  group_by(lat_bin, lon_bin) %>%
  summarise(acc_usage_rate = mean(acc_value), acc_count = n(), .groups = 'drop')

# マッピング
leaflet() %>%
  addTiles() %>%
  addRectangles(
    data = df_grid,
    lng1 = ~lon_bin - grid_size / 2, 
    lat1 = ~lat_bin - grid_size / 2, 
    lng2 = ~lon_bin + grid_size / 2, 
    lat2 = ~lat_bin + grid_size / 2,
    fillColor = ~colorNumeric("YlOrRd", df_grid$acc_usage_rate)(acc_usage_rate),
    fillOpacity = 0.6,
    color = "black",
    weight = 1,
    popup = ~paste("ACC Usage Rate: ", round(acc_usage_rate, 2), "<br>",
                   "ACC Count: ", acc_count)
  ) %>%
  addCircleMarkers(
    data = df,
    lng = ~longitude,
    lat = ~latitude,
    radius = 1,
    color = ~ifelse(acc_value == 1, "blue", "red"),
    fillOpacity = 0.8,
    popup = ~paste("VIN: ", vin, "<br>",
                   "ACC: ", acc_value)
  ) %>%
  addLegend("bottomright", 
            pal = colorNumeric("YlOrRd", df_grid$acc_usage_rate), 
            values = df_grid$acc_usage_rate,
            title = "ACC Usage Rate")
server.R
library(shiny)
library(MASS)
library(kernlab)
library(DT)
library(tidyverse)
library(plm)
library(caret)

shinyServer(function(input, output, session) {
  output$distPlot_shiny <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins_shiny + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
  
  data_for_plot <- reactive({
    data <- switch(input$selected_data_for_plot,
                   "iris" = iris,
                   "Boston" = Boston,
                   "titanic" = data.frame(lapply(data.frame(Titanic), 
                                                 function(i){rep(i, data.frame(Titanic)[, 5])}))
    ) %>% 
      dplyr::filter(
        Sepal.Length  >= input$Sepal.Length[1], Sepal.Length  <= input$Sepal.Length[2],
        Sepal.Width  >= input$Sepal.Width[1], Sepal.Width  <= input$Sepal.Width[2],
        Petal.Length  >= input$Petal.Length[1], Petal.Length  <= input$Petal.Length[2],
        Petal.Width  >= input$Petal.Width[1], Petal.Width  <= input$Petal.Width[2],
        Species %in% c(
          if_else(input$setosa == T, "setosa", ""),
          if_else(input$versicolor == T, "versicolor", ""),
          if_else(input$virginica == T, "virginica", "")
        )
      )
    
    updateSelectInput(session, "select_input_data_for_hist", choices = colnames(data))
    updateSelectInput(session, "input_data_for_scatter_plotX", 
                      choices = colnames(data), selected = colnames(data)[1])
    updateSelectInput(session, "input_data_for_scatter_plotY", 
                      choices = colnames(data), selected = colnames(data)[1])
    
    return(data)
  })
  
  output$map <- renderLeaflet({
    df_vin <- df %>% filter(vin == input$selected_vin)
    
    leaflet(df_vin) %>%
      addTiles() %>%
      addCircleMarkers(
        lng = ~longitude,
        lat = ~latitude,
        color = ~color_palette(b_dmode_value),
        popup = ~paste("Time:", gps_timestamp_20sec, "<br>Speed:", sp1_value, "km/h"),
        radius = 3,
        opacity = 0.8
      ) %>%
      addLegend("bottomright", 
                pal = color_palette, 
                values = ~b_dmode_value,
                title = "b_dmode_value")
  })
  
  output$histgram <- renderPlot({
    input$trigger_histogram
    
    tmpData <- data_for_plot()[, isolate(input$select_input_data_for_hist)]
    x <- na.omit(tmpData)
    bins <- seq(min(x), max(x), length.out = isolate(input$slider_input_data) + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
  
  output$table_for_plot <- DT::renderDataTable({
    data_for_plot()
  })
  
  
  output$scatter_plot <- renderPlot({
    isolate(temp <- data.frame(
      x = data_for_plot()[, input$input_data_for_scatter_plotX],
      y = data_for_plot()[, input$input_data_for_scatter_plotY]
    ))
    input$trigger_scatter_plot
    g <- ggplot(temp, aes(x=x, y=y))
    g + geom_point()
    
  })
  
  output$plot_brushedPoints <- DT::renderDataTable({
    res <- brushedPoints(data_for_plot(), input$plot_brush, 
                         xvar = input$input_data_for_scatter_plotX,
                         yvar = input$input_data_for_scatter_plotY)
    
    if (nrow(res) == 0)
      return()
    res
  })
  
  data_for_regression <- reactive({
    data <- switch(input$data_for_regressionX,
                   "iris" = iris,
                   "infert" = infert,
                   "Boston" = Boston,
                   "spam" = spam,
                   "airquality" = airquality,
                   "titanic" = data.frame(lapply(data.frame(Titanic), 
                                                 function(i){rep(i, data.frame(Titanic)[, 5])}))
    )
    updateSelectInput(session, "data_for_regressionY", choices = colnames(data), 
                      selected = colnames(data)[1])
    
    return(data)
  })
  
  output$data_table_for_regression <- DT::renderDataTable(
    t(data_for_regression()[1:10, ]), selection = list(target = 'row')
  )
  
  output$rows_selected <- renderPrint(
    input$data_table_for_regression_rows_selected
  )
  
  data_train_and_test <- reactiveValues()
  
  regression_summary <-  reactive({
    input$regression_button
    
    y <- data_for_regression()[, isolate(input$data_for_regressionY)]
    x <- data_for_regression()[, isolate(input$data_table_for_regression_rows_selected)]
    
    tmp_data <- cbind(na.omit(x), na.omit(y))
    colnames(tmp_data) <- c(colnames(x), "dependent_variable")
    train_index <- createDataPartition(tmp_data$"dependent_variable", p = .7,
                                       list = FALSE,
                                       times = 1)
    data_train_and_test$train <- tmp_data[train_index, ]
    data_train_and_test$test <- tmp_data[-train_index, ]
    
    return(train(dependent_variable ~.,
                 data = data_train_and_test$train,
                 method = isolate(input$regression_type),
                 tuneLength = 4,
                 preProcess = c('center', 'scale'),
                 trControl = trainControl(method = "cv"),
                 linout = TRUE))
  })
})
ui.R
library(shiny)
library(shinythemes)
library(DT)
library(shinydashboard)
library(tidyverse)
library(caret)

shinyUI(
  navbarPage("Data Dashboard Sample Application",

             tabPanel("VIN GPS Data Dashboard",
             sidebarLayout(
               sidebarPanel(
                 selectInput("selected_vin", "Select VIN:", choices = vin_list, selected = "VIN001")
               ),
               mainPanel(
                 tabsetPanel(type ="tabs",
                             tabPanel("Maps",leafletOutput("map"))
                 )
               )))
             ,


              tabPanel("可視化", sidebarLayout(
               sidebarPanel(
                 selectInput("selected_data_for_plot", label = h3("Select Dataset"),
                             choices = c("Iris" = "iris",
                                         "Boston" = "Boston",
                                         "Titanic" = "titanic"),
                             selected = "Iris"),
                 # sliders to select status of 6 parameters
                 sliderInput("Sepal.Length", "Sepal.Length:",
                             min = 0, max = 8, value = c(0,8)),
                 sliderInput("Sepal.Width", "Sepal.Width:",
                             min = 0, max = 5, value = c(0,5)),
                 sliderInput("Petal.Length", "Petal.Length:",
                             min = 0, max = 7, value = c(0,7)),
                 sliderInput("Petal.Width", "Petal.Width:",
                             min = 0, max = 3, value = c(0,3)),
                 
                 # checkboxes to select type
                tags$p("Species"),
                 checkboxInput("setosa", "setosa", TRUE),
                 checkboxInput("versicolor", "versicolor", TRUE),
                 checkboxInput("virginica ", "virginica ", TRUE),
                 
                 selectInput("select_input_data_for_hist",
                             "ヒストグラムを表示する列番号",
                             choices = colnames(iris)),
                 sliderInput("slider_input_data",
                             "Number of bins:",
                             min = 1,
                             max = 50,
                             value = 30),
                 actionButton("trigger_histogram", "ヒストグラムを出力"),
                 
                 h3("散布図を表示する列を指定"),
                 selectInput("input_data_for_scatter_plotX",
                             "x軸",
                             choices = colnames(iris), selected = colnames(iris)[1]),
                 selectInput("input_data_for_scatter_plotY",
                             "y軸",
                             choices = colnames(iris), selected = colnames(iris)[1]),
                 actionButton("trigger_scatter_plot", "散布図を出力")
               ),
               mainPanel(
                 tabsetPanel(type = "tabs",
                             tabPanel("Table",
                                      DT::dataTableOutput("table_for_plot")),
                             tabPanel("ヒストグラム", plotOutput("histgram")),
                             tabPanel("散布図", plotOutput("scatter_plot", brush = brushOpts(id="plot_brush")),
                                      DT::dataTableOutput("plot_brushedPoints")),
                             tabPanel("みたいに他にも図を表示する")
                 )
               )
             )),
             
             tabPanel("回帰", sidebarLayout(
               sidebarPanel(
                 selectInput("data_for_regressionX", label = h3("データセットを選択してください。"),
                             choices = c("アヤメのデータ" = "iris",
                                         "不妊症の比較データ" = "infert",
                                         "ボストン近郊の不動産価格データ" = "Boston",
                                         "スパムと正常メールのデータ" = "spam",
                                         "ニューヨークの大気状態データ" = "airquality",
                                         "タイタニックの乗客データ" = "titanic"),
                             selected = "iris"),
                 h3("回帰を出力"),
                 selectInput("data_for_regressionY",
                             "目的変数を選択",
                             choices = colnames(iris), selected = colnames(iris)[1]),
                 h3("選択された説明変数はこちら"),
                 verbatimTextOutput("rows_selected"),
                 selectInput("regression_type",
                             "回帰の手法を選択",
                             choices = c("重回帰分析" = "lm",
                                         "ランダムフォレスト" = "rf",
                                         "3層ニューラルネット" = "nnet")),
                 actionButton("regression_button", "回帰")
               ),
               mainPanel(
                 tabsetPanel(type = "tabs",
                             tabPanel("Table", h3("説明変数を選択してください。"), 
                                      DT::dataTableOutput("data_table_for_regression")),
                             tabPanel("回帰結果", verbatimTextOutput("summary_regression")),
                             tabPanel("プロットで結果を確認", plotOutput("plot_regression"))
                 )
               )
             )),
             
             
             navbarMenu("その他",
                        tabPanel("About",
                                 h2("私の名前はNp-Urです。")),
                        tabPanel("ソースコード",
                                 a(href="https://github.com/Np-Ur/ShinyBook", 
                                   p("https://github.com/Np-Ur/ShinyBook"))
                        )
             )
  )
)
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?