Background
Pada tahun 2019 terdapat kurang lebih 15 juta pengguna aktif aplikasi salah satu layanan transportasi online dengan sekitar 900.000 mitra pengendara aplikasi tersebut. Dengan berkembang pesatnya teknologi dan terjadinya pandemi tentu meningkatkan jumlah kedua belah pihak (customer dan driver). Setiap driver memiliki peluang untuk mendapat 16 customer aktif.
“Salah satu pengembang aplikasi melakukan riset mengenai mengapa customer menggunakan suatu aplikasi ojek online, dan dari 4 alasan yang diberikan peringkat kedua tertinggi alasan tersebut adalah jumlah driver” (Arini, 2017). 
Namun dengan meningkatnya driver maka dapat terjadi potensi membludaknya driver pada kondisi atau situasi tertentu pada suatu lokasi. Mari kita lihat, seringkah kita melihat driver ojek online yang menumpuk atau menunggu pada satu lokasi yang sama setiap harinya? 
Hal tersebut berkaitan dengan keinginan driver mencari penumpang pada lokasi strategis, namun apakah lokasi strategis yang diketahui driver terbatas? dengan keterbatasan tersebut sistem dapat memberikan saran mengenai lokasi yang berpotensi menjadi titik dengan kebutuhan driver tinggi pada waktu tertentu. Perlu kita ketahui umumnya waktu bekerja driver yang lebih dari 12 jam perhari sangat menyita waktu terlebih dimana driver masih menunggu penumpang yang belum tentu mereka dapatkan di lokasi dengan kebutuhan driver tinggi karena menumpuknya driver (Yunus, dkk. 2019). Waktu tersebut tentunya terpengaruh oleh target pendapatan driver sendiri. Bila driver sudah dapat memenuhi target maka driver dapat mengurangi jam kerja tersebut. Oleh karena itu pemaksimalan saran terhadap driver mengenai titik berpotensi kebutuhan driver tinggi akan mempercepatdriver menutup target tersebut.
Kebutuhan tiap harinya pun tidak selalu sama, terdapat waktu dan hari tertentu dimana terjadinya kebutuhan driver yang tinggi di lokasi tersebut. Bila driver hanya menunggu setiap hari pada titik yang sama akan mengakibatkan ketidak optimalan kinerja driver karena tidak mendapat customer secara merata ketika kebutuhan sedang rendah. Untuk mengetahui kebutuhan tersebut kita dapat mengelompokkan dua kategori tiap lokasi, yaitu high demand dan low demand. Kita ingin mengoptimalkan posisi driver menunggu/mencari penumpang dengan memberikan saran dalam aplikasi driver ke titik mana saja mereka dapat mencari peluang mendapat penumpang, dan dengan batas dari penentuan kategori high demand maka kita dapat memberikan saran kepada sejumlah driver sesuai kebutuhan lokasi tersebut sehingga tidak mengalami penumpukkan driver suatu lokasi. Sehingga tiap driver mendapatkan saran lokasi yang berbeda-beda.
Business Impact
Merekomendasikan kepada driver mengenai jam dan lokasi dengan kemungkinan demand yang tinggi pada suatu lokasi akan mengefisienkan waktu bagi customer dalam mendapatkan dan menunggu driver serta mengefektifkan driver dalam mencari penumpang. Selain itu dampak yang diberikan akan membantu para pengembang di bidang layanan tersebut untuk dapat mengoptimalkan jumlah driver yang ada pada suatu lokasi dengan demand tertentu.
Project Idea
Dengan memanfaatkan faktor pendukung seperti cuaca serta kondisi lingkungan pada jam tertentu di hari tertentu akan membuat pola yang dapat membantu identifikasi kemungkinan adanya “high demand” (tingginya kebutuhan driver) pada beberapa lokasi berbeda. Dengan begitu dasar dari sistem dapat menjadi saran bagi driver untuk mendekati titik-titik kemungkinan terjadi “high demand” dan mengoptimalkan waktu bekerja driver dengan lebih baik.
Problem Scope
Data yang dapat digunakan untuk menyelesaikan masalah tersebut berasal dari kaggle dengan judul Uber and Lyft Dataset Boston, MA (From 11-26-2018 to 12-18-2018) yang berisi 57 kolom dan disederhanakan menjadi beberapa kolom penting yaitu :
price : atau ongkos perjalanan,
distance : jarak perjalanan dari titik penjemputan ke titik tujuan,
source : atau daerah titik penjemputan,
datetime : atau waktu penjemputan yang dikelompokkan berdasarkan jam dan tanggal,
demand : jumlah pesanan di rentang waktu yang sama,
surge_multiplier : poin kenaikan harga yang dapat diberikan berdasarkan keadaan jalanan pada saat jam tersebut,
latitude dan longitude : titik penjemputan secara spesifik,
temperature adalah ukuran suhu pada lokasi dan hari yang sama,
humidity : atau kelembaban pada lokasi, windspeed atau kecepatan angin,
visibility : atau tingkat pengelihatan pengemudi jalan dalam melihat jalan secara jelas (semakin rendah dapat diakibatkan adanya kabut atau asap yang tebal),
temperatureHigh : titik tertinggi temperatur pada waktu dan lokasi tersebut,
temperatureLow : titik terendah temperatur pada lokasi dan waktu tersebut,
pressure : atau tekanan gravitasi bumi di lokasi yang sama,
short_summary : atau cuaca pada saat itu di lokasi dan waktu spesifik.
High : target kolom yang kita buat berdasarkan rerata demand tiap lokasi di tiap jamnya.
Output
Dari data dan machine learning yang sudah kita buat nantinya menghasilkan dashboard yang berisi trend demand dari beberapa lokasi, heatmap, dan input data yang diberika untuk mengetahui status demand yang terjadi tiap lokasi.
Data Preparation
Untuk menjawab masalah tersebut kita dapat memulai untuk melakukan persiapan data, pertama kita panggil library yang digunakan. Kemudian kita read data mentah kita. Lalu kita lihat kembali struktur data, baik ada tidaknya NA maupun type data yang kita miliki.
# Library
library(tidyverse) #membantu wranggling data
library(lubridate) #membantu dalam custom data tipe waktu (date time)
library(tidymodels)
library(zoo) #membuat padding (melengkapi data berdasarkan kelengkapan waktu dalam periode tertentu)
library(glue) #membuat keterangan dengan plotly
library(plotly) #grafik interaktif
df <- read.csv("rideshare_kaggle.csv") #membaca data
colSums(is.na(df)) #Cek NA dalam data## id timestamp
## 0 0
## hour day
## 0 0
## month datetime
## 0 0
## timezone source
## 0 0
## destination cab_type
## 0 0
## product_id name
## 0 0
## price distance
## 55095 0
## surge_multiplier latitude
## 0 0
## longitude temperature
## 0 0
## apparentTemperature short_summary
## 0 0
## long_summary precipIntensity
## 0 0
## precipProbability humidity
## 0 0
## windSpeed windGust
## 0 0
## windGustTime visibility
## 0 0
## temperatureHigh temperatureHighTime
## 0 0
## temperatureLow temperatureLowTime
## 0 0
## apparentTemperatureHigh apparentTemperatureHighTime
## 0 0
## apparentTemperatureLow apparentTemperatureLowTime
## 0 0
## icon dewPoint
## 0 0
## pressure windBearing
## 0 0
## cloudCover uvIndex
## 0 0
## visibility.1 ozone
## 0 0
## sunriseTime sunsetTime
## 0 0
## moonPhase precipIntensityMax
## 0 0
## uvIndexTime temperatureMin
## 0 0
## temperatureMinTime temperatureMax
## 0 0
## temperatureMaxTime apparentTemperatureMin
## 0 0
## apparentTemperatureMinTime apparentTemperatureMax
## 0 0
## apparentTemperatureMaxTime
## 0Dari data kita tidak terdapat NA, hal tersebut baik karena kumpulan data kita lengkap. Data dengan nilai NA dapat mempengaruhi hasil prediksi sehingga perlu kita hapus atau isi NA sesuai dengan kebutuhan bisnis kita.
Mari melihat struktur data dan tipe tiap kolom untuk dapat kita sesuaikan
glimpse(df)## Rows: 693,071
## Columns: 57
## $ id <chr> "424553bb-7174-41ea-aeb4-fe06d4f4b9d7", "4~
## $ timestamp <dbl> 1544952608, 1543284024, 1543366822, 154355~
## $ hour <int> 9, 2, 1, 4, 3, 18, 5, 19, 6, 10, 16, 19, 2~
## $ day <int> 16, 27, 28, 30, 29, 17, 26, 2, 3, 27, 30, ~
## $ month <int> 12, 11, 11, 11, 11, 12, 11, 12, 12, 11, 11~
## $ datetime <chr> "2018-12-16 09:30:07", "2018-11-27 02:00:2~
## $ timezone <chr> "America/New_York", "America/New_York", "A~
## $ source <chr> "Haymarket Square", "Haymarket Square", "H~
## $ destination <chr> "North Station", "North Station", "North S~
## $ cab_type <chr> "Lyft", "Lyft", "Lyft", "Lyft", "Lyft", "L~
## $ product_id <chr> "lyft_line", "lyft_premier", "lyft", "lyft~
## $ name <chr> "Shared", "Lux", "Lyft", "Lux Black XL", "~
## $ price <dbl> 5.0, 11.0, 7.0, 26.0, 9.0, 16.5, 10.5, 16.~
## $ distance <dbl> 0.44, 0.44, 0.44, 0.44, 0.44, 0.44, 1.08, ~
## $ surge_multiplier <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ~
## $ latitude <dbl> 42.2148, 42.2148, 42.2148, 42.2148, 42.214~
## $ longitude <dbl> -71.0330, -71.0330, -71.0330, -71.0330, -7~
## $ temperature <dbl> 42.34, 43.58, 38.33, 34.38, 37.44, 38.75, ~
## $ apparentTemperature <dbl> 37.12, 37.35, 32.93, 29.63, 30.88, 33.51, ~
## $ short_summary <chr> " Mostly Cloudy ", " Rain ", " Clear ", " ~
## $ long_summary <chr> " Rain throughout the day. ", " Rain until~
## $ precipIntensity <dbl> 0.0000, 0.1299, 0.0000, 0.0000, 0.0000, 0.~
## $ precipProbability <dbl> 0.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, ~
## $ humidity <dbl> 0.68, 0.94, 0.75, 0.73, 0.70, 0.84, 0.91, ~
## $ windSpeed <dbl> 8.66, 11.98, 7.33, 5.28, 9.14, 7.19, 0.53,~
## $ windGust <dbl> 9.17, 11.98, 7.33, 5.28, 9.14, 8.88, 0.88,~
## $ windGustTime <int> 1545015600, 1543291200, 1543334400, 154351~
## $ visibility <dbl> 10.000, 4.786, 10.000, 10.000, 10.000, 8.3~
## $ temperatureHigh <dbl> 43.68, 47.30, 47.55, 45.03, 42.18, 40.61, ~
## $ temperatureHighTime <int> 1544968800, 1543251600, 1543320000, 154351~
## $ temperatureLow <dbl> 34.19, 42.10, 33.10, 28.90, 36.71, 24.07, ~
## $ temperatureLowTime <int> 1545048000, 1543298400, 1543402800, 154357~
## $ apparentTemperatureHigh <dbl> 37.95, 43.92, 44.12, 38.53, 35.75, 34.97, ~
## $ apparentTemperatureHighTime <int> 1544968800, 1543251600, 1543320000, 154351~
## $ apparentTemperatureLow <dbl> 27.39, 36.20, 29.11, 26.20, 30.29, 12.04, ~
## $ apparentTemperatureLowTime <int> 1545044400, 1543291200, 1543392000, 154357~
## $ icon <chr> " partly-cloudy-night ", " rain ", " clear~
## $ dewPoint <dbl> 32.70, 41.83, 31.10, 26.64, 28.61, 34.41, ~
## $ pressure <dbl> 1021.98, 1003.97, 992.28, 1013.73, 998.36,~
## $ windBearing <int> 57, 90, 240, 310, 303, 294, 91, 159, 307, ~
## $ cloudCover <dbl> 0.72, 1.00, 0.03, 0.00, 0.44, 1.00, 1.00, ~
## $ uvIndex <int> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 2, 0, 0, 0, ~
## $ visibility.1 <dbl> 10.000, 4.786, 10.000, 10.000, 10.000, 8.3~
## $ ozone <dbl> 303.8, 291.1, 315.7, 291.1, 347.7, 335.8, ~
## $ sunriseTime <int> 1544962084, 1543232969, 1543319437, 154349~
## $ sunsetTime <int> 1544994864, 1543266992, 1543353364, 154352~
## $ moonPhase <dbl> 0.30, 0.64, 0.68, 0.75, 0.72, 0.33, 0.64, ~
## $ precipIntensityMax <dbl> 0.1276, 0.1300, 0.1064, 0.0000, 0.0001, 0.~
## $ uvIndexTime <int> 1544979600, 1543251600, 1543338000, 154350~
## $ temperatureMin <dbl> 39.89, 40.49, 35.36, 34.67, 33.10, 34.19, ~
## $ temperatureMinTime <int> 1545012000, 1543233600, 1543377600, 154355~
## $ temperatureMax <dbl> 43.68, 47.30, 47.55, 45.03, 42.18, 40.66, ~
## $ temperatureMaxTime <int> 1544968800, 1543251600, 1543320000, 154351~
## $ apparentTemperatureMin <dbl> 33.73, 36.20, 31.04, 30.30, 29.11, 27.39, ~
## $ apparentTemperatureMinTime <int> 1545012000, 1543291200, 1543377600, 154355~
## $ apparentTemperatureMax <dbl> 38.07, 43.92, 44.12, 38.53, 35.75, 34.97, ~
## $ apparentTemperatureMaxTime <int> 1544958000, 1543251600, 1543320000, 154351~Data kita memiliki 57 kolom namun kita tidak menggunakan semua kolom dan memilih berdasarkan kondisi yang akan mempengaruhi demand. kita ambil kolom dalam problem scope sebelumnya dan menambahkan kolom demand dari perhitungan data dan high untuk menentukan kondisi demand tinggi atau rendah.
Kita sesuaikan tipe data yang kita miliki pada data.
ride <- df %>%
mutate(cab_type = as.factor(cab_type),
product_id = as.factor(product_id),
name = as.factor(name),
hour = as.factor(hour),
short_summary = as.factor(short_summary),
long_summary = as.factor(long_summary),
datetime = ymd_hms(datetime)) %>%
select(-id)
ride <- ride %>%
mutate(datetime = round_date(x = datetime, unit ="hour"),
demand = 1)
head(ride)## timestamp hour day month datetime timezone
## 1 1544952608 9 16 12 2018-12-16 10:00:00 America/New_York
## 2 1543284024 2 27 11 2018-11-27 02:00:00 America/New_York
## 3 1543366822 1 28 11 2018-11-28 01:00:00 America/New_York
## 4 1543553583 4 30 11 2018-11-30 05:00:00 America/New_York
## 5 1543463360 3 29 11 2018-11-29 04:00:00 America/New_York
## 6 1545071112 18 17 12 2018-12-17 18:00:00 America/New_York
## source destination cab_type product_id name price
## 1 Haymarket Square North Station Lyft lyft_line Shared 5.0
## 2 Haymarket Square North Station Lyft lyft_premier Lux 11.0
## 3 Haymarket Square North Station Lyft lyft Lyft 7.0
## 4 Haymarket Square North Station Lyft lyft_luxsuv Lux Black XL 26.0
## 5 Haymarket Square North Station Lyft lyft_plus Lyft XL 9.0
## 6 Haymarket Square North Station Lyft lyft_lux Lux Black 16.5
## distance surge_multiplier latitude longitude temperature apparentTemperature
## 1 0.44 1 42.2148 -71.033 42.34 37.12
## 2 0.44 1 42.2148 -71.033 43.58 37.35
## 3 0.44 1 42.2148 -71.033 38.33 32.93
## 4 0.44 1 42.2148 -71.033 34.38 29.63
## 5 0.44 1 42.2148 -71.033 37.44 30.88
## 6 0.44 1 42.2148 -71.033 38.75 33.51
## short_summary long_summary
## 1 Mostly Cloudy Rain throughout the day.
## 2 Rain Rain until morning, starting again in the evening.
## 3 Clear Light rain in the morning.
## 4 Clear Partly cloudy throughout the day.
## 5 Partly Cloudy Mostly cloudy throughout the day.
## 6 Overcast Light rain in the morning and overnight.
## precipIntensity precipProbability humidity windSpeed windGust windGustTime
## 1 0.0000 0 0.68 8.66 9.17 1545015600
## 2 0.1299 1 0.94 11.98 11.98 1543291200
## 3 0.0000 0 0.75 7.33 7.33 1543334400
## 4 0.0000 0 0.73 5.28 5.28 1543514400
## 5 0.0000 0 0.70 9.14 9.14 1543446000
## 6 0.0000 0 0.84 7.19 8.88 1545022800
## visibility temperatureHigh temperatureHighTime temperatureLow
## 1 10.000 43.68 1544968800 34.19
## 2 4.786 47.30 1543251600 42.10
## 3 10.000 47.55 1543320000 33.10
## 4 10.000 45.03 1543510800 28.90
## 5 10.000 42.18 1543420800 36.71
## 6 8.325 40.61 1545076800 24.07
## temperatureLowTime apparentTemperatureHigh apparentTemperatureHighTime
## 1 1545048000 37.95 1544968800
## 2 1543298400 43.92 1543251600
## 3 1543402800 44.12 1543320000
## 4 1543579200 38.53 1543510800
## 5 1543478400 35.75 1543420800
## 6 1545130800 34.97 1545080400
## apparentTemperatureLow apparentTemperatureLowTime icon
## 1 27.39 1545044400 partly-cloudy-night
## 2 36.20 1543291200 rain
## 3 29.11 1543392000 clear-night
## 4 26.20 1543575600 clear-night
## 5 30.29 1543460400 partly-cloudy-night
## 6 12.04 1545134400 cloudy
## dewPoint pressure windBearing cloudCover uvIndex visibility.1 ozone
## 1 32.70 1021.98 57 0.72 0 10.000 303.8
## 2 41.83 1003.97 90 1.00 0 4.786 291.1
## 3 31.10 992.28 240 0.03 0 10.000 315.7
## 4 26.64 1013.73 310 0.00 0 10.000 291.1
## 5 28.61 998.36 303 0.44 0 10.000 347.7
## 6 34.41 1000.46 294 1.00 1 8.325 335.8
## sunriseTime sunsetTime moonPhase precipIntensityMax uvIndexTime
## 1 1544962084 1544994864 0.30 0.1276 1544979600
## 2 1543232969 1543266992 0.64 0.1300 1543251600
## 3 1543319437 1543353364 0.68 0.1064 1543338000
## 4 1543492370 1543526114 0.75 0.0000 1543507200
## 5 1543405904 1543439738 0.72 0.0001 1543420800
## 6 1545048523 1545081282 0.33 0.0221 1545066000
## temperatureMin temperatureMinTime temperatureMax temperatureMaxTime
## 1 39.89 1545012000 43.68 1544968800
## 2 40.49 1543233600 47.30 1543251600
## 3 35.36 1543377600 47.55 1543320000
## 4 34.67 1543550400 45.03 1543510800
## 5 33.10 1543402800 42.18 1543420800
## 6 34.19 1545048000 40.66 1545022800
## apparentTemperatureMin apparentTemperatureMinTime apparentTemperatureMax
## 1 33.73 1545012000 38.07
## 2 36.20 1543291200 43.92
## 3 31.04 1543377600 44.12
## 4 30.30 1543550400 38.53
## 5 29.11 1543392000 35.75
## 6 27.39 1545044400 34.97
## apparentTemperatureMaxTime demand
## 1 1544958000 1
## 2 1543251600 1
## 3 1543320000 1
## 4 1543510800 1
## 5 1543420800 1
## 6 1545080400 1Mengumpulkan prediktor yang kita gunakan nantinya dalam pemrosesan data dalam machine learning. Kita pisahkan prediktor dengan target variabel kita terlebih dahuluh untuk mengambil nilai mean dari tiap prediktor.
df_var <- ride %>%
select(-timestamp, -timezone, -destination, -long_summary, -name, -cab_type, -product_id, -icon, -hour)
predictor <- aggregate(. ~ source + datetime +short_summary, df_var, FUN = mean)
predictor %>%
group_by(source) %>%
arrange(source, datetime) %>%
head()## # A tibble: 6 x 48
## # Groups: source [1]
## source datetime short_summary day month price distance
## <chr> <dttm> <fct> <dbl> <dbl> <dbl> <dbl>
## 1 Back Bay 2018-11-26 04:00:00 " Foggy " 26 11 19.8 2.81
## 2 Back Bay 2018-11-26 05:00:00 " Overcast " 26 11 16.6 2.09
## 3 Back Bay 2018-11-26 06:00:00 " Overcast " 26 11 16.4 2.11
## 4 Back Bay 2018-11-26 07:00:00 " Overcast " 26 11 16.2 1.91
## 5 Back Bay 2018-11-26 08:00:00 " Overcast " 26 11 16.5 2.08
## 6 Back Bay 2018-11-26 09:00:00 " Overcast " 26 11 16.5 1.76
## # ... with 41 more variables: surge_multiplier <dbl>, latitude <dbl>,
## # longitude <dbl>, temperature <dbl>, apparentTemperature <dbl>,
## # precipIntensity <dbl>, precipProbability <dbl>, humidity <dbl>,
## # windSpeed <dbl>, windGust <dbl>, windGustTime <dbl>, visibility <dbl>,
## # temperatureHigh <dbl>, temperatureHighTime <dbl>, temperatureLow <dbl>,
## # temperatureLowTime <dbl>, apparentTemperatureHigh <dbl>,
## # apparentTemperatureHighTime <dbl>, apparentTemperatureLow <dbl>,
## # apparentTemperatureLowTime <dbl>, dewPoint <dbl>, pressure <dbl>,
## # windBearing <dbl>, cloudCover <dbl>, uvIndex <dbl>, visibility.1 <dbl>,
## # ozone <dbl>, sunriseTime <dbl>, sunsetTime <dbl>, moonPhase <dbl>,
## # precipIntensityMax <dbl>, uvIndexTime <dbl>, temperatureMin <dbl>,
## # temperatureMinTime <dbl>, temperatureMax <dbl>, temperatureMaxTime <dbl>,
## # apparentTemperatureMin <dbl>, apparentTemperatureMinTime <dbl>,
## # apparentTemperatureMax <dbl>, apparentTemperatureMaxTime <dbl>,
## # demand <dbl>df_surge <- df_var %>%
group_by(source, datetime, short_summary) %>%
summarise(surge_multiplier = max(surge_multiplier))## `summarise()` has grouped output by 'source', 'datetime'. You can override using the `.groups` argument.head(df_surge)## # A tibble: 6 x 4
## # Groups: source, datetime [6]
## source datetime short_summary surge_multiplier
## <chr> <dttm> <fct> <dbl>
## 1 Back Bay 2018-11-26 04:00:00 " Foggy " 1.75
## 2 Back Bay 2018-11-26 05:00:00 " Overcast " 1.75
## 3 Back Bay 2018-11-26 06:00:00 " Overcast " 1.25
## 4 Back Bay 2018-11-26 07:00:00 " Overcast " 2
## 5 Back Bay 2018-11-26 08:00:00 " Overcast " 1
## 6 Back Bay 2018-11-26 09:00:00 " Overcast " 1.25Membuat kolom demand dengan menghitung order pada lokasi dan waktu yang sama dengan perbedaan kondisi cuaca. hal tersebut berkaitan dengan jumlah demand yang akan kita gunakan nantinya dalam pembuatan label.
rd_s <- aggregate(demand ~ source +datetime, ride, FUN = sum)
rd_s <- rd_s %>%
mutate(hour = hour(datetime)) %>%
arrange(source, datetime)
head(rd_s)## source datetime demand hour
## 1 Back Bay 2018-11-26 04:00:00 9 4
## 2 Back Bay 2018-11-26 05:00:00 65 5
## 3 Back Bay 2018-11-26 06:00:00 73 6
## 4 Back Bay 2018-11-26 07:00:00 114 7
## 5 Back Bay 2018-11-26 08:00:00 34 8
## 6 Back Bay 2018-11-26 09:00:00 53 9Kita tentukan treshold untuk tiap lokasi dan waktu spesifik. Batasan tersebut akan membantu kita menentukan batasan serta mengelompokkan data kita berdasarkan status dari kolom demand. Kemudian kita masukan treshold kedalam data kita untuk membuat kolom target “high” dan melakukan padding untuk EDA.
treshold <- aggregate(demand ~ source + hour, rd_s, FUN = mean) %>%
mutate(demand = round(demand)) %>%
arrange(source, hour)
Backbay <- treshold %>%
filter(source == "Back Bay")
head(treshold)## source hour demand
## 1 Back Bay 0 196
## 2 Back Bay 1 189
## 3 Back Bay 2 175
## 4 Back Bay 3 168
## 5 Back Bay 4 170
## 6 Back Bay 5 152predictor <- df_surge %>%
right_join(predictor %>%
select(-surge_multiplier))Kita siapkan data prediktor kita yang sudah kita hitung meannya tiap prediktor dan dilakukan padding agar sesuai dengan data target kita yang dipadding
predictor_join <- predictor %>%
group_by(source) %>%
complete(datetime = seq.POSIXt(min(as.POSIXct(x = "2018-11-26 00:00:00", tz = "UTC")), max(as.POSIXct(x = "2018-12-18 23:00:00", tz = "UTC")), by = "hour")) %>%
ungroup() %>%
select(-demand)
head(predictor_join)## # A tibble: 6 x 47
## source datetime short_summary surge_multiplier day month price
## <chr> <dttm> <fct> <dbl> <dbl> <dbl> <dbl>
## 1 Back Bay 2018-11-26 00:00:00 <NA> NA NA NA NA
## 2 Back Bay 2018-11-26 01:00:00 <NA> NA NA NA NA
## 3 Back Bay 2018-11-26 02:00:00 <NA> NA NA NA NA
## 4 Back Bay 2018-11-26 03:00:00 <NA> NA NA NA NA
## 5 Back Bay 2018-11-26 04:00:00 " Foggy " 1.75 26 11 19.8
## 6 Back Bay 2018-11-26 05:00:00 " Overcast " 1.75 26 11 16.6
## # ... with 40 more variables: distance <dbl>, latitude <dbl>, longitude <dbl>,
## # temperature <dbl>, apparentTemperature <dbl>, precipIntensity <dbl>,
## # precipProbability <dbl>, humidity <dbl>, windSpeed <dbl>, windGust <dbl>,
## # windGustTime <dbl>, visibility <dbl>, temperatureHigh <dbl>,
## # temperatureHighTime <dbl>, temperatureLow <dbl>, temperatureLowTime <dbl>,
## # apparentTemperatureHigh <dbl>, apparentTemperatureHighTime <dbl>,
## # apparentTemperatureLow <dbl>, apparentTemperatureLowTime <dbl>,
## # dewPoint <dbl>, pressure <dbl>, windBearing <dbl>, cloudCover <dbl>,
## # uvIndex <dbl>, visibility.1 <dbl>, ozone <dbl>, sunriseTime <dbl>,
## # sunsetTime <dbl>, moonPhase <dbl>, precipIntensityMax <dbl>,
## # uvIndexTime <dbl>, temperatureMin <dbl>, temperatureMinTime <dbl>,
## # temperatureMax <dbl>, temperatureMaxTime <dbl>,
## # apparentTemperatureMin <dbl>, apparentTemperatureMinTime <dbl>,
## # apparentTemperatureMax <dbl>, apparentTemperatureMaxTime <dbl>Kemudian data tabel berisi target dan prdiktor digabungkan menjadi satu tabel dengan prediktor yang sudah kita identifikasi sebelumnya.
df_fus <- df_new %>%
left_join(predictor_join)## Joining, by = c("datetime", "source")df_fus <- na.locf(na.locf(df_fus),fromLast=TRUE) %>%
mutate(day = day(datetime),
month = month(datetime),
price = if_else(demand == 0, 0, price),
distance = if_else(demand == 0, 0, distance)) %>%
select("datetime", "source", "hour", "day", "month","short_summary", "high", "demand", "price", "distance", "surge_multiplier", "temperature", "humidity", "visibility", "temperatureHigh", "temperatureLow", "pressure")
head(df_fus)## # A tibble: 6 x 17
## datetime source hour day month short_summary high demand price
## <dttm> <chr> <int> <int> <dbl> <fct> <chr> <dbl> <dbl>
## 1 2018-11-26 04:00:00 Back B~ 4 26 11 " Foggy " 0 9 19.8
## 2 2018-11-26 05:00:00 Back B~ 5 26 11 " Overcast " 0 65 16.6
## 3 2018-11-26 06:00:00 Back B~ 6 26 11 " Overcast " 0 73 16.4
## 4 2018-11-26 07:00:00 Back B~ 7 26 11 " Overcast " 0 114 16.2
## 5 2018-11-26 08:00:00 Back B~ 8 26 11 " Overcast " 0 34 16.5
## 6 2018-11-26 09:00:00 Back B~ 9 26 11 " Overcast " 0 53 16.5
## # ... with 8 more variables: distance <dbl>, surge_multiplier <dbl>,
## # temperature <dbl>, humidity <dbl>, visibility <dbl>, temperatureHigh <dbl>,
## # temperatureLow <dbl>, pressure <dbl>Setelah data siap maka kita dapat melakukan EDA terlebih dahulu
EDA
Pertama kita ingin mengetahui bagaimana demand tiap lokasi dan pada lokasi manakah terdapat demand tertinggi.
Demand tiap lokasi
Kita kelompokkan data sesuai dengan kebutuhan kita (demand dan source) dan kita lihat kebutuhan tiap lokasi, lokasi manakah yang memiliki demand tinggi dari 12 lokasi berbeda di data kita? Apakah lokasi tertinggi tersebut terdapat pada kawasan padat? Dengan mengetahui jumlah lokasi secara keseluruhan kita dapat melihat bagaimana persebaran demand pada data tersebut.
vis_1 <- df_fus %>%
group_by(source) %>%
summarise(demand = sum(demand)) %>%
mutate(popup = glue("Source : {source}
Demand : {demand}
"))
vis_1 <- vis_1[order(vis_1$demand, decreasing = T),]plot1 <- ggplot(vis_1, aes(x = demand, y = reorder(source, demand))) +
geom_col(aes(fill = demand, text = popup)) +
scale_fill_gradient(high = "#173F5f",
low = "#3caea3") +
scale_x_continuous(limits = c(0,85000)) +
theme_classic() +
theme(legend.position = "none") +
labs(title = "Demand Tiap Lokasi",
x= "Demand",
y = "Lokasi")## Warning: Ignoring unknown aesthetics: textggplotly(plot1, tooltip = "text")Dari grafik tersebut terlihat bahwa daerah dengan demand tertinggi yaitu pada Financial District. Financial District merupakan salah satu lokasi berkumpulnya kawasan perkantoran yang bergerak dalam sistem keuangan (bank dan perkantoran mewah). Namun secara garis besar keduabelas daerah memiliki jumlah demand yang tidak jauh berbeda satu dengan yang lain.
Tren per Jam
Kemudian Kita melihat tren tiap jamnya dengan mengumpulkan data hour dan demand. Pada grafik berikut kita ingin melihat bagaimana perubahan demand yang terjadi tiap jamnya dengan rerata per jam tiap harinya pada data kita. Apakah jam terpadat merupakan waktu dimana customer berangkat kerja atau pulang kerja?
vis_2 <- df_fus %>%
group_by(hour) %>%
summarise(demand = mean(demand)) %>%
mutate(demand = round(demand,2),
popup = glue("Hour : {hour}
Demand : {demand}
"))
vis_2 <- vis_2[order(vis_2$hour, decreasing = F),]plot2 <- ggplot(vis_2, aes(x = hour, y = demand)) +
geom_segment(aes(x=hour, xend = hour, y = 0, yend=demand), color="skyblue") +
geom_point(aes(text = popup),color= "#173F5f", size=4, alpha=0.8) +
theme(legend.position = "none") +
labs(title = "Demand Tiap Jam",
x= "Jam",
y = "Demand")
ggplotly(plot2, tooltip = "text")Dari grafik tersebut dapat dilihat bahwa demand tertinggi terjadi pada jam 00.00 dan 17.00, terjadi peningkatan signifikan antara jam 9 ke jam 10. Pada kedua jam tersebut dapat berasal dari kegiatan pulang kantor baik sesuai waktu ataupun kegiatan lain hingga jam 00.00 malam.
Pola Harian
Kita juga ingin melihat pola yang terbentuk bila dalam satu minggu, kita kumpulkan data hari dan demand. Apakah hari senin yang merupakan hari pertama kerja dalam satu minggu selalu tinggi? Perubahan tren yang terjadi setiap harinya dan demand yang dominan pada hari tertentu dapat membantu kita memahami pergerakan atau kegiatan yang terjadi pada hari tersebut.
vis_3 <- df_fus %>%
select(source,datetime, day,month, demand, surge_multiplier, high) %>%
mutate(day_name = wday(df_fus$datetime, label=TRUE)) %>%
group_by(day_name) %>%
summarise(demand = mean(demand)) %>%
ungroup() %>%
mutate(demand = round(demand,2),
popup = glue("
Day : {day_name}
Demand : {demand}
"))
vis_3 <- vis_3[order(vis_3$demand, decreasing = T),]plot3 <- ggplot(vis_3, aes(x = day_name, y = demand)) +
geom_col(aes(fill=demand, text = popup)) +
scale_fill_gradient(high = "#173F5f",
low = "#3caea3") +
theme_classic() +
labs(title = "Demand tiap hari",
x= "Hari",
y = "Demand")
ggplotly(plot3, tooltip = "text")Dari grafik tersebut terlihat bahwa rerata pengguna tertinggi terjadi pada hari kamis dan pada hari rabu pengguna paling rendah. Dapat kita cermati bahwa demand pada hari libur (sabtu/minggu) lebih tinggi terhadap hari rabu dan jumat.
Komposisi Variabel Target
Data yang kita gunakan dalam machine learning adalah data tanpa padding sehingga kita membuang semua nilai demand yang bernilai 0 (demand yang bernilai 0 merupakan hasil padding)
df_clean <- df_fus %>%
mutate(day_name = wday(df_fus$datetime, label=TRUE)) %>%
filter(!demand == 0)Setelah kita hilangkan data hasil padding kemudian kita hitung jumlah value dari kolom “high”
vis_4 <- as.data.frame(table(df_clean$high)) %>%
mutate(x = 2)
names(vis_4)[1] <- "high"
names(vis_4)[2] <- "count"
vis_4 %>%
plot_ly(text = ~paste("High :", high , "<br> Count: ", count) , values = ~count, textinfo = "none", hoverinfo = "text") %>%
add_pie(hole = 0.6) %>%
layout(title = "Perbandingan Label high Berdasarkan Demand", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))Perbandingan total low demand jauh lebih besar daripada high demand.
Desain Dashboard
Halaman 1
Halaman 1 berisi penjelasan secara umum tren yang terjadi dan latar belakang masalah ## Halaman 2 
Melihat data secara geospasial dengan demand dan waktu-waktu tertentu (input each area diubah menjadi input tiap jam dan hari)
Halaman 3
penjelasan scatter plot mengenai bagaimana surge_multiple mempengaruhi harga, selain itu melihat demand tiap hari dan jam yang dapat dpilih sesuai area
Halaman 4
Halaman ini akan menjadi input dari machine learning yang akan digunakan untuk menghasilkan dan memunculkan hasil status daerah.
Halaman 5
Halaman ini berisi data pembuat
Refrensi
Arini, N., 2017. Sering Membandingkan Harga Transportasi Online? Aplikasi Ini Akan Memudahkan Penggunanya.
Yunus, M., dkk., 2019. Analisis Sistem kerja Aplikasi Transportasi Online dalam Peningkatan Kinerja Driver.