Skip to content

Commit

Permalink
bug fix:
Browse files Browse the repository at this point in the history
1. map background not printing.  see rstudio/leaflet#192 for fix--adding url to addTiles()

2. fixed function for downloading all metadata
  • Loading branch information
Painter committed Mar 27, 2018
1 parent 4677bda commit d667738
Show file tree
Hide file tree
Showing 2 changed files with 95 additions and 59 deletions.
128 changes: 81 additions & 47 deletions Desktop_Review.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ output:
editor_options:
chunk_output_type: console
params:
origin_login_file: training_kenya
origin_login_file: training_sierra_leone
cache: TRUE
echo: FALSE
---
Expand Down Expand Up @@ -154,12 +154,14 @@ Results shown are for data accessed on **`r format(date_metadata, "%d %B %Y") `*
metadata_attributes = map_df( md[names(md)], ~length(.x$id) ) %>%
gather( attribute, value ) %>% # columns to rows
mutate( value = comma( value ) ) %>% # format numbers
kable( align = c( 'l', 'r' ), 'html' ) %>%
kable_styling( bootstrap_options = c("striped", "hover") ) %>%
column_spec(1, bold = T)
mutate( value = comma( value ) ) # format numbers
metadata_attributes
metadata_attributes %>%
kable( align = c( 'l', 'r' ), 'html' ) %>%
kable_styling( bootstrap_options = c("striped", "hover") ) %>%
column_spec(1, bold = T) %>%
scroll_box(height = "500px")
```

Expand Down Expand Up @@ -341,8 +343,9 @@ NB: Focus on data elements for malaria, patients, ...
conf = grepl( 'conf' , de$name , ignore.case = TRUE )
susp = grepl( 'susp' , de$name , ignore.case = TRUE )
patients = grepl( 'patient' , de$name , ignore.case = TRUE )
mal.conf = de[ mal & conf, display.vars ] %>%
# any malaria element
de.mal = de[ mal, display.vars ] %>%
rename( categoryCombo.id = categoryCombo ) %>%
mutate( lastUpdated = format( ymd_hms( lastUpdated ), '%b %Y' ) ) %>%
Expand All @@ -363,33 +366,71 @@ NB: Focus on data elements for malaria, patients, ...
rename( Group = name ) %>%
unnest ,
by = 'id'
)
)
kable( select(mal.conf , name, Group, zeroIsSignificant, lastUpdated, categoryCombo ),
kable(
select( de.mal ,
name, Group, zeroIsSignificant, lastUpdated, categoryCombo
) %>%
rename( dataElement = name ) %>%
arrange( Group , dataElement),
'html' ,
caption = "Confirmed malaria data elements" ) %>%
caption = "Confirmed malaria data elements" ) %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
column_spec(1, bold = T)
mal.susp = de[ mal & susp, display.vars ] %>%
rename( categoryCombo.id = categoryCombo ) %>%
mutate( lastUpdated = format( ymd_hms( lastUpdated ), '%b %Y' ) ) %>%
left_join(
select( md$categoryCombos, id, name, categories ) %>%
rename(categoryCombo.id = id,
categoryCombo = name ,
category.id = categories
) ,
by = 'categoryCombo.id'
)
column_spec(1, bold = T)
kable( select( mal.susp, name, zeroIsSignificant, lastUpdated, categoryCombo ),
'html' ,
caption = 'Suspected malaria data elements' ) %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
column_spec(1, bold = T)
# # confirmed malaria elements ####
# mal.conf = de[ mal & conf, display.vars ] %>%
# rename( categoryCombo.id = categoryCombo ) %>%
# mutate( lastUpdated = format( ymd_hms( lastUpdated ), '%b %Y' ) ) %>%
#
# # categoryCombos
# left_join(
# select( md$categoryCombos, id, name, categories ) %>%
# rename(categoryCombo.id = id,
# categoryCombo = name ,
# category.id = categories
# ) ,
# by = 'categoryCombo.id'
# ) %>%
#
# # dataElementGroups
# left_join(
# md$dataElementGroups %>%
# select( name, dataElements) %>%
# rename( Group = name ) %>%
# unnest ,
# by = 'id'
# )
#
#
#
# kable( select(mal.conf , name, Group, zeroIsSignificant, lastUpdated, categoryCombo ),
# 'html' ,
# caption = "Confirmed malaria data elements" ) %>%
# kable_styling(bootstrap_options = c("striped", "hover")) %>%
# column_spec(1, bold = T)
#
# # suspected malaria elements ####
# mal.susp = de[ mal & susp, display.vars ] %>%
# rename( categoryCombo.id = categoryCombo ) %>%
# mutate( lastUpdated = format( ymd_hms( lastUpdated ), '%b %Y' ) ) %>%
# left_join(
# select( md$categoryCombos, id, name, categories ) %>%
# rename(categoryCombo.id = id,
# categoryCombo = name ,
# category.id = categories
# ) ,
# by = 'categoryCombo.id'
# )
#
# kable( select( mal.susp, name, zeroIsSignificant, lastUpdated, categoryCombo ),
# 'html' ,
# caption = 'Suspected malaria data elements' ) %>%
# kable_styling(bootstrap_options = c("striped", "hover")) %>%
# column_spec(1, bold = T)
```

Expand Down Expand Up @@ -422,12 +463,7 @@ NB: more description of total vs details for each data element--need to list
# find_dataset_for_element( mal.conf[1, 'id' ] )
# Datasets with malaria dataElements included
# data elements:
de.mal = bind_rows( mal.conf , mal.susp )
# NB : There may be duplicate rows in de.mal because the same elements belong to multiple groups.
# NB : There may be duplicate rows in de.mal because the same elements belong to multiple groups.
# Compare with de.mal %>% select(-Group) %>% distinct()
Expand Down Expand Up @@ -548,10 +584,8 @@ Count the org units assigned to each form, which is the basis for the number of
} else {
# data elements:
de.mal.conf.total = paste( mal.conf$id , collapse = ";" )
de.mal.susp.total = paste( mal.susp$id , collapse = ";" )
de.mal.total = paste( de.mal$id , collapse = ";" )
# login in to server
retry( login() )
Expand All @@ -572,11 +606,9 @@ Count the org units assigned to each form, which is the basis for the number of
"&dimension=ou:", levels.vector[level] ,
"&dimension=pe:" , periods.vector[i] ,
"&dimension=dx:" ,
#suspected
de.mal.susp.total , ";" ,
# confirmed
de.mal.conf.total ,
# malaria
de.mal.total ,
# opd summary
# "KNrK5VWTZkx;NLKRV7bYbVy" , # population
"&displayProperty=NAME")
Expand Down Expand Up @@ -981,7 +1013,9 @@ d = left_join( clinics ,
factpal <- colorFactor( brewer_pal("qual", 2)(7), data$level)
leaflet( d ) %>%
addTiles( ) %>%
addTiles( urlTemplate =
"http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
) %>%
addCircleMarkers(
~long, ~lat,
radius = ~value.scale ,
Expand Down
26 changes: 14 additions & 12 deletions dhis2_functions.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,19 @@ loginDHIS2<-function(baseurl,username,password) {
r<-GET(url,authenticate(username,password))
assert_that(r$status_code == 200L) }


## gets json text from url and converts to data frame
get = function( source_url , ...){

g = fromJSON( suppressMessages(
content( GET( source_url ), "text") )
)

return( g )

}


metadataDHIS2 = function(
baseurl ,
element, # e.g. data_elements, indicators, osu
Expand All @@ -17,8 +30,7 @@ loginDHIS2<-function(baseurl,username,password) {
if (element %in% 'all'){

url<-paste0(baseurl,"api/metadata.json")
get_met = GET(url)
met = fromJSON(get_met)
met = get( url )


}
Expand Down Expand Up @@ -254,16 +266,6 @@ loginDHIS2<-function(baseurl,username,password) {
))
}

## gets json text from url and converts to data frame
get = function( source_url , ...){

g = fromJSON( suppressMessages(
content( GET( source_url ), "text") )
)

return( g )

}

# Retry function to use when querying database
# borrowed from: https://stackoverflow.com/questions/20770497/how-to-retry-a-statement-on-error
Expand Down

0 comments on commit d667738

Please sign in to comment.