使用R重新创建Igor中创建的等高线图

本文介绍了使用R重新创建Igor中创建的等高线图的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 这个等高线图是用Igor程序制作的，在大气化学和污染研究中很受欢迎： 我试图用R来重新创建一个想停止使用Igor的朋友，但我们无法完全理解它。这里是 我的情节可以做更多的标签和刻度标记等。然而，我的主要问题是为什么我的轮廓填充看起来如此不同从伊戈尔情节。尺度看起来相反，插值看起来非常不同。 我怎样才能让我的情节看起来更像Igor情节？ 请注意，我的这些其他问题与重新创建此图的任务密切相关： 绿色和蓝色渐变与Igor情节有点不同。我的绿色很少！也许进一步的色彩坡道试验可能会改善那里的匹配。 要获得对数坐标的y轴，需要做一些额外的工作。我们必须使用 geom_rect 并调整每个矩形的大小以适合日志比例： ##################具有对数刻度的y轴#################### ####### ＃获得视觉上逐渐减少的轴点滴 base_breaks< - function（n = 10）{ function（x）{ axisTicks（log10（range （x，na.rm = TRUE）），log = TRUE，n = n）} } ＃现在用log轴，我们需要替换ymin和（唯一的（dat_interp_df_long_diameter）））/ 2 upper lower ＃创建xmin，xmax，ymin，ymax dat_interp_df_long $ xmin dat_interp_df_long $ xmax idx dat_interp_df_long $ ymin& lt; - unlist（lapply（lower，function（i）rep（i，idx））） dat_interp_df_long $ ymax< - unlist（lapply（upper，function（i）rep（i，idx））） ggplot（dat_interp_df_long，aes（y = Diameter，x = Time， xmin = xmin，xmax = xmax，ymin = ymin，ymax = ymax， fill = dN_dlogDp_log））+ geom_rect（）+ scale_fill_gradientn（name = expression（log（dN / dlogD [p]）），colors = blue2green2red（1000））+ scale_y_continuous（expand = c（0,0）， trans = log_trans（），breaks = base_breaks（））+ scale_x_datetime（expand = c（0,0）， breaks = date_breaks_2h，标签= insert_minor（格式（date_breaks_1_day，％d％b），长度（date_breaks_1_day）））+ xlab（Day and time）+ ylab（Diameter（ nm））+ mytheme 更新 ＃调整颜色斜坡以匹配Igor图（它们的颜色斜坡非常不均匀！ ） colfunc< - colorRampPalette（c（rep（red，3）， rep（yellow，1）， rep（ green，2），cyan， rep（blue，3），purple）） y_labels_breaks< - seq（0，max （Diameter），100） mytheme< - theme_bw（base_size = 14）+ theme（aspect.ratio = 1/5） ggplot（dat_interp_df_long，aes（y = Diameter，x = Time，fill = dN_dlogDp_log））+ geom_raster（interpolate = TRUE）+ scale_fill_gradientn（name = expression（log（dN / dlogD [p]）），colors = rev（colfunc（100）））+ scale_y_continuous（expand = c（0,0）， labels = every_nth（y_labels_breaks，2，inverse = TRUE）， breaks = y_labels_breaks）+ scale_x_datetime（expand = c（0 ，0）， breaks = date_breaks_2h， labels = insert_m inor（format（date_breaks_1_day，％d％b）， length（date_breaks_1_day）））+ xlab（Day and time）+ ylab（Diameter（nm） ）+ mytheme p> 这篇文章的代码也在 https：/ /gist.github.com/benmarwick/9a54cbd325149a8ff405 更新我现在已经制作了一个可以生成这些图的软件包： https://github.com/benmarwick/smps This contour plot, made with the Igor program, is popular in atmospheric chemistry and pollution studies:I'm trying to recreate it with R for a friend who wants to stop using Igor, and we can't quite get it. Here's the dataset (the same data used to make the plot with Igor), and here's what I've got so far to make the plot with R:# read in the datadat <- read.csv("contour_plot_data.csv")# focus on the untransformed valuesdat <- dat[, 1:108]# get Diameter value from col namesDiameter <- as.numeric(gsub("X", "", names(dat)[-1]))# interpolate between the Diameter values for a smoother contour,# a seperate interpolation for each row (date value)# this takes a moment or two...interp <- seq(min(Diameter), max(Diameter), 0.2)dat_interp <- data.frame(matrix(0, ncol = length(interp), nrow = nrow(dat)))for(i in 1:nrow(dat)){ # get the values from row i vec <- unlist(dat[i, 2:108], use.names = FALSE) # compute loess interpolations lo <- loess(vec ~ Diameter) # predict interpolated values pr <- predict(lo, newdata = data.frame(Diameter = interp)) # store in a data frame df <- data.frame(ct = unname(pr), Diameter = interp) # add as new row to new data frame dat_interp[i, ] <- df$ct print(i) # so we can see that it's working}# add date col and col names to the interpolated datanames(dat_interp) <- interpdat_interp$date <- as.character(dat$Time)# melt data into long format# see http://www.cookbook-r.com/Manipulating_data/Converting_data_between_wide_and_long_format/library(tidyr)gather_cols <- interpdat_long <- gather_(dat_interp, "Diameter", "dN_dlogDp", gather_cols)# we want diameter as a numericdat_long$Diameter <- as.numeric(as.character(dat_long$Diameter))# we want date as a date formatx <- as.character(dat_long$date)date_ <- as.Date(x, format = "%d/%m/%Y") time_ <- gsub(" ", "", substr(x, nchar(x) - 4, nchar(x)))dat_long$date_time <- as.POSIXct(paste0(date_, " ", time_))# The Igor plot seems to use log dN_dlogDp values, so let's get thosedat_long$dN_dlogDp_log <- log10(dat_long$dN_dlogDp)dat_long$dN_dlogDp_log <- ifelse(dat_long$dN_dlogDp_log == "NaN", 0, dat_long$dN_dlogDp_log)# get on with plottong...library(ggplot2) library(scales)labels_breaks <- seq(0, max(Diameter), 100)mytheme <- theme_bw(base_size = 14) + theme(aspect.ratio = 1/4) ggplot(dat_long, aes(y = Diameter, x = date_time, fill=dN_dlogDp_log)) + geom_raster(interpolate = TRUE) + scale_fill_gradientn(name=expression(log(dN/dlogD[p])), colours = rainbow(7)) + scale_y_continuous(expand = c(0,0), breaks = labels_breaks ) + scale_x_datetime(expand = c(0,0), breaks = date_breaks("12 hours")) + ylab("Diameter (nm)") + xlab("Date and time") + mythemeMy plot could do with a little more finessing with labels and tick marks, etc. However, my main question is why my contour fill looks so different from the Igor plot. The scale seems reversed, and the interpolation looks very different.How can I make my plot look more like the Igor plot?Note that these other questions of mine are closely related to the task of recreating this plot: geom_raster interpolation with log scale2d density plot for categories And after I asked this question I have been keeping an updated gist of R code that combines details from the answers to these questions, and successfully replicates these plots (example output included in the gist). That gist is here: https://gist.github.com/benmarwick/9a54cbd325149a8ff405.UPDATE I've now made a package that will produce these plots: https://github.com/benmarwick/smps 解决方案 I can get a lot closer to the Igor plot using akima::interp instead of loess for the interpolation: # read in the datadat <- read.csv("contour_plot_data.csv")# focus on the untransformed valuesdat <- dat[, 1:108]# get Diameter value from col namesDiameter <- as.numeric(gsub("X", "", names(dat)[-1]))# melt data into long format# see http://www.cookbook-r.com/Manipulating_data/Converting_data_between_wide_and_long_format/library(tidyr)dat_long <- gather(dat, "Diameter", "dN_dlogDp", 2:108)# we want diameter as a numericdat_long$Diameter <- as.numeric(gsub("X", "", dat_long$Diameter ))# we want time as a date-formatted variablex <- as.character(dat_long$Time)date_ <- as.Date(x, format = "%d/%m/%Y") time_ <- gsub(" ", "", substr(x, nchar(x) - 4, nchar(x)))dat_long$Time <- as.POSIXct(paste0(date_, " ", time_))# The Igor plot seems to use log dN_dlogDp values, so let's get thosedat_long$dN_dlogDp_log <- log10(dat_long$dN_dlogDp)dat_long$dN_dlogDp_log <- ifelse(dat_long$dN_dlogDp_log == "NaN" | dat_long$dN_dlogDp_log == "-Inf" , 0, dat_long$dN_dlogDp_log)# interpolate between the values for a smoother contour# this takes a moment or two...library(akima)xo <- with(dat_long, seq(min(Time), max(Time), 120))yo <- with(dat_long, seq(min(Diameter), max(Diameter), 0.5))dat_interp <- with(dat_long, interp(Time, Diameter, dN_dlogDp_log, xo = xo, yo = yo) )# get on with plotting...# make into a data frame for ggplotdat_interp_df <- data.frame(matrix(data = dat_interp$z, ncol = length(dat_interp$y), nrow = length(dat_interp$x)))names(dat_interp_df) <- dat_interp$ydat_interp_df$Time <- as.POSIXct(dat_interp$x, origin = "1970-01-01")# wide to longdat_interp_df_long <- gather(dat_interp_df, "Diameter", "dN_dlogDp_log", 1:(ncol(dat_interp_df)-1))dat_interp_df_long$Diameter <- as.numeric(as.character(dat_interp_df_long$Diameter))# plotlibrary(ggplot2) library(scales)y_labels_breaks <- seq(0, max(Diameter), 100)ggplot(dat_interp_df_long, aes(y = Diameter, x = Time, fill = dN_dlogDp_log)) + geom_raster(interpolate = TRUE) + scale_fill_gradientn(name=expression(log(dN/dlogD[p])), colours = rev(rainbow(50))) + scale_y_continuous(expand = c(0,0), breaks = y_labels_breaks ) + scale_x_datetime(expand = c(0,0), breaks = date_breaks("1 day"))But there is still quite a big difference in the colour mapping, with the Igor plot having wide bands with sharp boundaries, and my plot has fewer colour bands and fuzzy boundaries between them. So I guess I don't quite have the interpolation method that the Igor plot uses. UPDATE after experimenting with a bunch of colour ramps, I've found a pretty good match in colorRamps::blue2green2red. I've also put a bit of effort here into fancy tickmarks:# plotlibrary(ggplot2) library(scales) # for date_breakslibrary(colorRamps) # for blue2green2red# function for minor tick marksevery_nth <- function(x, nth, empty = TRUE, inverse = FALSE) { if (!inverse) { if(empty) { x[1:nth == 1] <- "" x } else { x[1:nth != 1] } } else { if(empty) { x[1:nth != 1] <- "" x } else { x[1:nth == 1] } }}# add tick marks every two hoursstart_date <- min(dat_interp_df_long$Time)end_date <- max(dat_interp_df_long$Time)date_breaks_2h <- seq(from = start_date, to = end_date, by = "2 hours")date_breaks_1_day <- seq(from = start_date, to = end_date, by = "1 day")multiple <- length(date_breaks_2h) / length(date_breaks_1_day)insert_minor <- function(major_labs, n_minor) {labs <- c( sapply( major_labs, function(x) c(x, rep("", multiple) ) ) )labs[1:(length(labs)-n_minor)]}y_labels_breaks <- seq(0, max(Diameter), 100)mytheme <- theme_bw(base_size = 14) + theme(aspect.ratio = 1/5)ggplot(dat_interp_df_long, aes(y = Diameter, x = Time, fill = dN_dlogDp_log)) + geom_raster(interpolate = TRUE) + scale_fill_gradientn(name=expression(log(dN/dlogD[p])), colours = blue2green2red(100)) + scale_y_continuous(expand = c(0,0), labels = every_nth(y_labels_breaks, 2, inverse = TRUE), breaks = y_labels_breaks) + scale_x_datetime(expand = c(0,0), breaks=date_breaks_2h, labels=insert_minor(format(date_breaks_1_day, "%d %b"), length(date_breaks_1_day))) + xlab("Day and time") + ylab("Diameter (nm)") + mythemeThe green-blue gradient is still a bit different from the Igor plot. I have very little green at all! Perhaps further experimentation with colour ramps might improve the match there. To get the y-axis on a log scale, some additional effort is required. We have to use geom_rect and adjust the sizes of each rectangle to fit in the log scale:################## y-axis with log scale ############################ get visually diminishing axis ticksbase_breaks <- function(n = 10){ function(x) { axisTicks(log10(range(x, na.rm = TRUE)), log = TRUE, n = n) }}# Now with log axis, we need to replace the ymin and ymaxdistance <- diff((unique(dat_interp_df_long$Diameter)))/2upper <- (unique(dat_interp_df_long$Diameter)) + c(distance, distance[length(distance)])lower <- (unique(dat_interp_df_long$Diameter)) - c(distance[1], distance) # Create xmin, xmax, ymin, ymaxdat_interp_df_long$xmin <- dat_interp_df_long$Time - 1000 # default of geom_raster is 0.5dat_interp_df_long$xmax <- dat_interp_df_long$Time + 1000idx <- rle(dat_interp_df_long$Diameter)$lengths[1]dat_interp_df_long$ymin <- unlist(lapply(lower, function(i) rep(i, idx)))dat_interp_df_long$ymax <- unlist(lapply(upper, function(i) rep(i, idx)))ggplot(dat_interp_df_long, aes(y = Diameter, x = Time, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, fill = dN_dlogDp_log)) + geom_rect() + scale_fill_gradientn(name=expression(log(dN/dlogD[p])), colours = blue2green2red(1000)) + scale_y_continuous(expand = c(0,0), trans = log_trans(), breaks = base_breaks()) + scale_x_datetime(expand = c(0,0), breaks=date_breaks_2h, labels=insert_minor(format(date_breaks_1_day, "%d %b"), length(date_breaks_1_day))) + xlab("Day and time") + ylab("Diameter (nm)") + mythemeUPDATE After some experimentation with colour ramps, I've found a pretty close match:# adjust the colour ramp to match the Igor plot (their colour ramp is pretty uneven! lots of red and blue, it seems.)colfunc <- colorRampPalette(c( rep("red", 3), rep("yellow", 1), rep("green", 2), "cyan", rep("blue", 3), "purple"))y_labels_breaks <- seq(0, max(Diameter), 100)mytheme <- theme_bw(base_size = 14) + theme(aspect.ratio = 1/5)ggplot(dat_interp_df_long, aes(y = Diameter, x = Time, fill = dN_dlogDp_log)) + geom_raster(interpolate = TRUE) + scale_fill_gradientn(name=expression(log(dN/dlogD[p])), colours = rev(colfunc(100))) + scale_y_continuous(expand = c(0,0), labels = every_nth(y_labels_breaks, 2, inverse = TRUE), breaks = y_labels_breaks) + scale_x_datetime(expand = c(0,0), breaks=date_breaks_2h, labels=insert_minor(format(date_breaks_1_day, "%d %b"), length(date_breaks_1_day))) + xlab("Day and time") + ylab("Diameter (nm)") + mythemeThe code from this post is also at https://gist.github.com/benmarwick/9a54cbd325149a8ff405UPDATE I've now made a package that will produce these plots: https://github.com/benmarwick/smps 这篇关于使用R重新创建Igor中创建的等高线图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！