Archive | Science and Technology RSS for this section

EggHatch – a function for easy pattern addition in ggplot2 bar plots.

So, when I had a little time a few months ago I started coding a wrapper function for ggplot2 in R, with the aim of making it a straight forward process when adding 3 basic patterns (hatching) to ggplot2 bar graphs.

Here’s the original answer I provided to the question posed on StackOverflow.

As you can see it’s a little cumbersome.

Anyway, below is the function ‘EggHatch’ (Easy ggplot2 Hatch) that I wrote to make the process a lot easier.

NOTE 1: All patterns work with a regular single plot of bar/s, however, I haven’t found the time to make the diagonal patterns work with facet_grid in ggplot2. The horizontal and vertical patterns do work with facet_grid.

NOTE 2: The following libraries should be installed in order to use this function:


install.packages('Epi')
install.packages('stringi')
install.packages('plyr')
install.packages('gtools')
install.packages('stringr')

NOTE 3: I’ve added example data and some instructions on how to use EggHatch further down the page.

 

EggHatch <- function(ggplot2_plot, cond.list, width_Man = NULL){

    # use this for Relevel
    library(Epi)
    # default relevel to avoid index issue
    ggplot2_plot$data$Variable = Relevel(ggplot2_plot$data$Variable, ref = c(ggplot2_plot$data$Variable))

    print("When choosing patterns ensure that scaling does not obscure horizontal lines. Should horizontal lines be obscured consider a different pattern (A, C, D, or any combination of them.)")
    # if statement for when no value input in 'fill'
      library(stringi)
      library(plyr)
      library(gtools)
      library(stringr)

      input_position_dodge<-ggplot2_plot$layers[[1]]$position$width
      input_colour<-ggplot2_plot$layers[[1]]$aes_params$colour
      fill_value<-ggplot2_plot$layers[[1]]$aes_params$fill
      input_size<-ggplot2_plot$theme$rect$size
      input_width<-ggplot2_plot$layers[[1]]$geom_params$width

      # remove any spaces, tabs etc. from input string
      cond.list<-stri_replace_all_charclass(cond.list, "\\p{WHITE_SPACE}", "")

      # list of conditions input by users
      string_split1<-strsplit(cond.list, ",")[[1]]

      # Dataframe shaped to match number of patterns and conditions entries
      df <- data.frame(matrix(ncol = 2, nrow = length(string_split1)))
      colnames(df) <- c("Pattern", "Condition")

      pattern_options <- c("A", "B", "C", "D") 

      BAR_OUTPUT1<-ggplot2_plot
      BAR_OUTPUT<-BAR_OUTPUT1

      for (pos in 1:length(string_split1)){

        # seperate pattern from input condition into list, dropping '='
        cond_patterns <- as.list(strsplit(string_split1[pos], "=")[[1]])

        # write values to relevant colomns on current row
        df$Pattern[pos]<-cond_patterns[1]
        df$Condition[pos]<-cond_patterns[2]

      }

      # find largest mean value and pass 2% of it
      two_percent_of_largest_mean<-((max(unlist(lapply(ggplot2_plot$data$Value,FUN=max)))/100)*2)

      # loop around for number of conditions
      for (pos in 1:length(df$Condition)){

          Condition_Pos=0

        # split pattern into individual characters
        pattern_split_loop_var<-as.character(df$Pattern[pos])
        pattern_split_loop_var<- strsplit(pattern_split_loop_var, "")[[1]]

        if(grep("A|B|C|D", df$Pattern[pos], ignore.case=TRUE)){

          if ((grepl('A', df$Pattern[pos], ignore.case=TRUE))){

            # get 25% of original width
            vert_bar_count = (((ggplot2_plot$layers[[1]]$geom_params$width)/100)*10)
            Condition_Pos<-as.numeric(df$Condition[pos])

            for (i in 1){

              if (is.null(fill_value)){

                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width=(ggplot2_plot$layers[[1]]$geom_params$width))

              }

              if (!is.null(fill_value)){

              BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width=(ggplot2_plot$layers[[1]]$geom_params$width),fill=fill_value)

              }

              # loop 4 times
              for (i in 1:((ggplot2_plot$layers[[1]]$geom_params$width)/vert_bar_count)){

                # when calculating the number of times to loop and draw consider making value = bar width
                # additionally consider add a verticle line '0' by default. Should get around any
                # stepping outside range
                # alternative just draw a line on each unit on the x-axis inside bounds of bar: number at given
                # point (x-axis label) then either side of number, for example:
                # geom_vline(xintercept=c(1.5,2.5, 10.5), linetype="dotted", size=.8)
                #
                # ensure the Condition_Position value is correct here
                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width=(ggplot2_plot$layers[[1]]$geom_params$width)-vert_bar_count, fill='transparent')
                vert_bar_count = vert_bar_count + (((ggplot2_plot$layers[[1]]$geom_params$width)/100)*10)#((ggplot2_plot$layers[[1]]$geom_params$width)/4)

              }
            }

            if ((grepl('B', df$Pattern[pos], ignore.case=TRUE))){  

              point_1_percent_of_current_mean <- ((BAR_OUTPUT$data$Value[Condition_Pos]/100)*.1)                              while((BAR_OUTPUT$data$Value[Condition_Pos])>=two_percent_of_largest_mean){ 

                # this breaks while loop to prevent going below x-axis 0
                if(((as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-(ggplot2_plot$data$Value[Condition_Pos]/100))<0){

                  break

                }

                BAR_OUTPUT$data$Value[Condition_Pos]<-(as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-two_percent_of_largest_mean

                # This stops line very close to 0 on y-axis
                if(((BAR_OUTPUT$data$Value[Condition_Pos])<((two_percent_of_largest_mean/100)*15))){

                  break

                }

                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width, fill='transparent')

              }

            } # end of sub grepl 'B'

            if ((grepl('C', df$Pattern[pos], ignore.case=TRUE))){

              # Code for diagonal C
              position_input_x<-as.numeric(df$Condition[pos])
              position_input_y<-as.numeric(df$Condition[pos])
              # half of input width
              # when minused from centre of bar point on x-axis
              # it gives value at start of bar on x-axis
              # inverse true for end of bar width
              half_input_width<-input_width/2
              ten_perc_input_width<-((input_width/100)*10)

              x_axis_min <- position_input_x-half_input_width
              x_axis_start_top<-x_axis_min
              x_axis_start_bottom<-x_axis_min
              x_axis_max <- position_input_x+half_input_width

              y_axis_max<- ggplot2_plot$data$Value[position_input_y]
              # need to pull the max value from the example_plot the max boundries...
              # or caluclate the
              z_percent_of_current_mean<-(y_axis_max/100)*10

              df_diag <- data.frame(

                # start on x-axis-end on x-axis
                x = c(x_axis_start_bottom,x_axis_start_top),

                # start on y-axis-end on y-axis
                y = c(y_axis_max,y_axis_max), Fill='Hope you\'re having a nice day.')

              for(i in 1:19){

                # run if 2nd x-position is less or equal to rightmost edge of bar
                # minus 10% of total input width
                if (df_diag$x[2]<(as.character(x_axis_max))){

                  # 1/10 of unit value in width field
                  df_diag$x[2]<-df_diag$x[2]+(ten_perc_input_width)

                  # subtract z percent from 1st y height
                  df_diag$y[1]<-df_diag$y[1]-(z_percent_of_current_mean)

                  # draw using current df_diag values
                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when less than x_axis_max

                # run this code to limit 2nd x-point from moving past rightmost edge of bar
                if (df_diag$x[2]==as.character(x_axis_max)){

                  # drop height of 2nd y-position by z percentage
                  df_diag$y[2]<-df_diag$y[2]-(z_percent_of_current_mean)

                  if(df_diag$y[1]<=z_percent_of_current_mean){

                    df_diag$x[1]<-df_diag$x[1]+ten_perc_input_width
                  }

                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when x_axis_max reached

              } # end of for loop 1:19

            } # end of sub grepl 'C'

            if ((grepl('D', df$Pattern[pos], ignore.case=TRUE))){

              # Code for left leaning diagonal 'D'
              position_input_x<-as.numeric(df$Condition[pos])
              position_input_y<-as.numeric(df$Condition[pos])
              # half of input width
              # when minused from centre of bar point on x-axis
              # it gives value at start of bar on x-axis
              # inverse true for end of bar width
              half_input_width<-input_width/2
              ten_perc_input_width<-((input_width/100)*10)

              x_axis_min <- position_input_x-half_input_width
              x_axis_max <- position_input_x+half_input_width
              y_axis_max<- ggplot2_plot$data$Value[position_input_y]
              # need to pull the max value from the example_plot the max boundries...
              # or caluclate the
              z_percent_of_current_mean<-(y_axis_max/100)*10

              df_diag <- data.frame(                                  # start on x-axis-end on x-axis                 x = c(x_axis_max,x_axis_max),                                                   # start on y-axis-end on y-axis                 y = c(y_axis_max,y_axis_max), Fill='Hope you\'re having a nice day.')                                            for(i in 1:19){                                  # run if 1st x-position is less or equal to leftmost edge of bar                 # minus 10% of total input width                 if (df_diag$x[2]>(as.character(x_axis_min))){

                  # 1/10 of unit value in width field
                  df_diag$x[2]<-df_diag$x[2]-(ten_perc_input_width)

                  # subtract z percent from 1st y height
                  df_diag$y[1]<-df_diag$y[1]-(z_percent_of_current_mean)

                  # draw using current df_diag values
                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when less than x_axis_max

                # run this code to limit 2nd x-point from moving past rightmost edge of bar
                if (df_diag$x[2]==as.character(x_axis_min)){

                  # drop height of 2nd y-position by z percentage
                  df_diag$y[2]<-df_diag$y[2]-(z_percent_of_current_mean)

                  if(df_diag$y[1]<=z_percent_of_current_mean){

                    df_diag$x[1]<-df_diag$x[1]-ten_perc_input_width
                  }

                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when x_axis_max reached

              } # end of for loop 1:19

            }

          } # end of if grepl 'A'

          # This runs code when *only* 'B' in string
          if ((!grepl("[^B]", df$Pattern[pos], ignore.case=TRUE))==TRUE){

            Condition_Pos<-as.numeric(df$Condition[pos])
            one_percent_horiz<-(BAR_OUTPUT$data$Value[Condition_Pos])/100
            Twenty_percent_horiz<-(one_percent_horiz*20)

            point_1_percent_of_current_mean <- ((BAR_OUTPUT$data$Value[Condition_Pos]/100)*.1)                          # draw original bar -> avoids any issue with 'fill' and drawing incorrect height
            BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width)                          # drawing lines (via minusing mean) above 0 on y-axis             while((BAR_OUTPUT$data$Value[Condition_Pos])>=two_percent_of_largest_mean){ 

              # this breaks while loop to prevent going below x-axis 0
              if(((as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-(ggplot2_plot$data$Value[Condition_Pos]/100))<0){

                break

              }

              # check null value
              if (is.null(fill_value)){

                BAR_OUTPUT$data$Value[Condition_Pos]<-(as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-two_percent_of_largest_mean

                if(((BAR_OUTPUT$data$Value[Condition_Pos])<((two_percent_of_largest_mean/100)*15))){

                  break

                }

                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width)

              }

              if (!is.null(fill_value)){

                BAR_OUTPUT$data$Value[Condition_Pos]<-(as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-two_percent_of_largest_mean

                if(((BAR_OUTPUT$data$Value[Condition_Pos])<((two_percent_of_largest_mean/100)*15))){

                  break

                }

                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width, fill=fill_value)

              }

            }

          } # end of if grepl 'B'

          if ((!grepl('A', df$Pattern[pos], ignore.case=TRUE))==TRUE){
          # Only run this code if 'A' is NOT in string - issue lies in BAR_OUTPUT value
            if ((grepl('C', df$Pattern[pos], ignore.case=TRUE))){

              Condition_Pos<-as.numeric(df$Condition[pos])                              if ((grepl('B', df$Pattern[pos], ignore.case=TRUE))){                 # draw original bar -> avoids any issue with 'fill' and drawing incorrect height
                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width)

                point_1_percent_of_current_mean <- ((BAR_OUTPUT$data$Value[Condition_Pos]/100)*.1)                                  while((BAR_OUTPUT$data$Value[Condition_Pos])>=two_percent_of_largest_mean){

                  # this breaks while loop to prevent going below x-axis 0
                  if(((as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-(ggplot2_plot$data$Value[Condition_Pos]/100))<0){

                    break

                  }

                  BAR_OUTPUT$data$Value[Condition_Pos]<-(as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-two_percent_of_largest_mean

                  # This stops line very close to 0 on y-axis
                  if(((BAR_OUTPUT$data$Value[Condition_Pos])<((two_percent_of_largest_mean/100)*15))){

                    break

                  }

                  BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width, fill='transparent')

                }

              } # end of sub grepl 'B'

              # Code for right leaning diagonal 'C'
              position_input_x<-as.numeric(df$Condition[pos])
              position_input_y<-as.numeric(df$Condition[pos])
              # half of input width
              # when minused from centre of bar point on x-axis
              # it gives value at start of bar on x-axis
              # inverse true for end of bar width
              half_input_width<-input_width/2
              ten_perc_input_width<-((input_width/100)*10)

              x_axis_min <- position_input_x-half_input_width
              x_axis_max <- position_input_x+half_input_width

              y_axis_max<- ggplot2_plot$data$Value[position_input_y]
              # need to pull the max value from the example_plot the max boundries...
              # or caluclate the
              z_percent_of_current_mean<-(y_axis_max/100)*10

              df_diag <- data.frame(

                                  # start on x-axis-end on x-axis
                                  x = c(x_axis_min,x_axis_min),

                                  # start on y-axis-end on y-axis
                                  y = c(y_axis_max,y_axis_max), Fill='Hope you\'re having a nice day.')

             for(i in 1:19){

                # run if 2nd x-position is less or equal to rightmost edge of bar
                # minus 10% of total input width
                if (df_diag$x[2]<(as.character(x_axis_max))){

                  # 1/10 of unit value in width field
                  df_diag$x[2]<-df_diag$x[2]+(ten_perc_input_width)

                  # subtract z percent from 1st y height
                  df_diag$y[1]<-df_diag$y[1]-(z_percent_of_current_mean)

                  # draw using current df_diag values
                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when less than x_axis_max

                # run this code to limit 2nd x-point from moving past rightmost edge of bar
                if (df_diag$x[2]==as.character(x_axis_max)){

                  # drop height of 2nd y-position by z percentage
                  df_diag$y[2]<-df_diag$y[2]-(z_percent_of_current_mean)

                  if(df_diag$y[1]<=z_percent_of_current_mean){

                    df_diag$x[1]<-df_diag$x[1]+ten_perc_input_width
                  }

                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when x_axis_max reached

              } # end of for loop 1:19

            } # end of grepl 'C'

            if ((grepl('D', df$Pattern[pos], ignore.case=TRUE))){

              Condition_Pos<-as.numeric(df$Condition[pos])                              if ((grepl('B', df$Pattern[pos], ignore.case=TRUE))){                                  # draw original bar -> avoids any issue with 'fill' and drawing incorrect height
                BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width)

                point_1_percent_of_current_mean <- ((BAR_OUTPUT$data$Value[Condition_Pos]/100)*.1)                                  while((BAR_OUTPUT$data$Value[Condition_Pos])>=two_percent_of_largest_mean){

                  # this breaks while loop to prevent going below x-axis 0
                  if(((as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-(ggplot2_plot$data$Value[Condition_Pos]/100))<0){

                    break

                  }

                  BAR_OUTPUT$data$Value[Condition_Pos]<-(as.numeric(BAR_OUTPUT$data$Value[Condition_Pos]))-two_percent_of_largest_mean

                  # This stops line very close to 0 on y-axis
                  if(((BAR_OUTPUT$data$Value[Condition_Pos])<((two_percent_of_largest_mean/100)*15))){

                    break

                  }

                  BAR_OUTPUT<-BAR_OUTPUT+geom_bar(data=BAR_OUTPUT$data[Condition_Pos,], position=position_dodge(input_position_dodge), stat="identity", colour=input_colour, size=input_size, width = ggplot2_plot$layers[[1]]$geom_params$width, fill='transparent')

                }

              } # end of sub grepl 'B'

              # Code for left leaning diagonal 'D'
              position_input_x<-as.numeric(df$Condition[pos])
              position_input_y<-as.numeric(df$Condition[pos])
              # half of input width
              # when minused from centre of bar point on x-axis
              # it gives value at start of bar on x-axis
              # inverse true for end of bar width
              half_input_width<-input_width/2
              ten_perc_input_width<-((input_width/100)*10)

              x_axis_min <- position_input_x-half_input_width
              x_axis_max <- position_input_x+half_input_width

              y_axis_max<- ggplot2_plot$data$Value[position_input_y]
              # need to pull the max value from the example_plot the max boundries...
              # or caluclate the
              z_percent_of_current_mean<-(y_axis_max/100)*10

              df_diag <- data.frame(                                  # start on x-axis-end on x-axis                 x = c(x_axis_max,x_axis_max),                                                   # start on y-axis-end on y-axis                 y = c(y_axis_max,y_axis_max), Fill='Hope you\'re having a nice day.')                                             for(i in 1:19){                                  # run if 1st x-position is less or equal to leftmost edge of bar                 # minus 10% of total input width                 if (df_diag$x[2]>(as.character(x_axis_min))){

                  # 1/10 of unit value in width field
                  df_diag$x[2]<-df_diag$x[2]-(ten_perc_input_width)

                  # subtract z percent from 1st y height
                  df_diag$y[1]<-df_diag$y[1]-(z_percent_of_current_mean)

                  # draw using current df_diag values
                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when less than x_axis_max

                # run this code to limit 2nd x-point from moving past rightmost edge of bar
                if (df_diag$x[2]==as.character(x_axis_min)){

                  # drop height of 2nd y-position by z percentage
                  df_diag$y[2]<-df_diag$y[2]-(z_percent_of_current_mean)

                  if(df_diag$y[1]<=z_percent_of_current_mean){

                    df_diag$x[1]<-df_diag$x[1]-ten_perc_input_width
                  }

                  BAR_OUTPUT<-BAR_OUTPUT+geom_path(data=df_diag, aes(x=x, y=y),colour = "black")

                } # end of if statement when x_axis_max reached

              } # end of for loop 1:19

            } # end of grepl 'D'

        } # end of no 'A' if statment

        }  

        } # second loop

      BAR_OUTPUT

  }

Below is some example data and a brief explanation of how to use the function.


library(ggplot2)

Example.Data<- data.frame(matrix(vector(), 0, 3, dimnames=list(c(), c("Value", "Variable", "Fill"))), stringsAsFactors=F)

Example.Data[1, ] <- c(80.9, 'Horizontal Pattern','Horizontal Pattern' )
Example.Data[2, ] <- c(67.677777, 'Vertical Pattern','Vertical Pattern' )
Example.Data[3, ] <- c(10.678, 'Mesh HorizVert Pattern','Mesh HorizVert Pattern' )
Example.Data[4,] <- c(95.8, 'Diagonal Pattern 1','Diagonal Pattern 1' )
Example.Data[5,] <- c(67.67, 'Diagonal Pattern 2','Diagonal Pattern 2' )
Example.Data[6,] <- c(58.9, 'Mesh Diagonal Pattern','Mesh Diagonal Pattern' )
Example.Data[7,] <- c(75, 'Mesh HorizVertDiag Pattern','Mesh HorizVertDiag Pattern' )

HighlightDataVert<-Example.Data[2, ]
HighlightHorizontal<-Example.Data[1, ]
HighlightMesh<-Example.Data[3, ]
HighlightHorizontal$Value<-as.numeric(HighlightHorizontal$Value)
Example.Data$Value<-as.numeric(Example.Data$Value)

example_plot<-ggplot(Example.Data, aes(x=Variable, y=Value, fill=factor(Fill))) +
  theme_bw() +
  theme(legend.position = "none")+
  scale_fill_grey(start=.4)+
  geom_bar(position='identity', stat="identity", colour="black", width=.86565656)

example_plot

# Understanding the EggHatch function:

# Patterns are represented by letters and assigned by row numbers.
# You can combine patterns by combining letters, for example: AB, ABC etc.
#
# Letters for each pattern:
# A=vertical lines
# B=horizontal lines
# C=diagonal lines bottom-top
# D=diagonal lines top-bottom

# Simply drop the already created ggplot2 bar plot into the function, as shown
# below, and make the desired pattern/s = the desired row number
# NOTE: the numbers correspond to the row in the dataframe NOT the default plot output order of bars
# You can simplify by using the Relevel function in library(Epi) if you want to reorder
# the rows in the dataframe to match the desired order of bars in the plot.
EggHatch_output<-EggHatch(example_plot, ('b=1, A=2, Ba=3, C=4, d=5, Dc=6, ABcD=7'))

EggHatch_output

And here’s the output:

EggHatch

There is plenty of repetition of code in this function that can be elimated relatively easily by dropping some of the separate patterns code into functions. However, I’ll leave it as it is for now so that it is (in my opinion) clear what the inner workings of each pattern is.

When/if I find time I’ll adapt the code here to allow for diagonal patterns in facet_grid. Until then I hope someone finds this useful. If you have found this function useful feel free to add a vote to the answer I gave to the original question posed on StackOverflow.

FINAL NOTE: you are free to use this code but I’d appreciate credit (even if you adapt my original code) where possible, and please don’t try to pass this work off as your own.

Advertisements

The Price of Knowledge.

There is a debate raging at the moment surrounding the practice of hiding research behind paywalls. The controversy lies not least in that many argue scientific research should be free and accessible to all, and that monetising it is counterproductive/unethical. But the fact that the scientists that conduct the research are not paid once their work has been accepted and published, highlights a strange model that favours the journals alone. I’m not going to get into debates about impact factors and that journals also have running costs. There are plenty of points on both sides of these arguments and the debate is easily found on the web. Instead I’m going to point you, the reader, to approaches used in accessing paywalled papers. This is simply an academic collection/cataloguing of approaches that people are currently using to bypass paywalls.

Disclaimer: The sci-hub site is currently being challenged in courts in America and I don’t necessarily advocate using this approach. I’m merely demonstrating how people get around paywalls when their university cannot afford the licence fees etc. Here is a piece on the origins of the sci-hub site etc. : http://bigthink.com/neurobonkers/a-pirate-bay-for-science

The following is a list of approaches I’ve discovered online that people use to bypass scientific journal paywalls:

1) Search on Google using this format: “paper name” filetype:pdf site:edu

2) Check out r/scholar

3) Use the hastag: #canihazpdf on twitter along with a link to the paper (or its title) and your email address.

4) Here’s another approach to try and gain access to articles behind pay-walls: https://t.co/ZigAgimxW7

5a) You can also go straight here: http://sci-hub.io/  http://sci-hub.cc/ and search for your paper of choice.

5b) This is an extension of the above and allows access from the url that hosts the paper of interest:

I’ll use an example. Say you want to access this article that is pay-walled:

http://www.nature.com/neuro/journal/v18/n10/full/nn.4105.html

By adding this:

.sci-hub.io .sci-hub.cc

straight after the .com you will be able to access the article for free via the sci-hub website.

Here’s the amended URL:

http://www.nature.com.sci-hub.io/neuro/journal/v18/n10/full/nn.4105.html

http://www.nature.com.sci-hub.cc/neuro/journal/v18/n10/full/nn.4105.html

6) Of course many academics also contact one of the authors of a paper via email who often are more than happy to forward a copy of their research for free. Professional and polite is the order of the day in this approach.

Again, sci-hub is currently being challenged in American courts so I am not advocating or recommending the use of the sci-hub website. The above paper is used merely as an example of how people use this approach and this blog is purely an academic exercise in cataloguing approaches currently being used by people to bypass paywalls in scientific journals.

Handling Images in the Digital Age.

Legal representatives of the British Royal family have pursued action in French courts due to the publishing of naked images of one of the most recent people brought into their fold. The first steps of this legal move resulted in (as reported by the BBC News website):

  • A court in Paris ruled the publishers of Closer must hand over the original photographs within 24 hours or face a daily fine of 10,000 euros (£8,000).

Before actually taking on board the above statement I think a necessary digression is in order.

Since the horrific chain of events which ultimately led to the death of Diana Spencer there is, understandably,  an obvious sensitivity surrounding paparazzi and her surviving children. However, gradually the media have gone to great lengths to attempt to recapture the public obsession surrounding Diana with her son William and more importantly his wife Kate Middleton. The media frenzy surrounding their wedding is evidence enough. The machine grinds on.

True to form, the peddlers of celebrity snap shots (and what a service they provide the world) have yet again crossed the line – thankfully nothing like the aforementioned tragedy – which separates mutually beneficial publicity from what is deemed inappropriate and boy is that a fine line. The recent ‘topless’ images of Kate Middleton have caused all sorts of outcry from Royalists and the like. I won’t delve into why the backlash is so much more severe when it comes to images of a princess – I even shudder at typing the word –  when compared to a ‘regular’ celebrity. That’s a whole other topic of discussion which ultimately revolves around class in society. However, I’ll go on the record and suggest that no one deserves the unwanted attention of paparazzi, and it is indeed distasteful for them to be harassing the family of a woman who died indirectly due to their pursuit, but I also think that this reaction to a topless image of someone who benefits from media attention in the same way as other celebrities who are victims of this extreme voyeurism is certainly disproportionate. Either condemn all voyeuristic, opportunistic pictures of celebrities equally or keep schtum. Kate Middleton is not deserving of special treatment in this regard. It should be one rule for all. She should have no more or less rights than the average Joe.

Getting back on topic. The quote above clearly states that the publishers of the image have to hand over the ‘original photographs’ . Consider that instruction. Assuming the images were digital – which I think is a fair assumption to make in 2012 – you have to wonder what exactly qualifies as the ‘original photographs’? Was it the first digital files saved on the camera? The transferred files from the camera to the computer? The first email with the images attached to it that was sent to Closer? The one of doubtless many emails circulated within the confines of Closer headquarters? Also, how does one go about handing over these originals? Forward an email to the legal team? I think I’ve made my point. This seems like an exercise in futility. If they were printed images with negatives attached this order would make sense but in the digital age it’s almost laughable.

I’m sure all of this will rumble on with continued cries of outrage at the nerve of a French magazine to publish such images of a royal for the foreseeable few days – maybe weeks – but I don’t think this court ruling can be considered a victory since it makes little sense and will have virtually no impact. After all, the images are only a Google click away now and I doubt they fall under the definition of being the originals.