knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.height = 3, fig.width = 7 ) require(ggplot2) require(reshape2) require(knitr) require(lubridate) require(dplyr)
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()
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()
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/milesmcbain/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") }
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") }
## 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") }
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.