Loading packages

Our intention is to use packages from the tidyverse and other tidy packages to provide a constistant framework.

library(DT)
library(plotly)
Loading required package: ggplot2
package 㤼㸱ggplot2㤼㸲 was built under R version 3.5.1
Attaching package: 㤼㸱plotly㤼㸲

The following object is masked from 㤼㸱package:ggplot2㤼㸲:

    last_plot

The following object is masked from 㤼㸱package:stats㤼㸲:

    filter

The following object is masked from 㤼㸱package:graphics㤼㸲:

    layout
library(tidyverse) # data manipulation and visualization - loads several packages
-- Attaching packages --------------------------------------- tidyverse 1.2.1 --
-- Conflicts ------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks plotly::filter(), stats::filter()
x dplyr::lag()    masks stats::lag()
library(readr) # reading data files
library(lubridate) # working with dates

Attaching package: 㤼㸱lubridate㤼㸲

The following object is masked from 㤼㸱package:base㤼㸲:

    date
library(tibbletime)
package 㤼㸱tibbletime㤼㸲 was built under R version 3.5.1
Attaching package: 㤼㸱tibbletime㤼㸲

The following object is masked from 㤼㸱package:stats㤼㸲:

    filter
library(tidyquant)
package 㤼㸱tidyquant㤼㸲 was built under R version 3.5.1Loading required package: PerformanceAnalytics
package 㤼㸱PerformanceAnalytics㤼㸲 was built under R version 3.5.1Loading required package: xts
package 㤼㸱xts㤼㸲 was built under R version 3.5.1Loading required package: zoo
package 㤼㸱zoo㤼㸲 was built under R version 3.5.1
Attaching package: 㤼㸱zoo㤼㸲

The following objects are masked from 㤼㸱package:base㤼㸲:

    as.Date, as.Date.numeric


Attaching package: 㤼㸱xts㤼㸲

The following objects are masked from 㤼㸱package:dplyr㤼㸲:

    first, last

Version 0.4-0 included new data defaults. See ?getSymbols.
Learn from a quantmod author: https://www.datacamp.com/courses/importing-and-managing-financial-data-in-r
library(sf)
Linking to GEOS 3.6.1, GDAL 2.2.3, proj.4 4.9.3
library(tmap)
library(crosstalk)

Data munging

Load and clean ActiLife Data

Read the file and create new column which encodes data-time as a single variable.

Using tibbletime commands, we will make this dataframe “time aware”.

We are basing these manipulations off the tutorial http://www.business-science.io/code-tools/2017/10/26/demo_week_tibbletime.html .

df=read_csv("Autumn ActiLife Data.csv",skip=10)
df <- df %>% mutate(Date=mdy(Date)) %>% mutate(date_time=ymd_hms(paste(Date,Time))) %>%
  janitor::clean_names() %>%
  as_tbl_time(index = date_time)
str(df)
Classes ‘tbl_time’, ‘tbl_df’, ‘tbl’ and 'data.frame':   3468 obs. of  13 variables:
 $ date                 : Date, format: "2018-06-29" "2018-06-29" "2018-06-29" ...
 $ time                 : 'hms' num  09:15:00 09:16:00 09:17:00 09:18:00 ...
  ..- attr(*, "units")= chr "secs"
 $ axis1                : int  0 14 0 1025 449 136 1128 0 0 0 ...
 $ axis2                : int  18 9 0 1066 417 275 537 34 80 0 ...
 $ axis3                : int  0 3 0 2275 1532 706 1798 0 19 0 ...
 $ steps                : int  0 1 0 15 9 4 8 0 0 0 ...
 $ lux                  : int  0 0 0 0 0 0 0 0 0 0 ...
 $ inclinometer_off     : int  44 0 0 0 0 0 0 0 0 0 ...
 $ inclinometer_standing: int  0 0 0 60 60 56 60 60 56 59 ...
 $ inclinometer_sitting : int  0 55 60 0 0 4 0 0 4 1 ...
 $ inclinometer_lying   : int  16 5 0 0 0 0 0 0 0 0 ...
 $ vector_magnitude     : num  18 16.9 0 2713.4 1650 ...
 $ date_time            : POSIXct, format: "2018-06-29 09:15:00" "2018-06-29 09:16:00" "2018-06-29 09:17:00" ...
 - attr(*, "index_quo")= language ~date_time
  ..- attr(*, ".Environment")=<environment: 0x0000000022777db8> 
 - attr(*, "index_time_zone")= chr "UTC"

Load and clean GPS data

First we load as a data frame and create a date-time variable.

df2 <- read_csv("Autumn 7-1-18.csv") %>% mutate(Date=mdy(Date)) %>% rename(Time='Time (local)') %>%
  mutate(date_time=ymd_hms(paste(Date,Time))) %>% janitor::clean_names()
Parsed with column specification:
cols(
  Date = col_character(),
  `Time (local)` = col_time(format = ""),
  Latitude = col_double(),
  Longitude = col_double(),
  `Altitude (feet)` = col_double(),
  `Speed (mi/hr)` = col_double()
)

We convert do a tibbletime object and change the periodicity to 1 minute intervals.

We chose to average all data from time xx:xx:00-xx:xx:59, and then round down to the nearest minute

df3_tt=df2 %>%
    as_tbl_time(index = date_time) %>% 
  as_period("minutes",side="start" ) %>% mutate(date_time=floor_index(date_time,unit="minutes"))

Merge the two data frames

We will merge all of the data, recognizing that not all times exist in both data sets, but we also create dfg, which restricts to those points with gps data

dffull=full_join(df,df3_tt,by="date_time") 
dfg=right_join(df,df3_tt,by="date_time") 

Some visualizations using ggplot2

dfg %>% ggplot( aes(x=date_time, y= longitude,col=speed_mi_hr)) +geom_point(aes())
dfg %>% ggplot( aes(x=date_time, y= latitude,col=speed_mi_hr)) +geom_point(aes())
dfg %>% ggplot( aes(x=longitude, y= latitude,col=steps)) +geom_point(aes())

Creating sf object and looking at Maps

We create a sf simple features object in an xy coordinate system and plot using ggplot.

dfg1=st_as_sf(dfg, coords=c("longitude" ,"latitude"))
#dfg1 %>% ggplot(aes(col=steps)) + geom_sf() +theme_minimal()+ scale_colour_viridis_c()

We also plot this data on a tmap plot:

tmap_mode("view")
tmap mode set to interactive viewing
#tmap_mode("plot")
tm_shape(dfg1) + 
  tm_dots("inclinometer_standing")+ 
  tm_view(alpha = 1,basemaps.alpha = 1)+
  tm_basemap(c(Canvas = "Esri.WorldGrayCanvas", Imagery = "Esri.WorldImagery",OpenStreet="OpenStreetMap"))
Currect projection of shape dfg1 unknown. Long-lat (WGS84) is assumed.

Can we do a multiview plot with crosstalk?

sd=SharedData$new(dfg1)
p1=tm_shape(sd$data()) + 
  tm_dots("speed_mi_hr")+ 
  tm_view(alpha = 1,basemaps.alpha = 1)+
  tm_basemap(c(Canvas = "Esri.WorldGrayCanvas", Imagery = "Esri.WorldImagery"))
lf <- tmap_leaflet(p1)
Currect projection of shape sd$data() unknown. Long-lat (WGS84) is assumed.
p2=datatable(sd)
p3=sd %>% ggplot(aes(x=date_time,y=steps))+geom_point() 
ggplotly(p3) %>%   highlight("plotly_selected", dynamic = TRUE)
Adding more colors to the selection color palette
Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.
Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

p1=leaflet(sd) %>% addProviderTiles("OpenStreetMap") %>% addCircles()
p1

# bscols(p1,datatable(sd))
bscols(p1,ggplotly(p3) %>%   highlight("plotly_selected", dynamic = TRUE))
Adding more colors to the selection color palette
Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.
Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

#bscols( lf, ggplotly(p3) %>% highlight(color="red"))
#bscols( lf, datatable(sd))
#bscols( ggplotly(p3), datatable(sd))
LS0tDQp0aXRsZTogIkF0dGVtcHRpbmcgdG8gZGF0YSBjbGVhbiBhbmQgbWVyZ2UgQWN0aWxpZmUgYW5kIEdQUyBkYXRhIGZpbGVzIg0Kb3V0cHV0OiANCiAgaHRtbF9ub3RlYm9vazoNCiAgICAgICAgdG9jOiB5ZXMNCiAgICAgICAgdG9jX2Zsb2F0OiB0cnVlDQoNCi0tLQ0KDQojIExvYWRpbmcgcGFja2FnZXMNCg0KT3VyIGludGVudGlvbiBpcyB0byB1c2UgcGFja2FnZXMgZnJvbSB0aGUgdGlkeXZlcnNlIGFuZCBvdGhlciAqdGlkeSogcGFja2FnZXMgdG8gcHJvdmlkZSBhIGNvbnN0aXN0YW50IGZyYW1ld29yay4gICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIA0KDQpgYGB7cn0NCmxpYnJhcnkoRFQpDQpsaWJyYXJ5KHBsb3RseSkNCmxpYnJhcnkodGlkeXZlcnNlKSAjIGRhdGEgbWFuaXB1bGF0aW9uIGFuZCB2aXN1YWxpemF0aW9uIC0gbG9hZHMgc2V2ZXJhbCBwYWNrYWdlcw0KbGlicmFyeShyZWFkcikgIyByZWFkaW5nIGRhdGEgZmlsZXMNCmxpYnJhcnkobHVicmlkYXRlKSAjIHdvcmtpbmcgd2l0aCBkYXRlcw0KbGlicmFyeSh0aWJibGV0aW1lKQ0KbGlicmFyeSh0aWR5cXVhbnQpDQpsaWJyYXJ5KHNmKQ0KbGlicmFyeSh0bWFwKQ0KbGlicmFyeShjcm9zc3RhbGspDQpsaWJyYXJ5KGxlYWZsZXQpDQoNCg0KYGBgDQoNCiMgRGF0YSBtdW5naW5nDQoNCiMjIExvYWQgYW5kIGNsZWFuIEFjdGlMaWZlIERhdGENCg0KUmVhZCB0aGUgZmlsZSBhbmQgY3JlYXRlIG5ldyBjb2x1bW4gd2hpY2ggZW5jb2RlcyBkYXRhLXRpbWUgYXMgYSBzaW5nbGUgdmFyaWFibGUuDQoNClVzaW5nIGB0aWJibGV0aW1lYCBjb21tYW5kcywgd2Ugd2lsbCBtYWtlIHRoaXMgZGF0YWZyYW1lICJ0aW1lIGF3YXJlIi4NCg0KV2UgYXJlIGJhc2luZyB0aGVzZSBtYW5pcHVsYXRpb25zIG9mZiB0aGUgdHV0b3JpYWwgDQpodHRwOi8vd3d3LmJ1c2luZXNzLXNjaWVuY2UuaW8vY29kZS10b29scy8yMDE3LzEwLzI2L2RlbW9fd2Vla190aWJibGV0aW1lLmh0bWwgLg0KDQoNCmBgYHtyIHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRX0NCmRmPXJlYWRfY3N2KCJBdXR1bW4gQWN0aUxpZmUgRGF0YS5jc3YiLHNraXA9MTApDQpkZiA8LSBkZiAlPiUgbXV0YXRlKERhdGU9bWR5KERhdGUpKSAlPiUgbXV0YXRlKGRhdGVfdGltZT15bWRfaG1zKHBhc3RlKERhdGUsVGltZSkpKSAlPiUNCiAgamFuaXRvcjo6Y2xlYW5fbmFtZXMoKSAlPiUNCiAgYXNfdGJsX3RpbWUoaW5kZXggPSBkYXRlX3RpbWUpDQoNCg0Kc3RyKGRmKQ0KYGBgDQoNCiMjIExvYWQgYW5kIGNsZWFuIEdQUyBkYXRhDQoNCkZpcnN0IHdlIGxvYWQgYXMgYSBkYXRhIGZyYW1lIGFuZCBjcmVhdGUgYSBkYXRlLXRpbWUgdmFyaWFibGUuDQoNCg0KDQpgYGB7cn0NCmRmMiA8LSByZWFkX2NzdigiQXV0dW1uIDctMS0xOC5jc3YiKSAlPiUgbXV0YXRlKERhdGU9bWR5KERhdGUpKSAlPiUgcmVuYW1lKFRpbWU9J1RpbWUgKGxvY2FsKScpICU+JQ0KICBtdXRhdGUoZGF0ZV90aW1lPXltZF9obXMocGFzdGUoRGF0ZSxUaW1lKSkpICU+JSBqYW5pdG9yOjpjbGVhbl9uYW1lcygpDQoNCg0KYGBgDQoNCldlIGNvbnZlcnQgZG8gYSB0aWJibGV0aW1lIG9iamVjdCBhbmQgY2hhbmdlIHRoZSBwZXJpb2RpY2l0eSB0byAxIG1pbnV0ZSBpbnRlcnZhbHMuICANCg0KV2UgY2hvc2UgdG8gYXZlcmFnZSBhbGwgZGF0YSBmcm9tIHRpbWUgeHg6eHg6MDAteHg6eHg6NTksIGFuZCB0aGVuIHJvdW5kIGRvd24gdG8gdGhlIG5lYXJlc3QgbWludXRlDQoNCmBgYHtyfQ0KDQpkZjNfdHQ9ZGYyICU+JQ0KICAgIGFzX3RibF90aW1lKGluZGV4ID0gZGF0ZV90aW1lKSAlPiUgDQogIGFzX3BlcmlvZCgibWludXRlcyIsc2lkZT0ic3RhcnQiICkgJT4lIG11dGF0ZShkYXRlX3RpbWU9Zmxvb3JfaW5kZXgoZGF0ZV90aW1lLHVuaXQ9Im1pbnV0ZXMiKSkNCg0KDQoNCmBgYA0KDQojIyBNZXJnZSB0aGUgdHdvIGRhdGEgZnJhbWVzDQoNCldlIHdpbGwgbWVyZ2UgYWxsIG9mIHRoZSBkYXRhLCByZWNvZ25pemluZyB0aGF0IG5vdCBhbGwgdGltZXMgZXhpc3QgaW4gYm90aCBkYXRhIHNldHMsIGJ1dCB3ZSBhbHNvIGNyZWF0ZSBgZGZnYCwgd2hpY2ggcmVzdHJpY3RzIHRvIHRob3NlIHBvaW50cyB3aXRoIGdwcyBkYXRhDQoNCmBgYHtyfQ0KZGZmdWxsPWZ1bGxfam9pbihkZixkZjNfdHQsYnk9ImRhdGVfdGltZSIpIA0KDQpkZmc9cmlnaHRfam9pbihkZixkZjNfdHQsYnk9ImRhdGVfdGltZSIpIA0KDQpgYGANCg0KIyBTb21lIHZpc3VhbGl6YXRpb25zIHVzaW5nIGdncGxvdDINCg0KYGBge3IgZXZhbD1GQUxTRX0NCmRmZyAlPiUgZ2dwbG90KCBhZXMoeD1kYXRlX3RpbWUsIHk9IGxvbmdpdHVkZSxjb2w9c3BlZWRfbWlfaHIpKSArZ2VvbV9wb2ludChhZXMoKSkNCg0KYGBgDQoNCmBgYHtyIGV2YWw9RkFMU0V9DQpkZmcgJT4lIGdncGxvdCggYWVzKHg9ZGF0ZV90aW1lLCB5PSBsYXRpdHVkZSxjb2w9c3BlZWRfbWlfaHIpKSArZ2VvbV9wb2ludChhZXMoKSkNCg0KYGBgDQoNCmBgYHtyIGV2YWw9RkFMU0V9DQpkZmcgJT4lIGdncGxvdCggYWVzKHg9bG9uZ2l0dWRlLCB5PSBsYXRpdHVkZSxjb2w9c3RlcHMpKSArZ2VvbV9wb2ludChhZXMoKSkNCg0KYGBgDQoNCiMgQ3JlYXRpbmcgc2Ygb2JqZWN0IGFuZCBsb29raW5nIGF0IE1hcHMNCg0KV2UgY3JlYXRlIGEgKnNmKiBzaW1wbGUgZmVhdHVyZXMgb2JqZWN0IGluIGFuIGB4eWAgY29vcmRpbmF0ZSBzeXN0ZW0gYW5kIHBsb3QgdXNpbmcgZ2dwbG90Lg0KDQpgYGB7cn0NCmRmZzE9c3RfYXNfc2YoZGZnLCBjb29yZHM9YygibG9uZ2l0dWRlIiAsImxhdGl0dWRlIikpDQoNCiNkZmcxICU+JSBnZ3Bsb3QoYWVzKGNvbD1zdGVwcykpICsgZ2VvbV9zZigpICt0aGVtZV9taW5pbWFsKCkrIHNjYWxlX2NvbG91cl92aXJpZGlzX2MoKQ0KDQpgYGANCg0KV2UgYWxzbyBwbG90IHRoaXMgZGF0YSBvbiBhIGB0bWFwYCBwbG90Og0KDQpgYGB7cn0NCnRtYXBfbW9kZSgidmlldyIpDQojdG1hcF9tb2RlKCJwbG90IikNCnRtX3NoYXBlKGRmZzEpICsgDQogIHRtX2RvdHMoImluY2xpbm9tZXRlcl9zdGFuZGluZyIpKyANCiAgdG1fdmlldyhhbHBoYSA9IDEsYmFzZW1hcHMuYWxwaGEgPSAxKSsNCiAgdG1fYmFzZW1hcChjKENhbnZhcyA9ICJFc3JpLldvcmxkR3JheUNhbnZhcyIsIEltYWdlcnkgPSAiRXNyaS5Xb3JsZEltYWdlcnkiLE9wZW5TdHJlZXQ9Ik9wZW5TdHJlZXRNYXAiKSkNCg0KYGBgDQoNCg0KIyBDYW4gd2UgZG8gYSBtdWx0aXZpZXcgcGxvdCB3aXRoIGNyb3NzdGFsaz8NCg0KDQpgYGB7cn0NCg0Kc2Q9U2hhcmVkRGF0YSRuZXcoZGZnMSkNCg0KDQoNCnAxPXRtX3NoYXBlKHNkJGRhdGEoKSkgKyANCiAgdG1fZG90cygic3BlZWRfbWlfaHIiKSsgDQogIHRtX3ZpZXcoYWxwaGEgPSAxLGJhc2VtYXBzLmFscGhhID0gMSkrDQogIHRtX2Jhc2VtYXAoYyhDYW52YXMgPSAiRXNyaS5Xb3JsZEdyYXlDYW52YXMiLCBJbWFnZXJ5ID0gIkVzcmkuV29ybGRJbWFnZXJ5IikpDQoNCmxmIDwtIHRtYXBfbGVhZmxldChwMSkNCg0KcDI9ZGF0YXRhYmxlKHNkKQ0KDQpwMz1zZCAlPiUgZ2dwbG90KGFlcyh4PWRhdGVfdGltZSx5PXN0ZXBzKSkrZ2VvbV9wb2ludCgpIA0KDQoNCg0KZ2dwbG90bHkocDMpICU+JSAgIGhpZ2hsaWdodCgicGxvdGx5X3NlbGVjdGVkIiwgZHluYW1pYyA9IFRSVUUpDQoNCg0KcDE9bGVhZmxldChzZCkgJT4lIGFkZFByb3ZpZGVyVGlsZXMoIk9wZW5TdHJlZXRNYXAiKSAlPiUgYWRkQ2lyY2xlcygpDQoNCnAxDQoNCiMgYnNjb2xzKHAxLGRhdGF0YWJsZShzZCkpDQoNCmJzY29scyhwMSxnZ3Bsb3RseShwMykgJT4lICAgaGlnaGxpZ2h0KCJwbG90bHlfc2VsZWN0ZWQiLCBkeW5hbWljID0gVFJVRSkpDQoNCiNic2NvbHMoIGxmLCBnZ3Bsb3RseShwMykgJT4lIGhpZ2hsaWdodChjb2xvcj0icmVkIikpDQoNCiNic2NvbHMoIGxmLCBkYXRhdGFibGUoc2QpKQ0KDQojYnNjb2xzKCBnZ3Bsb3RseShwMyksIGRhdGF0YWJsZShzZCkpDQoNCmBgYA0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg==