# allocativ 3001.2021.0002

# Map Step 1: Import Multi-Layer Data
mp1 = 'Map Step 1: Import and Clean Data'

### Import and Join Labels (W) with Predictors (X) and Outcomes (Y)
df_W = read.csv('_data/FIPS_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_X = read.csv('_data/_learn_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_Y = read.csv('_data/_spatial_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_WX = merge(df_W, df_X, by = 'ZCTA', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_WXY = merge(df_WX, df_Y, by.x = 'ZCTA', all.x = TRUE) # Merge data frame into data slot in SpatialDataFrame
head(df_WXY) # Verify

### Join with Shapes (Z)
sdf_Z = readOGR(dsn = '_shape/CENSUS_TIGER_2018_ZCTA', layer = 'cb_2018_us_zcta510_500k') # Import shape file with rgdal package
sdf_Z$ZCTA = as.character(sdf_Z$GEOID10) # Convert numeric to character
sdf_Z$ZCTA = paste('ZCTA', sdf_Z$ZCTA, sep = '') # Add character string to each value in column
library(sp) # Reimport sp library for merge() function
sdf_WXYZ = merge(sdf_Z, df_WXY, by = 'ZCTA') # Merge data frame into data slot in SpatialDataFrame
sdf_WXYZ = sdf_WXYZ[which(sdf_WXYZ$ST == ST & sdf_WXYZ$population >= 0), ]
head(sdf_WXYZ) #Verify
sdf_WXYZ # Show SpatialDataFrame

### Import and Join Labels (W2) with Predictors (X2) and Outcomes (Y2) for 2nd Layer
df_W2 = read.csv('_data/FIPS_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_W2$ZCTA <- df_W2$ZIP <- NULL # delete variables v3 and v5
df_W2a = aggregate(df_W2$population, by = list(FIPS = df_W2$FIPS), FUN = sum)
df_W2 = merge(df_W2, df_W2a, by = 'FIPS', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_W2$population <- df_W2$x
df_W2$x <- NULL # delete variables v3 and v5
df_W2 = unique(df_W2)
df_X2 = read.csv('_data/_learn_FIPS.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_Y2 = read.csv('_data/_spatial_FIPS.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_WX2 = merge(df_W2, df_X2, by = 'FIPS', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_WXY2 = merge(df_WX2, df_Y2, by = 'FIPS', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
head(df_WXY2) # Verify

### Join with Shapes (Z2)
sdf_Z2 = readOGR(dsn = '_shape/CENSUS_TIGER_2018_FIPS', layer = 'tl_2020_us_county') # County shapefiles
sdf_Z2$FIPS = as.character(sdf_Z2$GEOID) # Convert numeric to character
sdf_Z2$FIPS = paste('FIPS', sdf_Z2$FIPS, sep = '') # Add character string to each value in column
library(sp) # Reimport sp library for merge() function
sdf_WXYZ2 = merge(sdf_Z2, df_WXY2, by = 'FIPS') # Merge data frame into data slot in SpatialDataFrame
sdf_WXYZ2 = sdf_WXYZ2[which(sdf_WXYZ2$ST == ST & sdf_WXYZ2$population >= 0), ]
head(sdf_WXYZ2) #Verify
sdf_WXYZ2 # Show SpatialDataFrame

### Export to Summary File
sink(file = 'summary.txt', append = TRUE, type = 'output')
cat(c(mp1, '\n\n'), file = 'summary.txt', append = TRUE)
cat(c('Selected States: ', states, '\n'), file = 'summary.txt', append = TRUE)
cat(c('Observations: ', nrow(df_WXY), '\n\n'), file = 'summary.txt', append = TRUE)
print(sdf_WXYZ)
cat(c('\n'), file = 'summary.txt', append = TRUE)
cat(c('Observations (Layer 2): ', nrow(df_WXY2), '\n\n'), file = 'summary.txt', append = TRUE)
print(sdf_WXYZ2)
cat(c('\n'), file = 'summary.txt', append = TRUE)
cat(c('####################', '\n\n'), file = 'summary.txt', append = TRUE)
sink()

## Map Step 2: Make State Maps
mp2 = 'Map Step 2: Make State Maps'

### Define State Layer
state = 'Florida' # State abbreviation for map focus

### Define ZCTA Layer
sdf <- sdf_WXYZ # Subset spatial data frame by variable above
data = sdf@data # Data slot from SpatialPolygonDataFrame using variable above
ZCTA = fortify(sdf, region = 'ZCTA') # Create fortified data object containing SpatialPolygons from SpatialPolygonDataFrame and variables above
names(ZCTA)[names(ZCTA) == 'id'] <- 'ZCTA' # Rename column in base R
fort = merge(ZCTA, data, by = 'ZCTA')
head(fort)

### Define County Layer
sdf_2 <- sdf_WXYZ2 # Subset spatial data frame by variable above
data_2 = sdf_2@data # Data slot from SpatialPolygonDataFrame using variable above
FIPS = fortify(sdf_2, region = 'FIPS') # Create fortified data object containing SpatialPolygons from SpatialPolygonDataFrame and variables above
names(FIPS)[names(FIPS) == 'id'] <- 'FIPS' # Rename column in base R
fort_2 = merge(FIPS, data_2, by = 'FIPS')
head(fort_2)

### Create Maps (traditional)
low = 'blue3' # Standard map colorscheme
mid = 'lightyellow' # Standard map colorscheme
high = 'red3' # Standard map colorscheme
na = 'white' # Standard map colorscheme
breaks = 9 # Standard map colorscheme
scheme = 'trad'

#### Crude Rate
rate = 'crude' # Column label for outcome of interest
col_rate = fort$crude # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'per 1000'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort,
            aes(fill = crude,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Standardized Mortality Ratio
rate = 'standardized' # Column label for outcome of interest
col_rate = fort$SMR # Column in SpatialPolygonDataFrame where outcome is located
desc_rate = 'Crude counts / Expected counts'
median = median(col_rate, na.rm = TRUE)
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort,
            aes(fill = SMR,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Local Empirical Bayes Smoothed
rate = 'smoothed' # Column label for outcome of interest
col_rate = fort$bayes # Column in SpatialPolygonDataFrame where outcome is located
desc_rate = 'smoothed by population'
median = median(col_rate, na.rm = TRUE)
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort,
            aes(fill = bayes,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Log transformed crude rate
rate = 'log' # Column label for outcome of interest
col_rate = fort$crude # Column in SpatialPolygonDataFrame where outcome is located
median = log(median(col_rate, na.rm = TRUE))
desc_rate = 'log per 1000'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort,
            aes(fill = crude,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            trans = rate,
            breaks = waiver(),
            n.breaks = breaks,
            midpoint = median,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Local Health index
rate = 'health' # Column label for outcome of interest
col_rate = fort$health # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'aggregate health index'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort,
            aes(fill = health,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            breaks = waiver(),
            n.breaks = breaks,
            midpoint = median,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Local SDOH index
rate = 'social' # Column label for outcome of interest
col_rate = fort$social # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'aggregate SDOH index'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort,
            aes(fill = social,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            breaks = waiver(),
            n.breaks = breaks,
            midpoint = median,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Crude Rate (County)
rate = 'crude' # Column label for outcome of interest
col_rate = fort_2$crude # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'per 1000'
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = crude,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Log transformed Crude Rate (County)
rate = 'log' # Column label for outcome of interest
col_rate = fort_2$crude # Column in SpatialPolygonDataFrame where outcome is located
median = log(median(col_rate, na.rm = TRUE))
desc_rate = 'log per 1000'
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = crude,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            trans = rate,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Standardized Mortality Ratio (County)
rate = 'standardized' # Column label for outcome of interest
col_rate = fort_2$SMR # Column in SpatialPolygonDataFrame where outcome is located
desc_rate = 'Crude counts / Expected counts'
median = median(col_rate, na.rm = TRUE)
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = SMR,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Local Empirical Bayes Smoothed (County)
rate = 'smoothed' # Column label for outcome of interest
col_rate = fort_2$bayes # Column in SpatialPolygonDataFrame where outcome is located
desc_rate = 'smoothed by population'
median = median(col_rate, na.rm = TRUE)
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = bayes,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### LISA Quadrants
rate = 'LISA' # Column label for outcome of interest
col_rate = fort_2$LISA # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'hot/cold spots'
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = LISA,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Weighted Coefficients (County)
rate = 'GWR' # Column label for outcome of interest
col_rate = fort_2$GWR # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'Impact of local health'
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = GWR,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

##### Gini Index (County)
rate = 'gini' # Column label for outcome of interest
col_rate = fort_2$gini # Column in SpatialPolygonDataFrame where outcome is located
median = median(col_rate, na.rm = TRUE)
desc_rate = 'level of unequal distribution among Zip Codes'
layer = 'FIPS'
base = ggplot() +
        geom_polygon(
            data = fort_2,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = 'cyan',
            colour = NA,
            size = 0.1,
            alpha = 0.1,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        labs(
            title = paste(outcome, 'in', State, sep = " "),
            subtitle = paste('2019 ', rate, ' rate | ', author, ' | ', day, sep = ''),
            caption = paste(reference, 'Accessed:', day, fill = ' '),
            fill = desc_rate) +
        north(
            fort_2,
            scale = 0.1,
            symbol = 3,
            location = 'bottomleft') +
        theme(
            text = element_text(family = 'Bookman'),
            plot.background = element_blank(),
            plot.title = element_text(size = 20),
            plot.subtitle = element_text(size = 10),
            plot.caption = element_text(size = 6),
            legend.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
layer1 = base +
        geom_polygon(
            data = fort_2,
            aes(fill = gini,
                x = long,
                y = lat,
                group = group),
                alpha = 0.9,
                colour = 'darkslategray',
                size = 0.1) +
        geom_path() +
        coord_equal() +
        scale_fill_gradient2(
            low = low,
            mid = mid,
            high = high,
            na.value = na,
            midpoint = median,
            breaks = waiver(),
            n.breaks = breaks,
            guide = 'legend') +
        theme(
            legend.position = c(0.05, 0.25),
            legend.justification = c('left', 'bottom'),
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
top = layer1 +
        geom_polygon(
            data = fort,
            aes(
                x = long,
                y = lat,
                group = group),
            fill = NA,
            colour = 'gray10',
            size = 0.1,
            alpha = 0.9,
            show.legend = FALSE) +
        geom_path() +
        coord_equal() +
        theme(
            plot.background = element_blank(),
            panel.background = element_blank(),
            axis.title = element_blank(),
            axis.text = element_blank(),
            axis.ticks = element_blank())
ggsave(paste('_fig/', ST, '_', rate, '_', scheme, '_', layer, '_map.png', sep = ''), dpi = 1000) # Export ggplot to png file with variables above

### Create Maps (soft)
low = 'dodgerblue4' # Standard map colorscheme
mid = 'seashell' # Standard map colorscheme
high = 'tomato4' # Standard map colorscheme
na = 'white' # Standard map colorscheme
breaks = 9 # Standard map colorscheme
scheme = 'soft'

### Create Maps (bright)
low = 'turquoise2' # Standard map colorscheme
mid = 'snow' # Standard map colorscheme
high = 'deeppink2' # Standard map colorscheme
na = 'white' # Standard map colorscheme
breaks = 9 # Standard map colorscheme
scheme = 'bright'

### Create Maps (alternate)
low = 'chartreuse3' # Standard map colorscheme
mid = 'ivory' # Standard map colorscheme
high = 'magenta3' # Standard map colorscheme
na = 'white' # Standard map colorscheme
breaks = 9 # Standard map colorscheme
scheme = 'alternate'


#' Generate patient-specific bitstrings from adaptive network walk.
#'
#' This function calculates the bitstrings (1 is a hit; 0 is a miss) associated with the adaptive network walk
#' made by the diffusion algorithm trying to find the variables in the encoded subset, given the background knowledge graph.
#' @param S - A character vector of node names describing the node subset to be encoded.
#' @param ranks - The list of node ranks calculated over all possible nodes, starting with each node in subset of interest.
#' @return pt.byK - a list of bitstrings, with the names of the list elements the node names of the encoded nodes
#' @export multiNode.getPtBSbyK
#' @examples
#' # Get bitstrings associated with each patient's top kmx variable subsets
#' kmx = 15
#' ptBSbyK = list()
#' for (pt in 1:ncol(data_mx)) {
#'   S = data_mx[order(abs(data_mx[,pt]), decreasing=TRUE),pt][1:kmx]
#'   ptBSbyK[[ptID]] = multiNode.getPtBSbyK(S, ranks)
#' }
multiNode.getPtBSbyK = function(S, ranks) {
  ranks2 = ranks[which(names(ranks) %in% S)]
  pt.bitString = list()
  for (p in 1:length(ranks2)) {
    pt.bitString[[S[p]]] = as.numeric(ranks2[[S[p]]] %in% S)
    names(pt.bitString[[S[p]]]) = ranks2[[S[p]]]
    ind = which(pt.bitString[[S[p]]] == 1)
    pt.bitString[[S[p]]] = pt.bitString[[S[p]]][1:ind[length(ind)]]
  }
  # For each k, find the ranks that found at least k in S. Which found the first k soonest?
  pt.byK = list()
  for (k in 1:length(S)) {
    pt.byK_tmp = pt.bitString
    # Which found at least k nodes
    bestInd = vector("numeric", length(S))
    for (p in 1:length(S)) {
      bestInd[p] = sum(pt.bitString[[p]])
    }
    if (length(which(bestInd>=k))>0) {
      pt.byK_tmp = pt.byK_tmp[which(bestInd>=k)]
      # Which found the most nodes soonest
      bestInd = vector("numeric", length(pt.byK_tmp))
      for (p in 1:length(pt.byK_tmp)) {
        bestInd[p] = sum(which(pt.byK_tmp[[p]] == 1)[1:k])
      }
      maxInd = max(which(pt.byK_tmp[[which.min(bestInd)]] == 1)[1:k])
      pt.byK[[k]] = pt.byK_tmp[[which.min(bestInd)]][1:maxInd]
    } else {
      pt.byK[[k]] = pt.byK_tmp[[which.max(bestInd)]]
    }
  }

  return(pt.byK)
}


#' Translate an axis between two sets of identifiers
#'
#' @param x      A matrix
#' @param from   Names that match the dimension `along`
#' @param to     Names that this dimension should be summarized to
#' @param along  Along which axis to summarize
#' @param ...    Parameters passed to `match`
#' @param FUN    Which function to apply, default is throwing error on aggregation
#' @return       A summarized matrix as defined by `from`, `to`
#' @export
translate = function(x, along=1, to, from=dimnames(x)[[along]], ...,  FUN) {
    lookup = match(dimnames(x)[[along]], from=from, to=to, ..., na_rm=TRUE)
    x = subset(x, index=names(lookup), along=along)

    # aggregate the rest using fun
    re = split(x, along=along, subsets=lookup)
    re = lapply(re, function(j) map(j, along, FUN, drop=FALSE))
    bind(re, along=along)
}


pdf_file<-"pdf/networks_riverplot.pdf"

cairo_pdf(bg="white", pdf_file, width=12,height=12)
par(omi=c(1,1.95,1,1.95), mai=c(0,0,0,0), family="Lato Light")

library(riverplot)
library(RColorBrewer)

# Import data and prepare chart

xreg_flow<-read.csv("myData/xreg_flow.csv", stringsAsFactors=F)

edges <- rep(xreg_flow, col.names = c("N1", "N2", "Value"))
edges    <- data.frame(edges, stringsAsFactors=F)
edges$ID <- 1:81

regionen<-c("from Latin America and Caribbean","from Northern America","from Africa","from Europe","from Eastern Europe","from Western Asia","from Southern Asia","from Eastern Asia","from Oceania","to Latin America and Caribbean","to Northern America","to Africa","to Europe","to Eastern Europe","to Western Asia","to Southern Asia","to Eastern Asia","to Oceania")

nodes <- data.frame(ID = regionen, stringsAsFactors=F)

nodes$x <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2)

edges2 <- edges[ edges$N1 %in% nodes$ID & edges$N2 %in% nodes$ID, ]
edges2$ID <- as.character(edges2$ID)
edges2 <- edges2[nrow(edges2):1,]

nodes2 <- nodes[ match(unique(c(edges2$N1, edges2$N2)), nodes$ID), ]
nodes2$col <- rep(brewer.pal(9, "Blues")[2:9], 2)
sel <- gsub("from ", "", edges2$N1) == gsub("to ", "", edges2$N2)
node_styles <- sapply(edges2$ID[ sel ], function(x) list(horizontal=TRUE), simplify=F)
r <- makeRiver( nodes2, edges2, node_labels = "", node_styles=node_styles)

# Create chart

par(lty=0)
myplot <- riverplot(r, col = nodes2$col, srt=0 , plot_area = 1, fix.pdf=T)

colnames(myplot) <- gsub("and", "\\\nand", colnames(myplot))
oldpar <- par(xpd=NA)
sel <- grep("^from", colnames(myplot))
text(myplot["x",sel] - strwidth("X"), myplot["center", sel], colnames(myplot)[sel], pos=2)
sel <- grep("^to", colnames(myplot))
text(myplot["x",sel] + strwidth("X"), myplot["center", sel], colnames(myplot)[sel], pos=4)

# Titling

mtext("Migration 2010-2015", side=3, outer=T, cex=3, line=1, col="grey30", family="Lato Black")
mtext("All figures in millions. Data Source: https://github.com/cran/migest/tree/master/inst/vidwp",1,line=2, font=3, outer=T)

dev.off()


#import functions from other script files!
source('import_test.r')
?source
my_test(4,5)

#to see hidden files in a directory:   ls -a

my_test = function(x, y ){
	x**y
}


pdf_file<-"pdf/radial_polygons_2x3b.pdf"
cairo_pdf(bg="grey98", pdf_file,width=12,height=12)

par(mfcol=c(2,3),omi=c(1,0.5,1,0.5),mai=c(0,0,0,0),cex.axis=0.9,cex.lab=1,xpd=T,col.axis="green",col.main="red",family="Lato Light",las=1)

library(plotrix)
library(gdata)

# Import data and prepare chart

myRegions<-read.xls("myData/worldenergymix.xlsx", encoding="latin1")
row.names(myRegions)<-myRegions$Region
myRegions$Region<-NULL
myLabelling<-c("Oil","Coal","Gas","Renewable E.","Nuclear Energy")

myRegions<-myRegions[, c(1,3,2,4,5)]
myLabelling<-myLabelling[c(1,3,2,4,5)]

# Create charts

for (i in 2:nrow(myRegions))
{
radial.plot(rep(100/length(myRegions),length(myRegions)),labels=myLabelling,rp.type="p",main="",line.col="grey",show.grid=T,show.grid.labels=F,radial.lim=c(0,55),poly.col="grey")
radial.plot(myRegions[i,],labels="",rp.type="p",main="",line.col="red",show.grid=F,radial.lim=c(0,55),poly.col="red",add=T)
mtext(row.names(myRegions)[i],line=2,family="Lato Black")
}

# Titling

mtext("World energy mix",line=2,cex=3,family="Lato Black",outer=T,adj=0)
mtext(line=-1,"Shares of different energy types in total energy use",cex=1.5,font=3,outer=T,adj=0)
mtext(side=1, "Source: German Federal Agency for Civic Education: keyword 'Enegiemix' [energy mix], www.bpb.de [website in German]",line=2,cex=1.3,font=3,outer=T,adj=1)
dev.off()


##
## Fit Bayesian GLMs
##
# devtools::install_github("standev/loo")  # install dev version of loo to calculate model weights

source("init if necessary.r")

flog.info("Started social network analysis - degree and gifts")

library(rstanarm)
library(gridExtra)
library(bayesplot)
library(loo)

options(mc.cores = parallel::detectCores())

#########################################################################################################
## Prepare data
##
d.gift = na.omit( subset(herders, NamedInNetmap==1, select=c(NumGifts, CoopGiven.OtherReport)) )

#########################################################################################################
## Plot degree distributions
##
# these functions are the same as rethinking::simplehist() but without requiring the user to install the rethinking package...
plot_self = function() plot(table(subset(herders, HerderID %in% netmappers_list)$CoopGiven.SelfReport),
                            ylab="Frequency", xlab="Self-reported cooperation given", main=("(a)"))

plot_other = function() plot(table(subset(herders, HerderID %in% netmappers_list)$CoopGiven.OtherReport),
                             ylab="", xlab="Cooperation given (reported by others)", main=("(b)"))

png(file.path(plots.dir, "degree distribution - cooperation network.png"), height=10, width=20, units="cm", res=300)
  par(mfrow=c(1,2))
  plot_self()
  plot_other()
dev.off()

pdf(file.path(plots.dir, "degree distribution - cooperation network.pdf"), height=5, width=10)
  par(mfrow=c(1,2))
  plot_self()
  plot_other()
dev.off()

par(mfrow=c(1,1))  # reset

#########################################################################################################
## Model specifications
## - univariate model specifications for each outcome
## - intercept-only and negative binomial (if Poisson) models will also be fitted from these univariate specs
## - all models will use the same priors
##
# cooperation given by ego, reported by others (out-degree in `g.netmap.i`)
f.gift.coop = as.formula("NumGifts ~ CoopGiven.OtherReport")

#########################################################################################################
## Functions:
## 1. fit models
## 2. analyse/plot model predictions
##

#' Fit Bayesian social analysis Poisson models
#'
#' @param d The data
#' @param f The formula
#' @param type The link function (default: Poisson)
#' @param fit.nb Fit a negative binomial model (default: true)?
#'
#' @return stanreg object of the best-fitting model
#'
fit_sna_models = function(d, f, type=poisson, fit.nb=T) {
  # fit models
  m = list()
  m[[1]] = stan_glm(update(f, . ~ 1), data=d, family=type,
                    prior=normal(0,2), prior_intercept=normal(0,5),
                    chains=1, iter=10000, warmup=2000, cores=2)

  m[[2]] = stan_glm(f, data=d, family=type,
                    prior=normal(0,2), prior_intercept=normal(0,5),
                    chains=1, iter=10000, warmup=2000, cores=2)

  if (fit.nb)
    m[[3]] = update(m[[2]], family = neg_binomial_2)

  # model comparison
  log_liks = list()
  for (i in 1:length(m))
    log_liks[[i]] = log_lik(m[[i]])

  m.w = model_weights(log_liks)

  return(list(
    best_model = m[[ which.max(m.w) ]],
    weights = m.w
  ))
}

#' Plot predictions from SNA models
#'
#' @param m stanreg model
#' @param d the data
#' @param param string, name of variable used for predictions
#' @param param_labels string, what to label `param` on the parameter estimates plot
#' @param response string, name of the response variable (probably 'NumGifts')
#' @param x_label string, what to label the x axis
#' @param y_label string, what to label the y axis
#'
#' @return list containing two ggplots: the parameter estimates and the prediction plot
#'
plot_sna_model = function(m, d, param="", param_labels="", response="NumGifts",
                          x_label="", y_label="No. gifts received") {

  # construct a new univariate dataframe for generating predictions
  newdata = data.frame(seq(from = min(d[[param]]), to = max(d[[param]]), length.out=10))
  names(newdata) = param

  post = posterior_predict(m, newdata = newdata)
  pred = posterior_linpred(m, newdata = newdata, transform=T)

  quants = apply(post, 2, quantile, probs = c(0.025, 0.5, 0.975))  # quantiles over mcmc samples
  quants2 = apply(pred, 2, quantile, probs = c(0.025, 0.5, 0.975))  # quantiles over mcmc samples
  row.names(quants) = c("sim.lwr", "sim.med", "sim.upr")
  row.names(quants2) = c("lwr", response, "upr")

  newdata = cbind(newdata, t(quants), t(quants2))

  # get dataframe of posterior samples, rename to prettier labels, and exponentiate
  draws = as.data.frame(m)
  names(draws) = c("Intercept", param_labels)
  #draws = exp(draws)

  # plot prediction intervals
  # this will go in the top-left corner of the predictions plot
  options(bayesplot.base_size = 20, bayesplot.base_family = "sans")
  color_scheme_set("pink")
  pi = mcmc_intervals(draws, prob=0.8, prob_outer=0.97) #+ labs(subtitle = "Interval estimates")

  # colour for plotting
  pinkish = rgb(224, 151, 163, maxColorValue = 255)

  p1 = ggplot(d, aes_string(x=param, y=response)) +
    geom_jitter(alpha=0.2) +
    geom_line(data=newdata, colour=pinkish, size=1.5) +
    geom_ribbon(data=newdata, aes(ymin=lwr, ymax=upr), alpha=0.2, fill=pinkish) +
    geom_ribbon(data=newdata, aes(ymin=sim.lwr, ymax=sim.upr), alpha=0.2, fill=pinkish) +

    xlab(x_label) +
    ylab(y_label) +
    common_theme

  return(list(
    pred_intervals = pi,
    predictions = p1
  ))
}

flog.info("Fitting models...")

#########################################################################################################
## do people named more often in cooperative networks receive more gifts?
##
m.gift.coop = fit_sna_models(d.gift, f.gift.coop)

plt.gift.coop = plot_sna_model(m.gift.coop$best_model, d.gift, param=all.vars(f.gift.coop)[2],
                               param_labels="Times named", x_label="Cooperation (reported by others)")

flog.info("... finished fitting models")
flog.info("Saving model outputs")

#########################################################################################################
## Plot predictions for gift size
##
ggsave(file.path(plots.dir, "SNA - degree and gifts.png"), plot=plt.gift.coop$predictions, height=10, width=10, units="cm")
ggsave(file.path(plots.dir, "SNA - degree and gifts.pdf"), plot=plt.gift.coop$predictions, height=10, width=10, units="cm")

#########################################################################################################
## Save models and plots
##
save(d.gift, m.gift.coop, plt.gift.coop,
     file=file.path(models.dir, "social network analysis - degree and gifts.rdata"))

flog.info("Finished social network analysis - degree and gifts")


install.packages("RcppCCTZ") #for parseDatetime
install.packages("ggplot2")
install.packages("spatstat")
install.packages("RColorBrewer")
library(RcppCCTZ)
library(ggplot2)
library(spatstat)
library(RColorBrewer)

setwd("~/Schreibtisch/hacktrain/git/stay-safe/heatmap-creation/")

data <- read.csv('../data/objectstream.csv', header = T)
data$timestamp2 <- parseDatetime(data$timestamp, "%Y-%m-%dT%H:%M:%SZ");
min_x <- min(data$x)
max_x <- max(data$x)
min_y <- min(data$y)
max_y <- max(data$y)
head(data)

startTimeList = NULL
for(hour in 8:8) {
  for(minute in 0:59) {
    for(second in 0:59) {
startTimeHour <- toString(hour)
if (hour < 10) startTimeHour <- paste("0", startTimeHour, sep="")
startTimeMinute <- toString(minute)
if (minute < 10) startTimeMinute <- paste("0", startTimeMinute, sep="")
startTimeSecond <- toString(second)
if (second < 10) startTimeSecond <- paste("0", startTimeSecond, sep="")
startTime <- paste("2018-06-21T", startTimeHour, ":", startTimeMinute, ":", startTimeSecond, "Z", sep="")
startTimeList <- append(startTimeList, startTime)
#append(timeStamp, startTime)
#print(startTime)
  }
  }
}
print(startTimeList)

for (i in 1:length(startTimeList)){
intervalData <- NULL
startTime <- startTimeList[i]
endTime <- startTimeList[i+1]
print(startTime)
print(endTime)

filter_from <- parseDatetime(startTime, "%Y-%m-%dT%H:%M:%SZ");
filter_to <- parseDatetime(endTime, "%Y-%m-%dT%H:%M:%SZ");
data_subset <- subset(data, timestamp2 >= filter_from & timestamp2 <= filter_to)
#head(data_subset)

str(data_subset)
fileName <- paste("subdata/", startTime, "subset.csv", sep="")
write.csv(data_subset, file = fileName)

hist2 <- hist(data_subset$x, breaks = 6, main = "")
intervalCounts <- hist2$counts
print(intervalCounts)

intervalData$timestamp <- startTime
intervalData$countsB1 <- intervalCounts[1]
intervalData$countsC1 <- intervalCounts[2]
intervalData$countsC2 <- intervalCounts[3]
intervalData$countsD1 <- intervalCounts[4]
intervalData$countsD2 <- intervalCounts[5]
intervalData$countsE1 <- intervalCounts[6]
print(intervalData)

heatFile <- paste("heatmaps/heat", startTime, ".jpg", sep="")
heatMapPlot <- FALSE

intervalData$heatMapFile <- heatFile
print(intervalData)
write.table(intervalData, file = "data.csv", sep = ",", quote = FALSE, append = TRUE, col.names = FALSE)
#finalData <- frame(finalData, intervalData)

if (heatMapPlot == TRUE){
  foo <- data.frame(x=data_subset$x, y=data_subset$y)
  foo_ppp <- as.ppp(foo[!duplicated(foo), ], c(min_x,max_x,min_y,max_y))
  par(mar=c(1,1,1,1))

  jpeg(file = heatFile)
  plot(density(foo_ppp, 20), las=1,xlab="foo", ylab="bar")
  dev.off()
}
}

#
# ggplot approach
#
#g <- ggplot(data_subset,aes(x=x, y=y)) +
#  stat_density2d(aes(alpha=..level..), geom="polygon") +
#  #scale_alpha_continuous(limits=c(0,0.2),breaks=seq(0,0.2,by=0.025))+
#  #scale_fill_gradient(low="blue", high="green")+
#  geom_point(colour="red", size=0.1)+
#  theme_bw()
#g

#ggplot(data_subset, aes(x = x, y = y)) +
#  stat_density2d(aes(fill = ..level..), alpha=0.5, geom="polygon") +
#  scale_fill_gradientn(colours=rev(brewer.pal(7,"Spectral"))) +
#  geom_point(alpha = .5, size = .1)


#Copyright 2013 Brown University, Providence, RI.

                         #All Rights Reserved

#Permission to use, copy, modify, and distribute this software and its
#documentation for any purpose other than its incorporation into a
#commercial product is hereby granted without fee, provided that the
#above copyright notice appear in all copies and that both that
#copyright notice and this permission notice appear in supporting
#documentation, and that the name of Brown University not be used in
#advertising or publicity pertaining to distribution of the software
#without specific, written prior permission.

#BROWN UNIVERSITY DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
#INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR ANY
#PARTICULAR PURPOSE.  IN NO EVENT SHALL BROWN UNIVERSITY BE LIABLE FOR
#ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
#WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
#ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
#OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

library(survival)
str_f = paste("tableR.txt")
input_d <- read.table(str_f, header = T)
survdiff( Surv( TIME, STATUS == 'DECEASED')~IDH1, data = input_d)


REBOL [
	Title:   "Generates Red/System byte! tests"
	Author:  "Peter W A Wood"
	File: 	 %make-integer-auto-test.r
	Version: 0.2.0
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2015 Peter W A Wood. All rights reserved."
	License: "BSD-3 - https://github.com/red/red/blob/origin/BSD-3-License.txt"
]

rand: func [
	"returns a random number between 0 and 255"
	/local i
][
	i: random 256
	i: i - 1
]

;; initialisations
tests: copy ""                          ;; string to hold generated tests
test-number: 0                          ;; number of the generated test
make-dir %auto-tests/
file-out: %auto-tests/byte-auto-test.reds

;; create a block of values to be used in the binary ops tests
test-values: [
	#"^(00)"					; zero
	#"^(FF)"					; max
	#"^(01)"
	#"^(02)"
	#"^(03)"
	#"^(05)"
	#"^(F0)"
	#"^(FD)"
	#"^(FE)"
]
loop 3 [append test-values to char! rand]

;; function to format a char as a #"^(xx)"
hex-char: func [
	c [char!]
	/local
		i  ;; issue
][
	i: to-hex to integer! c
	to string! reduce [ {#"^^(} i/7 i/8 {)"}]
]

;; create blocks of operators to be applied
test-binary-ops: [
	+
	-
	*
	/
	//
	or
	xor
	and
]

test-no-zeroes: [         ;; zero not allowed as operand2
	/
	//
]

test-comparison-ops: [
	=
	<>
	<
	>
	>=
	=<
]

test-comparison-values: [
	-1
	0
	+1
]

;; create test file with header
append tests "Red/System [^(0A)"
append tests {  Title:   "Red/System auto-generated byte! tests"^(0A)}
append tests {	Author:  "Peter W A Wood"^(0A)}
append tests {  File: 	 %byte-auto-test.reds^(0A)}
append tests {  License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"^(0A)}
append tests "]^(0A)^(0A)"
append tests join ";make-length:"
			[length? read %make-byte-auto-test.r "^(0A)^(0A)"]
append tests "^(0A)^(0A)comment {"
append tests "  This file is generated by make-byte-auto-test.r^(0A)"
append tests "  Do not edit this file directly.^(0A)"
append tests "}^(0A)^(0A)"
append tests "#include %../../../../../quick-test/quick-test.reds^(0A)^(0A)"
append tests {~~~start-file~~~ "Auto-generated tests for bytes"^(0A)^(0A)}
append tests {===start-group=== "Auto-generated tests for bytes"^(0A)^(0A)}

write file-out tests
tests: copy ""

;; binary operator tests - in global context
foreach op test-binary-ops [
	foreach operand1 test-values [
		foreach operand2 test-values [
			;; only write a test if REBOL produces a result
			if attempt [expected: do reduce [operand1 op operand2]][

				;; don't write tests for certain ops with zero second operand
				if not all [
					operand2 = 0
					find test-no-zeroes op
				][
					expected: to char! expected
					;; test with literal values
					test-number: test-number + 1
					append tests join {  --test-- "byte-auto-} [test-number {"^(0A)}]
					append tests "  --assert "
					append tests reform [hex-char expected " = (" hex-char operand1 op hex-char operand2 ")^(0A)"]

					;; test with variables
					test-number: test-number + 1
					append tests join {  --test-- "byte-auto-} [test-number {"^(0A)}]
					append tests join "      ba-b1: " [hex-char operand1 "^(0A)"]
					append tests join "      ba-b2: " [hex-char operand2 "^(0A)"]
					append tests rejoin ["      ba-b3:  ba-b1 " op " ba-b2^(0A)"]
					append tests "  --assert "
					append tests reform [hex-char expected " = ba-b3 ^(0A)"]

					;; test with "complex expression"
					test-number: test-number + 1
					expected: expected + #"a"
					append tests join {  --test-- "byte-auto-} [test-number {"^(0A)}]
					append tests "  --assert "
					append tests reform [hex-char expected { = ( #"a" + (} hex-char operand1 op hex-char operand2 "))^(0A)"]

					;; write tests to file
					write/append file-out tests
					tests: copy ""
				]
			]
		recycle
		]
	]
]

;; comparison tests
foreach op test-comparison-ops [
	foreach operand1 test-values [
		foreach operand2 test-comparison-values [
			;; only write a test if REBOL produces a result
			if all [
				attempt [operand2: operand1 + operand2]
				none <> attempt [expected: do reduce [operand1 op operand2]]
			][
				test-number: test-number + 1
				append tests join {  --test-- "byte-auto-} [test-number {"^(0A)}]
				append tests "  --assert "
				append tests reform [expected " = (" hex-char operand1 op hex-char operand2 ")^(0A)"]

				;; write tests to file
				write/append file-out tests
				tests: copy ""
			]
		]
	]
]

;; write file epilog
append tests "^(0A)===end-group===^(0A)^(0A)"
append tests {~~~end-file~~~^(0A)^(0A)}

write/append file-out tests

print ["Number of assertions generated" test-number]


filename='108新生註冊率.csv'
x=read.csv(filename,fileEncoding = "utf8")
summary(x$當學年度新生註冊率...D..C..A.B...100.)
boxplot(x$當學年度新生註冊率...D..C..A.B...100.)
head(x[order(x$當學年度新生註冊率...D..C..A.B...100.),])


library(devtools)
devtools::load_all()
library(parallel)
RNGkind("L'Ecuyer-CMRG")
set.seed(999983)

# para setup
s_q <- 2L
ncores <- 1
s_n <- 128L
s_k <- 32L

cv_test <- grid_simulation(ncores, s_n, s_k, s_q,
                maxit = 5, thresh = 1e-3,
                s_range = 10, l_range = 8)

save(cv_test, file = "cv_test.RData")

analysis_plot(cv_test, 1:7)


# script for analysis of the matched ROMA group.
# get all the libraries we need.csv

library(pacman)
p_load(
    tidyverse, survival, rms, Hmisc, survminer,
    survRM2, relsurv
)

library(easypackages)
libraries(c(
    "tidyverse", "haven", "readxl",
    "survival", "lubridate", "WeightIt",
    "cobalt", "rms", "Hmisc", "survminer",
    "cmprsk", "splines"
))

library(cobalt)
library(Matching)
library(MatchIt)
library(WeightIt)
library(twang)
library(MatchThem)
library(naniar)
library("MatchIt")
library("lmtest")
library("sandwich")
library("boot")
library("survival")
library(gmodels)

df <- read_csv("D:/lita_bita3/matched_data_roma.csv")

# need to get the no_touch_aorta correct.

nt <- read_excel("D:/lita_bita3/no_touch.xlsx", sheet = 1)

glimpse(nt)

df$nt <- with(df, ifelse(pat_id %in% nt$Pat_ID, 1, 0))

df %>% count(nt)

# table 1.

vars <- c(
    "age_at_surgery", "gender", "height_cm", "weight_kg",
    "bmi", "diabetes", "art_hypertension",
    "smoker", "hyperlipemia", "copd", "pad", "creat",
    "pre_lvef", "pre_lvef_function", "elective", "cad_disease",
    "left_main_disease", "prior_pci", "pre_stroke", "bima"
)

factors <- c(
    "gender", "diabetes", "art_hypertension",
    "smoker", "hyperlipemia", "copd", "pad",
    "pre_lvef_function", "elective", "cad_disease",
    "left_main_disease", "prior_pci", "pre_stroke", "bima"
)

t1 <- tableone::CreateTableOne(
    vars = vars,
    factorVars = factors,
    data = df,
    strata = c("bima")
)

tab1_roma_m <- print(t1,
    nonnormal = c("age", "creat", "pre_lvef", "bmi")
)

tab1_roma_m

write.csv(
    tab1_roma_m,
    "D:/lita_bita3/tables/table1_roma_matched.csv"
)

# table 2.

vars <- c(
    "opcab", "conversion_to_onpump", "onpump_beating_heart",
    "nt", "length_of_surgery", "bypass_time", "cross_clamp_time", "distals_n", "distals_svg_n", "svg_grafts", "seq_n", "proximals_n", "y_graft_n", "bima"
)

factors <- c(
    "opcab", "conversion_to_onpump", "onpump_beating_heart",
    "nt",
    "bima"
)

t2 <- tableone::CreateTableOne(
    vars = vars,
    factorVars = factors,
    data = df,
    strata = c("bima")
)

tab2_roma_m <-
    print(t2, nonnormal = c("length_of_surgery", "bypass_time", "cross_clamp_time"))

write.csv(
    tab2_roma_m,
    "D:/lita_bita3/tables/table2_roma_matched.csv"
)

# early postoperative results.

vars <- c(
    "post_low_cardiac_output",
    "post_iabp", "post_ecmo", "post_mi", "post_reanimation", "post_cardiac_arrhythmia",
    "post_redo_heart", "post_rethorax_bleeding", "post_stroke", "post_dswi",
    "post_sepsis", "died_inhouse", "postop_los", "post_dialysis"
)

factors <- c(
    "post_low_cardiac_output",
    "post_iabp", "post_ecmo", "post_mi", "post_reanimation", "post_cardiac_arrhythmia",
    "post_redo_heart", "post_rethorax_bleeding", "post_stroke", "post_dswi",
    "post_sepsis", "died_inhouse", "post_dialysis"
)

t3 <- tableone::CreateTableOne(
    vars = vars,
    factorVars = factors,
    data = df,
    strata = c("bima")
)

tab3_roma_match <- print(t3, nonnormal = c("postop_los"))

write.csv(
    tab3_roma_match,
    "d:/lita_bita3/tables/tab3_roma_matched.csv"
)

# KM curve for this data.

s_rm <- survfit(Surv(surv_years, died) ~ bima, data = df)

summary(s_rm, times = c(0, 5, 10, 15))

survdiff(Surv(surv_years, died) ~ bima, data = df)

roma_m_s <- ggsurvplot(s_rm,
                surv.scale = "percent",
                risk.table = T,
                xlim = c(0, 15),
                break.x.by = 5,
                conf.int = T,
                legend.labs = c("SITA", "BITA"),
                palette = "lancet",
                censor.size = 0)

ggsave(
    plot = print(roma_m_s),
    filename = "D:/lita_bita3/figures/surv_roma_matched.tiff",
    height = 6,
    width = 7,
    units = "in",
    dpi = 1200,
    device = "tiff"
)

# looking at the overall CPH model.

cph <- coxph(Surv(surv_years, died) ~ bima,
             data = df)

summary(cph)

# Call:
#     coxph(formula = Surv(surv_years, died) ~ bima + age_at_surgery,
#           data = df)
#
# n= 518, number of events= 107
#
# coef exp(coef)  se(coef)      z Pr(>|z|)
# bima           -0.493417  0.610537  0.203092 -2.430   0.0151 *
#     age_at_surgery  0.008961  1.009001  0.015597  0.575   0.5656
# ---
#     Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#
# exp(coef) exp(-coef) lower .95 upper .95
# bima              0.6105     1.6379    0.4101     0.909
# age_at_surgery    1.0090     0.9911    0.9786     1.040
#
# Concordance= 0.574  (se = 0.029 )
# Likelihood ratio test= 6.61  on 2 df,   p=0.04
# Wald test            = 6.37  on 2 df,   p=0.04
# Score (logrank) test = 6.5  on 2 df,   p=0.04

# use RMST to obtain the difference in survival between groups.

rmst_res <- surv2sampleComp::surv2sample(time = df$surv_years,
                             status = df$died,
                             arm = df$bima,
                             tau = 15,
                             timepoints = c(5,10,15))

rmst_res$group0

# results for SITA:

# Est.  Lower 95%  Upper 95%         SE
# RMST                      12.3185084 11.7655185 12.8718357 0.28319670
# Loss time                  2.6814916  2.1281643  3.2344815 0.28319670
# Prob at 5                  0.8812558  0.8416535  0.9168186 0.01953932
# Prob at 10                 0.7838603  0.7281208  0.8365872 0.02828289
# Prob at 15                 0.6000727  0.5111078  0.6844163 0.04338231
# Quantile at 10 %           4.3998467  3.5759364  6.2233052 0.78233013
# Quantile at 15 %           7.5922681  4.7010185  8.9858723 1.28508847
# Quantile at 20 %           8.9858723  7.6798817 11.2172818 0.94984419
# Ave of t-year event rates  0.7550629  0.7072142  0.8022654 0.02484550
# Ave percentiles            6.9926624  5.3699850  8.7837906 0.89266457

rmst_res$group1

# RMST for the BITA group:

#                                 Est.  Lower 95%  Upper 95%         SE
# RMST                      13.2740437 12.7213533 13.7441484 0.26265117
# Loss time                  1.7259563  1.2558516  2.2786467 0.26265117
# Prob at 5                  0.9377413  0.9027367  0.9632504 0.01572081
# Prob at 10                 0.8351464  0.7776583  0.8848827 0.02706405
# Prob at 15                 0.7559597  0.6341785  0.8402100 0.05205989
# Quantile at 10 %           6.6832767  5.3197897  9.0187274 1.22094749
# Quantile at 15 %           9.6128573  7.1980068 14.2919724        NaN
# Quantile at 20 %          11.1871646  9.0187274        Inf        NaN
# Ave of t-year event rates  0.8429491  0.7873286  0.8895253 0.02579136
# Ave percentiles            9.1610996  7.3750593        Inf        NaN

rmst_res$contrast.diff10
#
# Est.    Lower 95%  Upper 95%      p-val
# RMST Group1-Group0                       0.95553531  0.186783275  1.7242873 0.01484349
# Loss time Group1-Group0                 -0.95553531 -1.724287349 -0.1867833 0.01484349
# Prob at 5 Group1-Group0                  0.05648548  0.006598483  0.1063725 0.02647273
# Prob at 10 Group1-Group0                 0.05128613 -0.025660108  0.1282324 0.19143246
# Prob at 15 Group1-Group0                 0.15588703  0.023993261  0.2877808 0.02053055
# Quantile at 10 % Group1-Group0           2.28343007 -0.654983569  5.2218437 0.12773855
# Quantile at 15 % Group1-Group0           2.02058920          NaN        NaN        NaN
# Quantile at 20 % Group1-Group0           2.20129230          NaN        NaN        NaN
# Ave of t-year event rates Group1-Group0  0.08788621  0.017772630  0.1579998 0.01401876
# Ave percentiles Group1-Group0            2.16843719          NaN        NaN

# rmst at 5, 10 and 15 using survRM2.

t5 <- survRM2::rmst2(time = df$surv_years,
               status = df$died,
               arm = df$bima,
               tau = 5)

t5

# The truncation time: tau = 5  was specified.
#
# Restricted Mean Survival Time (RMST) by arm
# Est.    se lower .95 upper .95
# RMST (arm=1) 4.838 0.047     4.745     4.930
# RMST (arm=0) 4.715 0.060     4.597     4.833
#
#
# Restricted Mean Time Lost (RMTL) by arm
# Est.    se lower .95 upper .95
# RMTL (arm=1) 0.162 0.047     0.070     0.255
# RMTL (arm=0) 0.285 0.060     0.167     0.403
#
#
# Between-group contrast
# Est. lower .95 upper .95     p
# RMST (arm=1)-(arm=0) 0.123    -0.027     0.273 0.108
# RMST (arm=1)/(arm=0) 1.026     0.994     1.059 0.109
# RMTL (arm=1)/(arm=0) 0.569     0.281     1.151 0.117

t10 <- survRM2::rmst2(time = df$surv_years,
                      status = df$died,
                      arm = df$bima,
                      tau = 10)

t10

# The truncation time: tau = 10  was specified.
#
# Restricted Mean Survival Time (RMST) by arm
# Est.    se lower .95 upper .95
# RMST (arm=1) 9.290 0.131     9.034     9.547
# RMST (arm=0) 8.918 0.158     8.608     9.227
#
#
# Restricted Mean Time Lost (RMTL) by arm
# Est.    se lower .95 upper .95
# RMTL (arm=1) 0.710 0.131     0.453     0.966
# RMTL (arm=0) 1.082 0.158     0.773     1.392
#
#
# Between-group contrast
# Est. lower .95 upper .95     p
# RMST (arm=1)-(arm=0) 0.373    -0.029     0.775 0.069
# RMST (arm=1)/(arm=0) 1.042     0.997     1.089 0.070
# RMTL (arm=1)/(arm=0) 0.656     0.414     1.039 0.072

# t15

t15 <- survRM2::rmst2(time = df$surv_years,
                      status = df$died,
                      arm = df$bima,
                      tau = 15)

t15

# The truncation time: tau = 15  was specified.
#
# Restricted Mean Survival Time (RMST) by arm
# Est.    se lower .95 upper .95
# RMST (arm=1) 13.274 0.258    12.769    13.779
# RMST (arm=0) 12.319 0.288    11.754    12.883
#
#
# Restricted Mean Time Lost (RMTL) by arm
# Est.    se lower .95 upper .95
# RMTL (arm=1) 1.726 0.258     1.221     2.231
# RMTL (arm=0) 2.681 0.288     2.117     3.246
#
#
# Between-group contrast
# Est. lower .95 upper .95     p
# RMST (arm=1)-(arm=0) 0.956     0.198     1.713 0.013
# RMST (arm=1)/(arm=0) 1.078     1.015     1.144 0.014
# RMTL (arm=1)/(arm=0) 0.644     0.449     0.923 0.017


require(graphics)
require(Matrix)

pdf(file="plots/Experiment1b.pdf",
  width=3.7, height=4.0, family="serif", pointsize=14)

data1 = rowMeans(matrix(as.matrix(read.table("results/Experiment1_times.dat", sep=","))[,2],5,3,byrow=TRUE))

data = as.matrix(data1/1000)
data

plot_colors <- c("cornflowerblue","gray40","black","orange","orangered")

barplot( data,
         space = c(0.5,0.5),
         xlab = "",
         ylab = "",
         col=plot_colors,
         ylim = c(1,245),
         log = "y",
         axes = FALSE,
         names.arg = c("Deduplication and Pruning"),
         args.legend = list(x="topleft", bty="n", bty="n", ncol=1),
         beside = TRUE,
)

legend( 0, 290,
       c("No dedup","No parents, sc, ss","No parents, sc","No parents", "All"), fill=plot_colors[5:1],
       bty="n", x.intersp=0.7);

axis(2, las=1)
mtext(2,text="Execution Time [s]",line=2.7)
mtext(1,text="Configurations",line=2)

box()	              # box around plot
dev.off()


library(tidyverse)
library(readr)
library(ggplot2)
library(tibble)
library(lubridate)

#Load Data
netflix_info <- read_csv("netflix_titles.csv", show_col_types = 'FALSE')

#Preview Data
glimpse(netflix_info)
summary(netflix_info)

#Separate into Three Category Columns & Keep the First
netflix_info <- netflix_info %>% separate(listed_in, c("Category1", "Category2", "Category3"), sep=",")
netflix_info <- netflix_info %>% select(c(-"Category2", -"Category3"))

#Separate Date Added (into Date & Year)
netflix_info <- netflix_info %>% separate(date_added, c("date_added", "year_added"), sep=",")

#GG Plot For Films Released By Year (Separated by Type: Movie / TV Show)
ggplot(netflix_info, mapping= aes(x=release_year, fill=type)) +
  geom_histogram(color = "black", binwidth=2.5) +
  labs(title="Netflix TV Shows/Movies Released by Year", x="Release Year", y="Total Films")

#Updating Year Added to Numeric Value
netflix_info$year_added <- as.numeric(netflix_info$year_added)

#Updating GG Plot
ggplot(netflix_info, mapping= aes(x=release_year, fill=type)) +
  geom_histogram(color = "black", binwidth=2.5) +
  labs(title="Netflix: Films Added by Year", x="Year", y="Total Films")+

#Creating New Data Frame for Film Types
netflix_types <- netflix_info %>% group_by(type) %>% count() %>% ungroup() %>%
  mutate(perc = `n` / sum(`n`)) %>%
  arrange(perc) %>%
  mutate(labels = scales::percent(perc))

head(netflix_types)

#GG Plot for Pie Chart % Movie vs. TV Show
ggplot(netflix_types, aes(x="", y = perc, fill= type)) +
  geom_col()+
  geom_text(aes(label = labels), position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y") +
  labs(title="Netflix Film Type: Movies vs TV Shows") +
  theme_void() +

#Netflix Films by Genre's
genre1 <- netflix_info %>% group_by(Category1) %>% count()

#Creating Top 9 Genres + Combining "Others": Into a Top 10 Genres DataFrame
top9_genres <- filter(genre1, n > 300) %>% arrange(desc(n))
other_genres <- filter(genre1, n < 300)

other_genres <- data.frame(Category1 = c("Others*"), n=c(sum(other_genres$n)))
top10_genres <- rbind(top9_genres, other_genres)

#Preview Genres DataFrame
head(top10_genres)

#GGPlot For Top 10 Genres
ggplot(data = top10_genres, mapping=aes(x=reorder(Category1, n), y=n, fill=Category1))+
  geom_bar(stat = "identity", show.legend=FALSE)+
  coord_flip()+
  labs(title = "Netflix: Top 10 Genres", x = "Genres", y = "Total Films", caption = "Others: Anime, British, Classic, Docuseries, Horror, International, etc.")

#Netflix Films by Ratings
ratings <- netflix_info %>% group_by(rating) %>% count()

#Adding Top 9 Ratings + Combining "Others": Into a Top 10 Ratings
top9_ratings <- filter(ratings, n > 200) %>% arrange(desc(n))
other_ratings <- filter(ratings, n < 200)

other_ratings <- drop_na(other_ratings)
other_ratings <- data.frame(rating = c("Others*"), n = c(sum(other_ratings$n)))
top10_ratings <- rbind(top9_ratings, other_ratings)

#Preview Ratings DataFrame
head(top10_ratings)

#GGPlot For Top 10 Ratings
ggplot(data = top10_ratings, aes(x = reorder(rating, n), y=n, fill=rating)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  labs(title= "Netflix: Top 10 Ratings", x="Ratings", y="Total Films", caption = "Others: G, NR, NC-17,  TV-Y7-FV, UR, etc.")

#Netflix Films By Country
countries <- netflix_info %>%
  select(country, type, title, year_added)
sum(is.na(countries$country))/nrow(countries)

countries <- countries %>%
  filter(!is.na(country))

#Split Countries into Single Country
max(str_count(countries$country, ','))
countr <- countries %>%
  separate(country, into =c('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l')
           ,", ", convert = TRUE)
countr <-countr[,1:12]
countr_list <- countr %>%
  unlist()
countr_tibble <- tibble(
  country_name=countr_list
)

#Create Country Tibble
ctr <- countr_tibble %>%
  group_by(country_name) %>%
  count() %>%
  filter(!is.na(country_name))

#GGPlot for Films by Country
ctr %>%
  filter(n > 100 && country_name != '') %>%
  ggplot(aes(n, reorder(country_name, FUN=median, n), fill = n > 1000)) +
  geom_bar(stat='identity', show.legend = F) +
  labs(title="Netflix: Films Created by Country", x="Total Films", y="Country Name")


pdf_file<-"pdf/timeseries_quarterly_columns.pdf"
cairo_pdf(bg="grey98", pdf_file,width=14,height=7)

library(gplots)
library(gdata)
par(omi=c(0.65,0.75,0.95,0.75),mai=c(0.9,0,0.25,0.02),fg="cornsilk",bg="cornsilk",family="Lato Light",las=1)

# Read data and prepare chart

gdp<-read.xls("myData/GDP_germany_quarter.xlsx",sheet=2)
x<-rev(gdp$priceadjusted)
t<-unique(gdp$year)

# Create chart and other elements

par(mfcol=c(1,length(t)))
for (i in length(t):1)
{
xt<-subset(gdp$priceadjusted,gdp$year == t[i])
myColours<-rep("blue4",length(xt))
for (j in 1:length(xt)) if(xt[j]<0) myColours[j]<-"coral4"
barplot2(rev(xt),border=NA,bty="n",col=rev(myColours),ylim=c(-4,2),axes=F,prcol="bisque1")
if (i==length(t)) axis(2,col="cornsilk",cex.axis=1.25,at=c(-4:2),labels=c("-4%","-3%","-2%","-1%","0%","1%","2%"))
mtext(t[i],1,line=2,col=rgb(64,64,64,maxColorValue=255),cex=1.25)
}

# Titling

mtext("Gross Domestic Product in Germany 2000 - 2011",3,line=2.5,adj=0,cex=2,family="Lato Black",col="Black",outer=T)
mtext("Price-adjusted rates of change from the previous quarter, chain index, quarterly values",3,line=-0.5,adj=0,cex=1.5,font=3,col="Black",outer=T)
mtext("Source: destatis.de",1,line=1,adj=1,cex=1.25,font=3,col="Black",outer=T)
dev.off()


#' Iterator that drops elements until the predicate function returns FALSE
#'
#' Constructs an iterator that drops elements from the iterable \code{object} as
#' long as the \code{predicate} function is true; afterwards, every element of
#' \code{iterable} object is returned.
#'
#' Because the iterator does not return any elements until the \code{predicate}
#' first becomes false, there may have a lengthy start-up time before elements
#' are returned.
#'
#' @importFrom iterators iter nextElem
#' @export
#' @param predicate a function that determines whether an element is \code{TRUE}
#' or \code{FALSE}. The function is assumed to take only one argument.
#' @param object an iterable object
#' @return iterator object
#'
#' @examples
#' # Filters out numbers exceeding 3
#' not_too_large <- function(x) {
#'   x <= 3
#' }
#' it <- idropwhile(not_too_large, 1:8)
#' as.list(it)
#'
#' # Same approach but uses an anonymous function
#' it2 <- idropwhile(function(x) x <= 10, seq(2, 20, by=2))
#' as.list(it2)
idropwhile <- function(predicate, object) {
  iter_obj <- iterators::iter(object)

  nextElem <- function() {
    repeat {
      next_elem <- iterators::nextElem(iter_obj)
      if (!predicate(next_elem)) {
        return(next_elem)
      }
    }
  }

  it <- list(nextElem=nextElem)
  class(it) <- c("abstractiter", "iter")
  it
}


# customized by Xiaoqing Rong-Mullins 2015-11-16

meltcurve <- function(
data,
temps = NULL,
fluos = NULL,
window = NULL,
norm = FALSE,
auto_span_smooth = TRUE, # xqrm
temp_1side = NULL, # xqrm
# span.smooth = 0.05, # ori
span_smooth_default = NULL, # xqrm
span_smooth_factor = NULL, # xqrm
span.peaks = 51,
is.deriv = FALSE,
Tm.opt = NULL,
Tm.border = c(1, 1),
plot = TRUE,
peaklines = TRUE,
calc.Area = TRUE,
plot.Area = TRUE,
cut.Area = 0,
...)
{
  # xqrm: start counting for running time
  func_name <- 'meltcurve'
  start_time <- proc.time()[['elapsed']]

  options(warn = -1)
  if (is.null(temps)) temps <- seq(from = 1, to = ncol(data), by = 2)
  if (is.null(fluos)) fluos <- seq(from = 2, to = ncol(data), by = 2)
  if (length(temps) != length(fluos)) stop("Numbers of temperature columns and fluorescence columns do not match!")
  if (calc.Area == FALSE) plot.Area <- FALSE

  NAMES <- colnames(data[, fluos, drop = FALSE])

  ### create dataframes with temp and fluo values
  TEMPS <- data[, temps, drop = FALSE]
  FLUOS <- data[, fluos, drop = FALSE]

  ### define grid
  if (!is.null(Tm.opt)) {
    SM.seq <- seq(0, 0.2, by = 0.01)
    SP.seq <- seq(11, 201, by = 10)
    GRID <- expand.grid(SM.seq, SP.seq)
    GRID_not_determined <- FALSE # xqrm
  } else
    #GRID <- matrix(c(span.smooth, span.peaks), nrow = 1) # ori
    GRID_not_determined <- TRUE # xqrm

  ### create output list
  outLIST <- vector("list", length = ncol(TEMPS))

  ### iterate over all samples
  for (i in 1:ncol(TEMPS)) {

    # xqrm: start counting for running time
    start_time_for <- proc.time()[['elapsed']]

    cat(NAMES[i], "\n")
    TEMP <- TEMPS[, i]
    FLUO <- FLUOS[, i]

    ### cut off unimportant temperature regions
    if (!is.null(window)) {
      SEL <- which(TEMP <= window[1] | TEMP > window[2])
      TEMP <- TEMP[-SEL]
      FLUO <- FLUO[-SEL]
    }

    ### optionally normalize fluo values
    if (norm) FLUO <- rescale(FLUO, 0, 1)

   # start: xqrm: determine span_smooth

    if (auto_span_smooth) {

      message('Automatic selection of `span_smooth`...')

      # start: find the data region considered (csdd) for choosing span_smooth

      len1 <- length(TEMP)

      # # method 1: median fluo value => corresponding central_fluo_temp => 2 * temp_1side centered at central_fluo_temp
      # central_fluo_temp = TEMP[order(FLUO)[as.integer(len1 / 2)]] # the temperature for approximately median fluo value
      # csdd_indices <- which(TEMP >= central_fluo_temp - temp_1side & TEMP <= central_fluo_temp + temp_1side)
      # # message('central_fluo_temp: ', central_fluo_temp) # to test

      # start: method 2: find the region of length 2 * temp_1side showing the largest fluo difference between start and end

      temp_span <- diff(range(na.omit(TEMP)))
      temp_step <- temp_span / len1 # assume temperature step is about constant
      num_csdd_steps_1side <- as.integer(temp_1side / temp_step)

      fluo_ranges <- list()
      fluo_diffs <- list()

      for (i1 in 1:len1) {

        fluo_start <- i1 - num_csdd_steps_1side
        if (fluo_start < 1) fluo_start <- 1

        fluo_end <- i1 + num_csdd_steps_1side
        if (fluo_end > len1) fluo_end <- len1

        fluo_ranges[[i1]] <- fluo_start:fluo_end
        fluo_diffs[[i1]] <- FLUO[fluo_start] - FLUO[fluo_end]
        }

      csdd_central_index <- which.max(unlist(fluo_diffs))
      # message('TEMP[csdd_central_index]: ', TEMP[csdd_central_index]) # to test
      csdd_indices <- fluo_ranges[[csdd_central_index]]

      # end: method 2

      csdd_temp <- TEMP[csdd_indices]
      csdd_fluo <- FLUO[csdd_indices]

      # end: find...

      len2 <- length(csdd_indices)
      trend_mtx <- as.data.frame(cbind(1:len2,
                                       csdd_temp, c(csdd_temp[2:len2], NA),
                                       csdd_fluo, c(csdd_fluo[2:len2], NA)))
      colnames(trend_mtx) <- c('count', 'TEMP', 'TEMP_next', 'FLUO', 'FLUO_next')
      trend_mtx[,'TEMP_diff'] <- trend_mtx[,'TEMP_next'] - trend_mtx[,'TEMP']
      trend_mtx[,'FLUO_diff'] <- trend_mtx[,'FLUO_next'] - trend_mtx[,'FLUO']

      trend_positive <- trend_mtx[trend_mtx[,'FLUO_diff'] > 0,]

      if (all(is.na(trend_positive))) {
        span_smooth <- span_smooth_default
        message('Use `span_smooth_default` ', span_smooth_default)
      } else {
        message('Fluorescence increase with temperature increase was detected.')
        len3 <- dim(trend_positive)[1]
        trend_positive[,'count_diff'] <- c(trend_positive[2:len3, 'count'], NA) - trend_positive[,'count']
        trend_seps <- which(trend_positive[,'count_diff'] > 1)
        trend_starts <- c(1, trend_seps + 1)
        trend_ends <- c(trend_seps, len3 - 2)

        len4 <- length(trend_seps) + 1
        temp_intervals <- sapply(1:len4, function(i) sum(trend_positive[trend_starts[i]:trend_ends[i], 'TEMP_diff'])) # temperature intervals where fluo value increases
        max_temp_interval <- max(temp_intervals)
        span_smooth_product <- span_smooth_factor * max_temp_interval / temp_span
        if (span_smooth_product > span_smooth_default) {
          span_smooth <- span_smooth_product
          message(sprintf('`span_smooth` was selected as %f.', span_smooth))
        } else {
          span_smooth <- span_smooth_default
          message(sprintf('`span_smooth_product` %f < `span_smooth_default`, use `span_smooth_default` %f.',
                          span_smooth_product, span_smooth)) }

        # # to test
        # print(trend_mtx)
        # print(trend_positive)
        # print(cbind(trend_starts, trend_ends))
        # print(temp_intervals)
        # message('max_temp_interval: ', max_temp_interval)

        }

      } else {
          span_smooth <- span_smooth_default
          message(sprintf('No automatic selection of `span_smooth`, use `span_smooth_default` %f.', span_smooth_default))
      }

    if (GRID_not_determined) GRID <- matrix(c(span_smooth, span.peaks), nrow = 1)

    # end: xqrm: determine span_smooth

    ### define result matrix
    resMAT <- matrix(nrow = nrow(GRID), ncol = 3)

    ### iterate over GRID and get result for best parameters
    ### (lowest RSS)
    for (j in 1:nrow(GRID)) {
      counter(j)
      RES <- try(TmFind(TEMP = TEMP, FLUO = FLUO, span.smooth = GRID[j, 1], span.peaks = GRID[j, 2], is.deriv = is.deriv, Tm.opt = Tm.opt), silent = TRUE)
      if (inherits(RES, "try-error")) next
      resMAT[j, ] <- c(RES$Pars[1:2], RES$RSS[1])
    }

    if (!is.null(Tm.opt)) {
      resMAT <- resMAT[order(resMAT[, 3]), ]
      bestPAR <- resMAT[1, 1:2]
      RES <- try(TmFind(TEMP = TEMP, FLUO = FLUO, span.smooth = bestPAR[1], span.peaks = bestPAR[2], is.deriv = is.deriv, Tm.opt = Tm.opt), silent = TRUE)
      if (inherits(RES, "try-error")) RES <- NA
    }

    ### calculation of peak area by 'peakArea'
    tempDATA <- RES$Temp
    meltDATA <- RES$Fluo
    derivDATA <- RES$df.dT
    TMs <- RES$Tm
    TMs <- TMs[!is.na(TMs)]
    PA <- numeric(length = length(TMs))
    baseLIST <- vector("list", length = length(TMs))

    if (calc.Area) {

      if (length(TMs) == 0) { # xqrm
        RES <- cbind.na(RES, Area=NA, baseline=NA) # xqrm

      } else { # xqrm
        for (k in 1:length(TMs)) {
          WHICH <- which(tempDATA > TMs[k] - Tm.border[1] & tempDATA < TMs[k] + Tm.border[2])
          X <- tempDATA[WHICH]
          Y <- derivDATA[WHICH]
          PEAKAREA <- try(peakArea(X, Y), silent = TRUE)
          if (!inherits(PEAKAREA, "try-error")) {
            PA[k] <- PEAKAREA$area
            BL <- PEAKAREA$baseline
          } else PA[k] <- BL <- NA

          baseLIST[[k]] <- cbind.na(Temp = X, baseline = BL)
        }

        ### remove TMs if peak area < cutoff
        SEL <- which(PA < cut.Area | is.na(PA))
        if (length(SEL) > 0) {
          PA <- delete(PA, SEL, fill = TRUE)
          BL <- NA
          RES$Tm <- delete(RES$Tm, SEL, fill = TRUE)
        }

        ### attach peak area values
        # RES <- cbind.na(RES, Area = PA) # ori
        RES <- cbind.na(RES, Area = round(PA, 2)) # xqrm

        ### attach baseline area values to
        ### the corresponding temperature values
        RES <- cbind.na(RES, baseline = NA)
        for (m in 1:length(baseLIST)) {
          MATCH <- match(baseLIST[[m]][, 1], RES$Temp)
          RES$baseline[MATCH] <- baseLIST[[m]][, 2]
        }
      }
    }

    ### flag meltcurve as 'failed' if all peak areas < cut.Area
    if (all(is.na(RES$Area))) attr(RES, "quality") <- "bad" else attr(RES, "quality") <- "good"

    ### create output list
    outLIST[[i]] <- RES

    cat("\n\n")

    # xqrm: report time cost for this function
    end_time_for <- proc.time()[['elapsed']]
    message('iteration ', i, ' took ', round(end_time_for - start_time_for, 2), ' seconds.\n')

  } # xqrm: end: for loop

  ### plotting setup and x-y-y plot
  if (plot) {
    DIM <- ceiling(sqrt(length(outLIST)))
    par(mfrow = c(DIM, DIM))
    for (i in 1:length(outLIST)) {
      ### plot raw melt data and first derivatives
      ### including identified melting points
      tempDATA <- outLIST[[i]]$Temp
      meltDATA <- outLIST[[i]]$Fluo
      derivDATA <- outLIST[[i]]$df.dT
      baseDATA <- outLIST[[i]]$baseline
      TMs <- outLIST[[i]]$Tm

      xyy.plot(tempDATA, meltDATA, if (!is.deriv) derivDATA, main = NAMES[i],
                      y1.par = list(xlab = "", ylab = "", type = "l", lwd = 2),
                      y2.par = list(xlab = "", ylab = "", type = ifelse(is.deriv, "n", "l"), lwd = 2, main = "", text = ""),
                      first = par(mar = c(3, 2, 2, 3)),
                      y1.last = if (peaklines) abline(v = TMs, lwd = 1, lty = 2, ...) else NULL,
                      y2.last = if (plot.Area) segments(tempDATA, baseDATA, tempDATA, derivDATA, col = 2) else NULL,
                      ...)
    }
  }

  # xqrm: report time cost for this function
  end_time <- proc.time()[['elapsed']]
  message('`', func_name, '` took ', round(end_time - start_time, 2), ' seconds.')

  return(outLIST)
}