簡體   English   中英

使用循環在R中繪制

[英]Plots in R using Loops

我不是程序員,但是我已經學會了將R用於統計的基礎知識。 我將盡力描述我的問題:

我有一個包含120列的表格,其中每一列代表兩個時間點(2017年和1920年)的小通道的橫截面坐標(x或y)。表的第一行是橫截面坐標的名稱,例如“ 7X”和“ 7Y”是2017年名為“ 7”的部分的(x,y)坐標,而“ 7BX”和“ 7BY”是1920年同一部分“ 7”的坐標。為了使用R繪制線形圖,並使用以下代碼將其中的4個圖容納在單個圖形中進行打印,並使用以下代碼(其中R中的表名為“ SEC”),我使用ggpubr軟件包將單獨的圖形放在一起:

library(ggpubr)

g <- ggplot(SEC, aes(x=`7X`, y = `7Y`, colour = "Observed"))+geom_line()+
  geom_line(aes(x = `7BX`,y = `7BY`, colour = "1974"), linetype = "dashed") +
  labs(x = "Distance [cm]", y = "Depth [cm]") + coord_equal() + 
  scale_x_continuous(position = "top", limits = c(0,750)) + 
  scale_y_continuous(limits = c(-280,0)) + 
  scale_colour_manual("", breaks = c("Observed", "1974"), values = c("Observed"="black", "1974"="blue"))
g2 <- ggplot(SEC, aes(x=`10X`, y = `10Y`, colour = "Observed"))+geom_line()+
  geom_line(aes(x = `10BX`,y = `10BY`, colour = "1974"), linetype = "dashed") +
  labs(x = "Distance [cm]", y = "Depth [cm]") + coord_equal() + 
  scale_x_continuous(position = "top", limits = c(0,750)) + 
  scale_y_continuous(limits = c(-280,0)) + 
  scale_colour_manual("", breaks = c("Observed", "1974"), values = c("Observed"="black", "1974"="blue"))
g3 <- ggplot(SEC, aes(x=`13X`, y = `13Y`, colour = "Observed"))+geom_line()+
  geom_line(aes(x = `13BX`,y = `13BY`, colour = "1974"), linetype = "dashed") +
  labs(x = "Distance [cm]", y = "Depth [cm]") + coord_equal() + 
  scale_x_continuous(position = "top", limits = c(0,750)) + 
  scale_y_continuous(limits = c(-280,0)) + 
  scale_colour_manual("", breaks = c("Observed", "1974"), values = c("Observed"="black", "1974"="blue"))
g4 <- ggplot(SEC, aes(x=`14X`, y = `14Y`, colour = "Observed"))+geom_line()+
  geom_line(aes(x = `14BX`,y = `14BY`, colour = "1974"), linetype = "dashed") +
  labs(x = "Distance [cm]", y = "Depth [cm]") + coord_equal() + 
  scale_x_continuous(position = "top", limits = c(0,750)) + 
  scale_y_continuous(limits = c(-280,0)) + 
  scale_colour_manual("", breaks = c("Observed", "1974"), values = c("Observed"="black", "1974"="blue"))


ggarrange(g, g2, g3, g4, ncol = 2, nrow = 2, common.legend = TRUE, legend = "bottom")

上面的代碼生成下圖(請注意,我在R studio環境中使用了縮放,然后右鍵單擊->在縮放的圖片上復制圖片並粘貼在繪畫上,因為我仍然不知道如何正確地將其另存為圖片“縮放”級別): 使用以上代碼生成的圖

到那時為止,一切都很完美。 我的問題是如何在代碼中添加循環以每4列執行一次此圖並將其另存為png,jpg或類似內容。

我使用的數據(為共享而修改)是:

  SEC <- structure(list(`7X` = c(7.5, 15, 22.5, 30, 37.5, 45, 52.5, 60, 
67.5, 75, 82.5, 90, 97.5, 105, 112.5, 120, 127.5, 135, 142.5, 
150, 157.5, 165, 172.5, 180, 187.5, 195, 202.5, 210, 217.5, 225, 
232.5, 240, 247.5, 255, 262.5, 270, 277.5, 285, 292.5, 300, 307.5, 
315, 322.5, 330, 337.5, 345, 352.5, 360, 367.5, NA, NA, NA, NA, 
NA, NA, NA, NA, NA), `7Y` = c(-25.9671090715505, -47.4607397762232, 
-53.7559172609319, -63.3665293310876, -66.6777325668064, -73.7850158514536, 
-75.8786077662389, -78.4717300522204, -86.6122602392833, -86.5085656086825, 
-99.7082525346791, -106.066956054077, -104.893267727827, -103.768964560977, 
-101.143312965043, -103.962172334764, -104.758547162389, -102.136349931386, 
-110.815517978626, -111.363366631309, -111.050166912353, -105.649062617965, 
-105.910377967987, -104.4320913694, -113.768783085737, -119.518754325158, 
-131.902196495777, -132.44782879906, -135.956263880875, -133.892807725805, 
-133.693311165822, -136.954487539369, -136.880936445156, -136.861399724998, 
-137.24878640853, -139.889844889866, -140.123989192931, -139.964791362668, 
-142.767842490807, -139.984728213883, -139.514265170192, -133.47785217087, 
-82.7273919344385, -75.020643340269, -61.9680666387492, -53.2860080778223, 
-51.0896682486046, -44.6102547614017, -35.7014461630998, NA, 
NA, NA, NA, NA, NA, NA, NA, NA), `7BX` = c(0, 440, 640, 1080, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA), `7BY` = c(0, -210, -210, 0, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA), `10X` = c(32, 40, 48, 56, 64, 72, 80, 88, 96, 
104, 112, 120, 128, 136, 144, 152, 160, 168, 176, 184, 192, 200, 
208, 216, 224, 232, 240, 248, 256, 264, 272, 280, 288, 296, 304, 
312, 320, 328, 336, 344, 352, 360, 368, 376, 384, 392, 400, 408, 
416, 424, 432, 440, 448, 456, 464, 472, 480, 488), `10Y` = c(-94.5966356796394, 
-98.9763004291606, -103.076968535357, -106.962218988179, -110.617820502447, 
-114.115499665262, -116.110479384182, -120.384670012772, -135.012443220999, 
-140.641277783522, -149.397077818365, -152.23251255149, -154.594844651231, 
-161.870765592212, -169.050648283188, -168.468938070109, -178.406458075646, 
-189.60326884302, -185.215711843659, -192.652302594034, -204.420567844116, 
-214.802445709178, -262.006760906245, -269.627846515966, -271.928416747414, 
-280.842869544577, -286.192359059652, -286.393432557465, -287.096960178529, 
-286.681850224408, -286.247209161192, -283.325346268317, -280.952049206594, 
-275.950384188228, -258.70613971596, -259.410546763113, -245.655256400078, 
-236.838966940681, -228.287891246208, -225.674662960305, -225.790568242069, 
-226.182932581986, -226.575239267478, -227.964898636738, -226.343652570147, 
-200.896351276318, -191.905220163245, -175.399533006979, -168.597240169831, 
-163.1128036503, -157.861050484961, -155.229423199991, -139.207319012034, 
-127.927733637759, -120.782994141792, -113.149068161756, -109.895475650145, 
-94.4163178937629), `10BX` = c(0, 55, 300, 380, 550, 740, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA), `10BY` = c(0, -20, -155, -155, -30, 0, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA), `13X` = c(30, 60, 90, 120, 150, 180, 210, 240, 270, 300, 
330, 360, 390, 420, 450, 480, 510, 540, 570, 600, 630, 660, 690, 
720, 750, 780, 810, 840, 870, 900, 930, 960, 990, 1020, 1050, 
1080, 1110, 1140, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA), `13Y` = c(-130.280130140096, 
-133.314602565698, -155.755735588693, -165.349822633039, -163.527278504803, 
-164.127092741566, -168.544964800923, -168.010043126269, -172.859848036266, 
-182.767172542781, -172.116768890092, -172.5868812035, -173.634903800562, 
-176.611077660323, -179.665100040058, -176.989870773949, -180.77134156612, 
-183.742221306137, -183.799677917615, -180.703438314547, -195.745531287296, 
-207.31260678753, -222.757679568742, -225.343317270965, -230.478091545319, 
-232.25420677185, -224.230717742185, -217.685383613481, -213.890519933422, 
-203.152992365013, -200.464974159305, -195.833697602067, -175.547017122402, 
-172.802992846061, -160.173459133272, -159.843210575388, -155.227573251256, 
-130.275570551425, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA), `13BX` = c(0, 308, 378, 
700, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA), `13BY` = c(0, -70.5943380693977, 
-142.827413298, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `14X` = c(40, 80, 
120, 160, 200, 240, 280, 320, 360, 400, 440, 480, 520, 560, 600, 
640, 680, 720, 760, 800, 840, 880, 920, 960, 1000, 1040, 1080, 
1120, 1160, 1200, 1240, 1280, 1320, 1360, 1400, 1440, 1480, 1520, 
1560, 1600, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA), `14Y` = c(-145.990632758813, -150.826188851428, 
-163.682940701739, -172.043833955967, -182.53083213644, -191.353726599893, 
-197.584471071481, -200.834572726043, -207.495959099511, -210.65543163322, 
-209.939464279794, -216.671860614474, -225.310844045373, -232.206404957882, 
-234.306313434513, -243.524048340371, -245.209549795867, -249.902953463223, 
-255.057143558744, -245.369858504693, -220.664700874663, -206.676224685967, 
-205.23664115722, -200.759982388337, -200.092376111362, -200.431526555313, 
-200.338637172383, -200.111899718351, -203.759654556748, -206.71146837615, 
-204.674270849751, -201.336543870959, -200.845407082769, -197.435021642656, 
-192.266899943151, -191.237294125464, -173.518399500314, -166.786712970063, 
-165.921143424977, -145.856527067335, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `14BX` = c(0, 
360, 460, 800, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `14BY` = c(0, -43.3291743105714, 
-118.074399602666, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)), .Names = c("7X", 
"7Y", "7BX", "7BY", "10X", "10Y", "10BX", "10BY", "13X", "13Y", 
"13BX", "13BY", "14X", "14Y", "14BX", "14BY"), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -58L))

感謝您的任何建議,如果缺少某些內容或問題/問題沒有正確設置,我們深表歉意。

1.很抱歉告訴您這一點,但是您的數據集一團糟。

是的,您可以遍歷列索引並使用get()或類似方法以編程方式訪問列。 但是 ,對於任何其他情況,此代碼都是非常不可讀的且無用。

最佳做法是認識到您實際上只是在不同的時間和位置有兩個觀測值-X和Y。 除了按組觀察的ID之外,當前行實際上不表示其他任何內容。 就像有人剛將一堆XY對並排粘貼在電子表格上一樣。

您理想的數據集將包含四列:

  • 段ID(例如7)
  • 時間點(即,已觀察或B / 1974)
  • X
  • ÿ

因此,首先讓我們將數據放入這種“長”格式。 您應該檢查tidyverse以及有關SO的許多相關問題。 我們還將使用正則表達式來解析關鍵信息。

#----- These functions help you parse your section/time codes ------
#----- To understand them, use the regex tutorial linked above.  ---
keyStartingDigits <- function(s) as.integer(regmatches(s ,regexpr('^\\d+',s) ))
keyEndingXorY     <- function(s) regmatches(s ,regexpr('[XY]$',s) )
#----- This function helps you parse observed/historical  ----------
keyTime <- function(s) {
  factor(
    ifelse(substr(s,nchar(s)-1,nchar(s)-1)=='B',
           '1974',
           'Observed'
    ), levels=c('1974','Observed')
  )
}

library(dplyr) # \  popular libaries for data manipulation
library(tidyr) # /  part of the 'tidyverse'
df <- 
  SEC %>% 
    mutate(obs_id = 1:n()) %>%
    gather(key=key, value=measurement,-obs_id, na.rm=TRUE) %>% # produces key-value pairs, e.g. [7X, 7.5]
    mutate(section=keyStartingDigits(key), # section ID, e.g. 7
           time = keyTime(key),            # 1974 or Observed
           dimension = keyEndingXorY(key)  # X or Y
           ) %>%
    select(-key) %>%
    spread(dimension,measurement) %>%
    select(-obs_id)

現在,您有了一個不錯的數據集,如下所示。

# > head(df)
# # A tibble: 6 x 4
#   section     time     X          Y
#     <chr>   <fctr> <dbl>      <dbl>
# 1      10     1974     0    0.00000
# 2      10 Observed    32  -94.59664
# 3      13     1974     0    0.00000
# 4      13 Observed    30 -130.28013
# 5      14     1974     0    0.00000
# 6      14 Observed    40 -145.99063

現在,您可以在列值(而不是列名!)中使用分組變量了,在此更自然地進行分組。

2.不要重復自己(干)

您需要一個具有一個幾何圖形的繪圖功能,而不是四個具有兩個幾何圖形的繪圖功能。 當您以適當的標准格式獲取數據時,使用相同的幾何圖形而不是繪制兩個子集即可輕松創建觀察到的和歷史的線。

library(ggplot2)
myPlot <- function(section){
  line_cols <- c('Observed'='black', '1974'='blue')
  line_types <- c('Observed'='solid', '1974'='dashed')

  ggplot(df[df$section==section,], aes(x=X, y = Y))+
    geom_line(aes(colour = time, linetype=time)) +
    labs(x = "Distance [cm]", y = "Depth [cm]", caption=paste('Section',section)) + 
    coord_equal() + 
    scale_x_continuous(position = "top", limits = c(0,750)) + 
    scale_y_continuous(limits = c(-280,0)) + 
    scale_colour_manual(values = line_cols, guide=FALSE) +
    scale_linetype_manual(values=line_types, guide=FALSE) +
    theme(plot.caption = element_text(hjust=0.5,size=rel(1.5)))
}
myPlot(7) # example

在此處輸入圖片說明

3.現在很容易按部分創建圖

有很多選項可以將地塊排列成網格。 您可以將地塊列表傳遞給您的安排功能。 該圖列表可以是已經創建的myPlot函數的一個lapply

library(gridExtra) # could also use ggarrange instead of marrangeGrob, or grid.arrange
pl <- lapply(sort(unique(df$section)), 
         function(i) myPlot(i)) # list of 4 plots
ggsave("plotgrid.png", 
       plot = marrangeGrob(pl, nrow=2, ncol=2), 
       device='png')

在此處輸入圖片說明

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM