In MilesMcBain/r2vr: Compose and Serve WebVR Scenes

  knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.height = 3,
  fig.width = 7
  )
require(ggplot2)
require(reshape2)
require(knitr)
require(lubridate)
require(dplyr)

R objects for building A-Frame Scenes with Interactive Entities

New additions to r2vr now include interactive entities that store the outputs into a database. So far there are two question types. The first is a binary question with options for 1 or 0 as responses. The second is a multivariable response question with four answer options.

binary_question_scene()
multivariable_question_scene()

Case Study 1: Koalas

First you will need to install ACEMS/r2vr into your R library. Also you will need to set up a data base on db4free with the same class name. For this example our class name is koala.

Next you will need to know your local IP address on your computer. You can find this by opening a command window (cmd) and running the command ipconfig and the IP address next to IPv4 Address is what you need. OR use find_IP() function in our r2vr package.

library(r2vr)

## Other packages for data handling and visualisation
library(ggplot2)
library(reshape2)
library(knitr)
library(lubridate)
library(dplyr)

## Find the IPv4 Address
IPv4_ADDRESS <- find_IP()

Create experiment

You will need a folder of VR compatible images to use. Set up a variable that lists the paths to each image.

## Full path to image web locations
r2vr_pkg <- "https://cdn.jsdelivr.net/gh/ACEMS/r2vr@master/inst"

## Append to get full paths to images
img_paths <- paste(r2vr_pkg,
                   c("/ext/images/koalas/Site_1.jpg", 
                     "/ext/images/koalas/Site_2.jpg", 
                     "/ext/images/koalas/Site_3.jpg", 
                     "/ext/images/koalas/Site_4.jpg"),
                   sep = "")

For this experiment we wish to ask a question with a yes or no answer so we will use binary_question_scene().

animals <- binary_question_scene(
  the_question = "Do you see any koalas in this image?", # Our question
  answer_1 = "Yes",  # Text for '1'
  answer_2 = "No",   # Text for '0'
  img_paths = img_paths, # Image paths
  IPv4_ADDRESS = IPv4_ADDRESS, # Our local IP address
  animal_class = "koala" # Class name for database 
)

Let's start the VR server. Copy and paste your IP address into an internet browswer after running the below command.

start(IPv4_ADDRESS)

Now the participant should be viewing the VR server in an internet browser on desktop or in a VR headset. Once the participant is immersed into the scene, we can now 'pop' the question.

pop()

The question and answer boxes should pop up on the displayed image. This command will only work once the scene is displayed. For the binary question, once an answer is selected it will be locked in so that answers are not duplicated for each participant for the same image.

Next we will want to move to the next image with the below command.

go(image_paths = img_paths, index = 2) # going to the second image

Again we pop the question and wait for the participant to answer.

pop()

We can also 'unpop' to remove the question and answer boxes.

pop(F)

When you are done with your image set, simply use the below command to close the server.

end()

Time for the exciting part which is to import our elicitation data. Note that the end of the url is our animal class (koala).

## Get data from database with API GET request
koala.df <- read(url = "https://test-api-koala.herokuapp.com/koala")
if(!is.null(nrow(koala.df))){
  koala.df$recordedOn <- lubridate::ymd_hms(koala.df$recordedOn, tz = "Australia/Queensland")
  knitr::kable(tail(koala.df))
  ## Tidy dataframe for plotting
  koala.df <- dplyr::mutate(koala.df, 
                            binary_response = dplyr::case_when(binary_response == 0 ~ "No",
                                                               binary_response == 1 ~ "Yes",
                                                               TRUE ~ "unknown"))

  ## Basic visualisation of data
  ggplot2::ggplot(koala.df, aes(fill = as.factor(binary_response), x = image_id)) + 
    geom_bar(colour = "black") + 
    theme_bw() + 
    labs(fill = "Do you see any\nkoalas in this image?") + 
    ggtitle("Koala presence response")
}

Case Study 2: The Great Barrier Reef

Repeat for reef case study.

## Define image paths
img_paths <- paste(r2vr_pkg, 
                   c("/ext/images/reef/100030039.jpg", 
                     "/ext/images/reef/120261897.jpg", 
                     "/ext/images/reef/130030287.jpg", 
                     "/ext/images/reef/130050093.jpg"), 
                   sep = "")

## Create binary qestion scene for animals
animals <- binary_question_scene(
  the_question = "Do the live corals on this reef form a structurally complex habitat?", 
  answer_1 = "Yes", 
  answer_2 = "No", 
  img_paths = img_paths, 
  IPv4_ADDRESS = IPv4_ADDRESS, 
  animal_class = "reef")

## Launch VR server
start(IPv4_ADDRESS)

## Pop a question for first scene
pop()

## Move to new scene
go(image_paths = img_paths, index = 3)

## Don't forget to pop the question!
pop()

## Finish
end()

## Get data from database with API GET request
reef.df <- read(url = "https://test-api-koala.herokuapp.com/reef")
## Check for empty data frame
if(!is.null(nrow(reef.df))){
  reef.df$recordedOn <-  lubridate::ymd_hms(reef.df$recordedOn, tz = "Australia/Queensland")
  knitr::kable(tail(reef.df))
  ## Tidy dataframe for plotting
  reef.df <- dplyr::mutate(reef.df,  
                           binary_response = dplyr::case_when(binary_response == 0 ~ "No",
                                                              binary_response == 1 ~ "Yes",
                                                              TRUE ~ "unknown"))

  ## Basic visualisation of data
  ggplot2::ggplot(reef.df, aes(fill = as.factor(binary_response), x = image_id)) + 
    geom_bar(colour = "black") + 
    theme_bw() + 
    labs(fill = "Do the live corals\non this reef form a\nstructurally complex\nhabitat?") + 
    ggtitle("Structurally Complex Coral Habitat")
}

Case Study 3: Jaguars

## Define image paths
img_paths <- paste(r2vr_pkg,
                   c("/ext/images/jaguars/WP14_360_002.jpg", 
                     "/ext/images/jaguars/WP55_360_001.jpg", 
                     "/ext/images/jaguars/WP56_360_001.jpg",
                     "/ext/images/jaguars/WP60_360_001.jpg"),
                   sep = "")

animals <- multivariable_question_scene(
  the_question = "Do you see any of these habitat features in this image? If you do see a feature, click on the box to select it.",
  answer_1 = "Water", 
  answer_2 = "Jaguar tracks", 
  answer_3 = "Scratch marks", 
  answer_4 = "Dense Vegetation", 
  img_paths = img_paths, IPv4_ADDRESS)

## Launch VR server
start(IPv4_ADDRESS)

## Pop a question for first scene
pop(question_type = "multivariable")

## Move to new scene
go(image_paths = img_paths, index = 4, question_type = "multivariable")

## Don't forget to pop the question!
pop(question_type = "multivariable")

## Finish
end()

## Get data from database with API GET request
jaguar.df <- read(url = "https://test-api-koala.herokuapp.com/jaguar")
## Check for empty data frame
if(!is.null(nrow(jaguar.df))){
  jaguar.df$recordedOn <-  lubridate::ymd_hms(jaguar.df$recordedOn, 
                                              tz = "Australia/Queensland")
  knitr::kable(tail(jaguar.df))
  ## Tidy dataframe for plotting
  jaguar.df <- dplyr::mutate(
    dplyr::filter(
      reshape2::melt(
        jaguar.df, measure.vars = c("option_1", "option_2", "option_3","option_4")), 
      value == 1), 
    response = dplyr::case_when(variable == "option_1" ~ "Water",
                                variable == "option_2" ~ "Jaguar tracks",
                                variable == "option_3" ~ "Scratch marks",
                                variable == "option_4" ~ "Dense vegetation",
                                TRUE ~ "unknown"))

  ## Basic visualisation of data
  ggplot2::ggplot(jaguar.df,aes(x = image_id, fill = response)) +
    geom_bar(position = "dodge", colour = "black") +
    facet_grid(cols = vars(image_id), scales = "free") +
    theme_bw() +
    labs(fill = "Observed\nhabitat\nfeatures") +
    ggtitle("Jaguar Habitat Features")
}