Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

GEL test bug fixes #9

Merged
merged 14 commits into from
Oct 21, 2020
Merged

GEL test bug fixes #9

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
dd2d5ca
base url to api server
sk-sahu Oct 9, 2020
2b44a9a
plot color aligning with platform
sk-sahu Oct 13, 2020
e218ee4
readme updates with new changes
sk-sahu Oct 13, 2020
0707f96
always return defualt columns untill and end point is ready from backend
sk-sahu Oct 13, 2020
1be6109
refactor the dataframe creation
sk-sahu Oct 13, 2020
de0832a
Unit test data modification
sk-sahu Oct 13, 2020
c2cadfa
minor fix
sk-sahu Oct 13, 2020
1998dff
updates to cohort list function
sk-sahu Oct 13, 2020
8f29f50
handeling null description
sk-sahu Oct 16, 2020
bb5414e
minor fix
sk-sahu Oct 16, 2020
9e02c56
value filter josn create fix
sk-sahu Oct 16, 2020
b85a597
manuall josn convert with auto_unbox = F
sk-sahu Oct 16, 2020
256dab7
minor fix
sk-sahu Oct 16, 2020
e240e8d
unit test fixes
sk-sahu Oct 16, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion R/cb_class.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ setClass("cohort",
)

.get_cohort_info <- function(cloudos, cohort_id) {
url <- paste(cloudos@base_url, "api/v1/cohort", cohort_id, sep = "/")
url <- paste(cloudos@base_url, "v1/cohort", cohort_id, sep = "/")
r <- httr::GET(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id)
Expand Down
2 changes: 1 addition & 1 deletion R/cb_create_cohort.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ cb_create_cohort <- function(cloudos, cohort_name, cohort_desc, filters = "") {
cohort_desc = list()
}

url <- paste(cloudos@base_url, "api/v1/cohort/", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/", sep = "/")
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id),
Expand Down
28 changes: 15 additions & 13 deletions R/cb_extract_cohort.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ cb_get_genotypic_table <- function(cloudos,
# "values" = type)
# filters = list(chr_filt, type_filt)

url <- paste(cloudos@base_url, "api/v1/cohort/genotypic-data", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/genotypic-data", sep = "/")
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id),
Expand Down Expand Up @@ -82,16 +82,18 @@ cb_get_samples_table <- function(cloudos,
search <- .get_search_json(my_cohort)
}
# make request
url <- paste(cloudos@base_url, "api/v1/cohort/participants/search", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/participants/search", sep = "/")
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id),
body = list("pageNumber" = page_number,
"pageSize" = page_size,
"columns" = columns,
"search" = search,
"returnTotal" = FALSE),
encode = "json"
body = jsonlite::toJSON(
list("pageNumber" = page_number,
"pageSize" = page_size,
#"columns" = columns, # TODO
sk-sahu marked this conversation as resolved.
Show resolved Hide resolved
"search" = search,
"returnTotal" = FALSE),
auto_unbox = T),
encode = "raw"
)
if (!r$status_code == 200) {
stop("Something went wrong. Not able to create a cohort")
Expand All @@ -100,13 +102,13 @@ cb_get_samples_table <- function(cloudos,
res <- httr::content(r)
# into a dataframe
df_list <- list()
for (n in 1:length(res$data)) {
dta <- do.call(cbind, res$data[[n]])
df_list[[n]] <- as.data.frame(dta)
for (n in res$data) {
dta <- do.call(cbind, n)
df_list <- c(df_list, list(as.data.frame(dta)))
}
res_df <- dplyr::bind_rows(df_list)
# remove mongodb _id column
res_df_new <- subset(res_df, select = (c(-`_id`)))
res_df_new <- subset(res_df, select = -c(`_id`))
return(res_df_new)
}

Expand All @@ -126,7 +128,7 @@ cb_get_samples_table <- function(cloudos,
#'
#' @export
cb_extract_samples <- function(cloudos, raw_data) {
url <- paste(cloudos@base_url, "api/v1/cohort/participants/export", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/participants/export", sep = "/")
# TODO work on raw_data - Find an end point that returns this and make a json in R
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
Expand Down
10 changes: 5 additions & 5 deletions R/cb_filter_cohort.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@
#' @export
cb_search_phenotypic_filters <- function(cloudos,
term){
url <- paste(cloudos@base_url, "api/v1/cohort/fields_search", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/fields_search", sep = "/")
r <- httr::GET(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id,
Expand Down Expand Up @@ -62,7 +62,7 @@ cb_get_filter_statistics <- function(cloudos, cohort, filter_id ) {
"cohortId" = cohort@id
)
# make request
url <- paste(cloudos@base_url, "api/v1/cohort/filter", filter_id, "data", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/filter", filter_id, "data", sep = "/")
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id),
Expand Down Expand Up @@ -136,7 +136,7 @@ cb_filter_participants <-function(cloudos, cohort, filter_id ) {
"cohortId" = cohort@id
)
# make request
url <- paste(cloudos@base_url, "api/v1/cohort/filter/participants", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/filter/participants", sep = "/")
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id),
Expand Down Expand Up @@ -178,7 +178,7 @@ cb_genotypic_save <- function(cloudos, cohort, filter_id ) {
"cohortId" = cohort@id
)
# make request
url <- paste(cloudos@base_url, "api/v1/cohort/genotypic-save", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/genotypic-save", sep = "/")
r <- httr::POST(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id),
Expand Down Expand Up @@ -207,7 +207,7 @@ cb_genotypic_save <- function(cloudos, cohort, filter_id ) {
#'
#' @export
cb_filter_metadata <- function(cloudos, filter_id) {
url <- paste(cloudos@base_url, "api/v1/cohort/filter", filter_id, "metadata", sep = "/")
url <- paste(cloudos@base_url, "v1/cohort/filter", filter_id, "metadata", sep = "/")
r <- httr::GET(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id)
Expand Down
8 changes: 5 additions & 3 deletions R/cb_json.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,10 @@
# make a value vector
my_values <- c()
for(i in 1:length(more_fields$value)){
value_id <- as.numeric(more_fields$value[[i]][1])
my_values <- c(my_values, fields$field$values[[as.character(value_id)]])
value_id <- as.character(more_fields$value[[i]][1])
field_value <- fields$field$values[[value_id]]
if(is.null(field_value)) field_value <- value_id
my_values <- c(my_values, field_value)
}
# make search json
search = list("column" = list("id" = jsonlite::unbox(more_fields$fieldId),
Expand Down Expand Up @@ -74,7 +76,7 @@

############################################################################################
# Column JOSN
# TODO work on column - not able to find end-point that returns this information
# TODO work on column - At this point NO end-point that returns this information, there are cards
sk-sahu marked this conversation as resolved.
Show resolved Hide resolved

.get_column_json <- function(){
columns <-
Expand Down
37 changes: 21 additions & 16 deletions R/cb_list_cohorts.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,7 @@
#'
#' @param cloudos A cloudos object. (Required)
#' See constructor function \code{\link{connect_cloudos}}
#' @param page_number Number of page. (Optional) Default - 0
#' @param page_size Number of entries in a page. (Optional) Default - 10
#' @param size Number of cohort entries from database. (Optional) Default - 10
#'
#' @return A data frame with available cohorts.
#'
Expand All @@ -15,32 +14,38 @@
#' }
#' @export
cb_list_cohorts <- function(cloudos,
page_number = 0,
page_size = 10) {
url <- paste(cloudos@base_url, "api/v1/cohort", sep = "/")
size = 10) {
url <- paste(cloudos@base_url, "v1/cohort", sep = "/")
r <- httr::GET(url,
.get_httr_headers(cloudos@auth),
query = list("teamId" = cloudos@team_id,
"pageNumber" = page_number,
"pageSize" = page_size))
"pageNumber" = 0,
"pageSize" = size))
if (!r$status_code == 200) {
stop("No cohorts found. Or not able to connect with server.")
}
# parse the content
res <- httr::content(r)
message("Total number of cohorts found-", res$total,
". But here is 10. For more, change 'page_number' and 'page_size'")
if(size == 10){
message("Total number of cohorts found-", res$total,
". But here shows-", size," as default. For more, change size = ", res$total, " to get all.")
}
cohorts <- res$cohorts
# make in to a list
cohorts_list <- list()
for (n in 1:page_size) {
for (n in 1:length(cohorts)) {

# For empty description backend returns two things NULL and ""
description = cohorts[[n]]$description
if(is.null(description)) description = "" # change everything to ""

dta <- data.frame(id = cohorts[[n]]$`_id`,
name = cohorts[[n]]$`name`,
description = cohorts[[n]]$`description`,
number_of_participants = cohorts[[n]]$`numberOfParticipants`,
number_of_filters = cohorts[[n]]$`numberOfFilters`,
created_at = cohorts[[n]]$`createdAt`,
updated_at = cohorts[[n]]$`updatedAt`)
name = cohorts[[n]]$name,
description = description,
number_of_participants = cohorts[[n]]$numberOfParticipants,
number_of_filters = cohorts[[n]]$numberOfFilters,
created_at = cohorts[[n]]$createdAt,
updated_at = cohorts[[n]]$updatedAt)
cohorts_list[[n]] <- dta
# filter
# cohorts[[1]]$`filters`
Expand Down
22 changes: 14 additions & 8 deletions R/cb_plots.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ cb_plot_filters <- function(cloudos, cohort){
geom_bar(stat="identity") + coord_flip() +
labs(title= fields_name) +
scale_fill_manual(values = filtered_values_colour) +
theme_bw() +
theme_classic() +
theme(legend.position="none")
}else if(ncol(filter_df) == 3){ ############################### range - histogram
# to make sure we getting morefileds for same filter as fields
Expand All @@ -66,10 +66,12 @@ cb_plot_filters <- function(cloudos, cohort){
plot_list[[filter_id]] <- ggplot(data=filtered_range_colour_df, aes(x=range, y=number)) +
geom_histogram(stat="identity", fill= filtered_range_colour_df$color_value) +
scale_x_discrete(limits = filtered_range_colour_df$range) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
theme_classic() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line( size=.1, color="black")) +
labs(title= fields_name) +
xlab(label = "range") +
theme_bw()
xlab(label = "range")
}else{
sk-sahu marked this conversation as resolved.
Show resolved Hide resolved
stop("Unknown filter type. Accepts 'bar' and 'histogram' only.")
}
Expand All @@ -79,6 +81,10 @@ cb_plot_filters <- function(cloudos, cohort){
return(plot_list)
}

# cloudos colour code
# selected filters - #94C3C1 (bit darker bluegreen)
# Unselested filters - #C8EAD6 (light green)

.filtered_values_colour <- function(more_fields, fields){
# make a value vector
my_values <- c()
Expand All @@ -94,9 +100,9 @@ cb_plot_filters <- function(cloudos, cohort){
my_value_color <- c()
for(i in all_values){
if(i %in% my_values){
my_value_color <- c(my_value_color, "green")
my_value_color <- c(my_value_color, "#94C3C1")
}else{
my_value_color <- c(my_value_color, "lightgreen")
my_value_color <- c(my_value_color, "#C8EAD6")
}
}
return(my_value_color)
Expand All @@ -107,8 +113,8 @@ cb_plot_filters <- function(cloudos, cohort){
range_from <- more_fields$range$from
range_to <- more_fields$range$to
new_df <- df %>%
mutate(color_value = case_when(range > range_from & range < range_to ~ "green",
TRUE ~ "lightgreen"))
mutate(color_value = case_when(range > range_from & range < range_to ~ "#94C3C1",
TRUE ~ "#C8EAD6"))

return(new_df)
}
Expand Down
3 changes: 3 additions & 0 deletions R/cloudos_class.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,9 @@ connect_cloudos <- function(base_url, auth, team_id){
auth_method = "API Key" # default
}

# remove the tailing slash
base_url = sub("/$","",base_url)

cloudos_class_obj <- methods::new("cloudos",
base_url = base_url,
auth_method = auth_method,
Expand Down
2 changes: 1 addition & 1 deletion README.Rmd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ To interact with the cloudos server, it require few login details.
Note: If no `base_url` given the default is https://cloudos.lifebit.ai/

```{r}
cb_base_url <- "http://cohort-browser-766010452.eu-west-1.elb.amazonaws.com"
cb_base_url <- "http://cohort-browser-766010452.eu-west-1.elb.amazonaws.com/api"
my_auth <- "your_apikey"
my_team_id <- "your_team_id"
# OR from environment variable stored in a ~/.Renviron file
Expand Down
Loading