R/sankey.R

In eamoakohene/beamaSankey: Plot Sankey Diagrams

SK<- R6::R6Class(
    'SK',
    inherit = sankey_utils,
    public = list(
        yr = NULL,
        mth = NULL,
        grp = NULL,


        initialize = function(grp,yr,mth){

            self$set_yr(yr)
            self$set_mth(mth)
            self$set_group(grp)

        },

        set_yr = function(value){
            if( !missing(value) && !is.null(value)){
                self$yr <- value
            }
            invisible(self)
        },

        set_mth = function(value){
            if(!missing(value) && !is.null(value)){
                self$mth <- value
            }
            invisible(self)
        },

        set_group = function(value){
            if(!missing(value) && !is.null(value)){
                self$grp <- value
            }
            invisible(self)
        },

        get_data = function(){

            my_data <- self$get_sq()$set_name('sk_get_group')$set_params(
                list(
                    `@s_grp`= self$grp,
                    `@i_yr` = self$yr,
                    `@i_mth` = self$mth
                )
            )$qry_exec()


            if( nrow(my_data)>0 ){
                my_data$source <- as.integer( my_data$source )
                my_data$target <- as.integer( my_data$target)
                my_data$value <- as.numeric( my_data$value )
                my_data$name <- as.factor( my_data$name )
            }
            return(my_data)
        },

        view_groups = function(is_detail=TRUE){

            my_data <- NULL


            if(!is_detail){
                my_data <- self$get_sq()$set_name('sk_view_group')$qry_exec()
            }else{
                my_data <- self$get_sq()$set_name('sk_view_group_dt')$qry_exec()
            }

            return(my_data)
        },

        plot = function(output_filename = NULL, font_size = 12){

            my_sankey_df <- self$get_data()
            save_output <- TRUE
            save_path <- output_filename

            if(is.null( output_filename ) ){ save_output <- FALSE}

            my_sankey_links <-  dplyr::filter(
                my_sankey_df[ , c('source', 'target', 'value')] ,
                !is.na(value)
            )

            names( my_sankey_links ) <- c('source','target','value')

            my_sankey_names <- dplyr::filter(

                data.frame(
                    name = my_sankey_df[,c('name')]
                ) ,
                !(name=='NA')
            )



            nwk <- networkD3::sankeyNetwork(

                  Links = my_sankey_links,
                  Nodes = my_sankey_names,
                  Source = "source",
                  Target = "target",
                  Value = "value",
                  NodeID = "name",
                  fontSize = font_size,
                  nodeWidth = 30

            )

            if(save_output){
                networkD3::saveNetwork(nwk,save_path)
            }
            return(nwk)
        }



    ),#public
    private = list(

    )#private

)#SK

## non-class functions

add_row <- sankey_add_rows <- function(
    sk_group,
    sk_yr,
    sk_mth,
    sk_name,
    sk_source,
    sk_target,
    sk_value,
    sk_sort
){

    sankey_utils$new()$get_sq()$set_name('sk_add_row')$set_params(
       list(
            `@s_grp`= sk_group,
            `@i_yr` = sk_yr,
            `@i_mth` = sk_mth,
            `@s_name` = sk_name,
            `@s_source` = sk_source,
            `@s_target` = sk_target,
            `@s_value` = sk_value,
            `@i_sort`= sk_sort
        )
    )$qry_exec()
}#add_row



remove_row <- sk.remove_row <- sk_remove_row <- function(
    sk_group,
    sk_yr,
    sk_mth,
    sk_name
){


    sankey_utils$new()$get_sq()$set_name('sk_remove_row')$set_params(
        list(
            `@s_grp`= sk_group,
            `@i_yr` = sk_yr,
            `@i_mth` = sk_mth,
            `@s_name` = sk_name
        )
    )$qry_exec()

}#remove_row


remove_group <- sk.remove_group <-sk_remove_group <- function(
    sk_group,
    sk_yr,
    sk_mth
){

    sankey_utils$new()$get_sq()$set_name('sk_remove_group')$set_params(
        list(
            `@s_grp`= sk_group,
            `@i_yr` = sk_yr,
            `@i_mth` = sk_mth
        )
    )$qry_exec()
}#remove_group


sk_plot<- sk.plot <- function(grp, yr, mth, save_path= NULL, db_is_local = T){

    abc <- SK$new()$set_db_mode( db_is_local )

    if( is.null( save_path )){
        abc$set_group( grp )$set_yr( yr )$set_mth( mth )$plot()
    }else{
        abc$set_group( grp )$set_yr( yr )$set_mth( mth )$plot( save_path )
    }

}

sk.view_groups <- function(is_detail=TRUE){

    SK$new()$view_groups( is_detail = is_detail)

}