R/migration.R

In yikeshu0611/mapit: Heat Map, Bubble Map and Migration Map

#' Plot Migration Map
#'
#' @param data data
#' @param shapename shape name variable
#' @param group group varaible
#' @param choice default is NULL
#' @param color.variable color variable
#' @param size.variable size variable
#' @param type.variable type variable
#' @param lgd.color.title colored legend title
#' @param lgd.size.title sized legend title
#' @param lgd.type.title typed legend title
#' @param size size for all line, default is 1
#' @param color color, which be more than one, default is black and red
#' @param type line type, default is 2
#' @param fill fill color for base map
#' @param border.color map border color
#' @param border.size map border size
#' @param basemap logical, default is TRUE
#' @return a ggplot2 migration map
#' @export
#'
#' @examples
#' plot(1:10)
migration<-function(data,
                     shapename,
                     choice=NULL,
                     group=NULL,
                     color.variable=NULL,
                     size.variable=NULL,
                     type.variable=NULL,
                     lgd.color.title=NULL,
                     lgd.size.title=NULL,
                     lgd.type.title=NULL,
                     size=1,
                     color=c('black','red'),
                     type=2,
                     fill='#e5e5e5',
                     border.color='black',
                     border.size=0.5,
                     basemap=TRUE){
    res=checkname(data = data,shapename = shapename,choice = choice)
    map.ready0=res$map.ready0
    data=res$data
    if (!is.null(group)){
        #data prepare
        variable=c(shapename,group)
        k.color=is.null(color.variable)
        k.size=is.null(size.variable)
        k.type=is.null(type.variable)
        if (!k.color) variable=c(variable,color.variable)
        if (!k.size) variable=c(variable,size.variable)
        if (!k.type) variable=c(variable,type.variable)
        variable=unique(variable)
        dd.value=data[,variable]
        map.ready=merge(x=map.ready0,y=dd.value,by.x='Name',by.y=shapename)
        map.df=data.frame(map.ready,check.names = FALSE)
        map.ready
        map.df
        ####plot
        if (basemap){
            p0<-ggplot(data = map.ready) +
                geom_sf(color=border.color,size=border.size,fill=fill) +
                theme(plot.background = element_blank())+
                geom_sf_line(aes_string(group=group))+
                theme_half_open()
            p0
        }else{
            p0<-ggplot(data = map.ready) +
                geom_sf(color=NA,size=NA,fill=NA) +
                theme(plot.background = element_blank())+
                geom_sf_line(aes_string(group=group))+
                theme_half_open()
            p0
        }
        #title
        if (is.null(lgd.color.title)) lgd.color.title=color.variable
        if (is.null(lgd.size.title)) lgd.size.title=size.variable
        if (is.null(lgd.type.title)) lgd.type.title=type.variable
        #0:NULL
        if (k.color & k.size & k.type){
            p_line=p0
        }
        #1: color
        if (!k.color & k.size & k.type){
            p_line=p0+geom_sf_line(aes_string(group=group,
                                              color=color.variable),
                                   size=size,
                                   linetype=type)
            if (is.numeric(map.df[,color.variable])){
                p_line<-p_line+scale_color_gradientn(name=lgd.color.title,
                                                     colours = color)
            }else{
                p_line<-p_line+scale_color_manual(name=lgd.color.title,
                    values = colorRampPalette(color)(length(unique(map.df[,color.variable]))))
            }
        }
        #1:size
        if (k.color & !k.size & k.type){
            p_line<-p0+geom_sf_line(aes_string(group=group,
                                               size=size.variable),
                                    color=color[1],
                                    linetype=type)
            if (is.numeric(map.df[,size.variable])){
                p_line<-p_line+scale_size(name=lgd.size.title)
            }else{
                p_line<-p_line+scale_size_discrete(name=lgd.size.title)
            }
            p_line
        }
        #1:type
        if (k.color & k.size & !k.type){
            p_line=p0+geom_sf_line(aes_string(group=group,
                                              linetype=factor(map.df[,type.variable])),
                                   color=color[1],
                                   size=size)
            p_line<-p_line+scale_linetype(name=lgd.type.title)

        }
        #2:color and size
        if (!k.color & !k.size & k.type){
            p_line<-p0+geom_sf_line(aes_string(group=group,
                                               color=color.variable,
                                               size=size.variable),
                                    linetype=type)
            if (is.numeric(map.df[,size.variable])){
                p_line<-p_line+scale_size(name=lgd.size.title)
            }else{
                p_line<-p_line+scale_size_discrete(name=lgd.size.title)
            }
            if (is.numeric(map.df[,color.variable])){
                p_line<-p_line+scale_color_gradientn(name=lgd.color.title,
                                                     colours = color)
            }else{
                p_line<-p_line+scale_color_manual(name=lgd.color.title,
                    values = colorRampPalette(color)(length(unique(map.df[,color.variable]))))
            }
            p_line
        }
        #2:color and type
        if (!k.color & k.size & !k.type){
            p_line<-p0+geom_sf_line(aes_string(group=group,
                                               color=color.variable,
                                               linetype=factor(map.df[,type.variable])),
                                    size=size)
            if (is.numeric(map.df[,color.variable])){
                p_line<-p_line+scale_color_gradientn(name=lgd.color.title,
                                                     colours = color)
            }else{
                p_line<-p_line+scale_color_manual(name=lgd.color.title,
                    values = colorRampPalette(color)(length(unique(map.df[,color.variable]))))
            }
            p_line<-p_line+scale_linetype(name=lgd.type.title)
            p_line
        }
        #2:size and type
        if (k.color & !k.size & !k.type){
            p_line<-p0+geom_sf_line(aes_string(group=group,
                                               size=size.variable,
                                               linetype=factor(map.df[,type.variable])),
                                    color=color[1])
            if (is.numeric(map.df[,size.variable])){
                p_line<-p_line+scale_size(name=lgd.size.title)
            }else{
                p_line<-p_line+scale_size_discrete(name=lgd.size.title)
            }
            p_line<-p_line+scale_linetype(name=lgd.type.title)
            p_line
        }
        #3:all
        if (!k.color & !k.size & !k.type){
            p_line<-p0+geom_sf_line(aes_string(group=group,
                                               size=size.variable,
                                               linetype=factor(map.df[,type.variable]),
                                               color=color.variable))
            if (is.numeric(map.df[,color.variable])){
                p_line<-p_line+scale_color_gradientn(name=lgd.color.title,
                                                     colours = color)
            }else{
                p_line<-p_line+scale_color_manual(name=lgd.color.title,
                                                  values = color)
            }
            if (is.numeric(map.df[,size.variable])){
                p_line<-p_line+scale_size(name=lgd.size.title)
            }else{
                p_line<-p_line+scale_size_discrete(name=lgd.size.title)
            }
            p_line<-p_line+scale_linetype(name=lgd.type.title)
            p_line
        }
    }else{
        if (basemap){
            p_line<-ggplot(data = map.ready0) +
                geom_sf(color=border.color,size=border.size,fill=fill) +
                geom_sf_line()+
                theme_half_open()
            p_line
        }else{
            p_line<-ggplot(data = map.ready0) +
                geom_sf(color=NA,size=NA,fill=NA) +
                geom_sf_line()+
                theme_half_open()
            p_line
        }
    }
    p_line<-p_line+
        theme(axis.title = element_blank())
    return(p_line)
}