使用兩個不同大小的數據幀從R Loop繪制圖

Question

我有2個大小不同的數據框-一個大約300行，另一個大約30行。 大小將取決於所選輸入。 我已經成功構建了R代碼，可以為每個輸入繪制一個循環的輸出，但是我無法弄清楚如何將所有迭代都放在一個圖表上。 關於多張圖的文章很多，但是到目前為止，我還沒有成功，那就是大小不同的數據框，在一張圖表上繪制所有（不同大小）的迭代（一頁上沒有多個圖表，一頁上沒有一張圖表） 。 以下是用於生成單個圖表的代碼-我只是不知道如何將它們全部放在同一張圖表上。

WellS <- rep(WellSelect[i], length(EW))
WellC <- rep(WellSelect[i], length(X))
dfSurvey <- data.frame(Well = WellS, MD = MD, EW = EW, NS = NS, TVD = TVD)
dfCalc <- data.frame(Well = WellC, Perf = P, X = X, Y = Y, TVDp = TVDp)

上面的代碼將此處未顯示的計算編譯到數據幀dfSurvey和dfCalc中。 請注意，“ WellSelect”是驅動用於計算的原始數據輸入的主要變量。 可能存在2到4000多個唯一的“ WellSelect”可能性，每個可能性都有2個數據幀，其大小在第一句中提到-都是“ WellSelect”唯一的。 除上述圖表外，其他所有功能均正常。 我試圖綁定數據幀，但不知道如何在不同大小的df上進行綁定。

pname <- paste0(dfSurvey$Well[i])
p <- ggplot() + geom_point(data = dfSurvey, aes(x=EW, y=NS), shape = 2,    size = 2, color = "blue1") +
  geom_point(data = dfCalc, aes(x=X, y=Y), shape = 17, size = 5, color = "Chartreuse3") +
  ggtitle(pname)
ggsave(paste0(pname, ".png"), p)
print(p)

請注意，“ dfSurvey”是較大的數據幀，而“ dfCalc”是較小的數據幀。 我希望得到一些指導。

編輯以包括數據集和示例圖：

這是我目前通過編碼獲得的圖：

每個“ WellSelect”當前都會生成自己的圖

這是我要實現的目標：

組合圖，請注意紅色三角形代表“ dfCalc”，實線是“ dfSurvey”

這些鏈接提供了“ DS”和“ Perf”的簡化示例數據集：

DS（請注意，繪制的變量是EW對NS）： https : //drive.google.com/open?id=0B5pFHCTpv6BWTUh3MWJoaVhaT0kxZzJFVWJ4QTFaM0Q5S29j

性能： https ：//drive.google.com/open ？ id = 0B5pFHCTpv6BWMjhLZnF3Zk9mM0hZaXYxLWVKUlBnWXlPQ0xB

我已經包含了下面代碼的整個寬度，應該使用上面的文件來運行這些代碼，最終將是上面所示的各個圖。 我知道代碼效率不高，但是我對此並不陌生，所以我只需要現在可以使用的東西。

library(ggplot2)

DS <- read.csv(file = "DirectionalSurveys.csv")
Perf <- read.csv(file = "Perforation.csv")

colnames(DS) <- c "IDWELL", "API", "WellName", "Division", "MD", "INCL", "AZIM", "NS", "EW", "TVD", "DLS")
colnames(Perf) <- c("IDWELL", "API", "WellName", "County", "MidPerfMD", "MidPerfTVD")

WellSelect <- c("LINDA GREATHOUSE BRK 1", "LINDA GREATHOUSE BRK 3", "LINDA GREATHOUSE BRK 5", "LINDA GREATHOUSE BRK 205",
            "BARRY GREATHOUSE A 5", "BARRY GREATHOUSE A 10", "BARRY GREATHOUSE B 3")

for(i in seq_along(WellSelect)) {

    S <- DS$MD[DS$WellName == WellSelect[i]]
    P <- Perf$MidPerfMD[Perf$WellName == WellSelect[i]]
    INCL <- DS$INCL[DS$WellName == WellSelect[i]]
    AZIM <- DS$AZIM[DS$WellName == WellSelect[i]]
    NS <- DS$NS[DS$WellName == WellSelect[i]]
    EW <- DS$EW[DS$WellName == WellSelect[i]]
    TVD <- DS$TVD[DS$WellName == WellSelect[i]]

    #Subset to get the survey depths deeper than "P"
    resultGT <- outer(S, P, '>=')
    resultGT[resultGT == FALSE] <- 50
    rownames(resultGT) <- paste0(S)
    colnames(resultGT) <- paste0("P=", P)
    minGT <- as.numeric(rownames(resultGT)[apply(resultGT , 2, which.min)])

    #P is mid-perf MD for each stage, Deep is Survey depth below P, Shallow is Survey depth above P

    deep <- S[match(minGT, S)]
    shallow <- S[match(minGT, S) - 1]

    #Subset "DS" to WellSelect
    Sub1 <- DS[DS$WellName == WellSelect[i], ]

    #Subset Sub1 to get the Survey data
    Sub2 <- Sub1[ , 5]

    #Match deep and shallow to the Survey depths to get location in DS
    deepRow <- match(deep, Sub2)
    shallowRow <- match (shallow, Sub2)

    #Pull the other data for deep and shallow from DS
    deepData <- Sub1[deepRow, ]
    shallowData <- Sub1[shallowRow, ]

    #Calculate Survey Variables

    AA29 <- 2*3.1416/360
    AY <- shallowData[ , "INCL"] + ((P - shallowData[ , "MD"]) / (shallowData[ , "MD"] - deepData[ , "MD"]) * (shallowData[ , "INCL"] - deepData[ , "INCL"] ))
    AZ <- shallowData[ , "AZIM"] + ((P - shallowData[ , "MD"]) / (shallowData[ , "MD"] - deepData[ , "MD"]) * (shallowData[ , "AZIM"] - deepData[ , "AZIM"] ))
    BA <- 0.000001 + acos(cos(AY * AA29 - shallowData[ , "INCL"] * AA29) - sin(shallowData[ , "INCL"] * AA29) * sin(AY * AA29) * (1 - cos(shallowData[ , "AZIM"] * AA29 - AZ * AA29)))
    BB <- 2 / BA * (tan(BA / 2))

    ##NOTE:  "X" and "Y" below are the plotted variables for the red triangles shown on the plots previously##

    Y <- (P - shallowData[ , "MD"]) * ((sin(AY * AA29) * cos(AZ * AA29)) + (sin(shallowData[ , "INCL"] * AA29) * cos(shallowData[ , "AZIM"] * AA29))) / 2 * BB + shallowData[ , "NS"]
    X <- (P - shallowData[ , "MD"]) * ((sin(AY * AA29) * sin(AZ * AA29)) + (sin(shallowData[ , "INCL"] * AA29) * sin(shallowData[ , "AZIM"] * AA29))) / 2 * BB + shallowData[ , "EW"]
    TVDp <- (P - shallowData[ , "MD"]) * (cos(AY * AA29) + cos(shallowData[ , "INCL"] * AA29)) / 2 * BB + shallowData[ , "TVD"]

    #***********************************************************#
    #Calculations all done, now on to the graphing process......#
    #***********************************************************#

    #fill in "WellSelect to match length of dataframe
    WellS <- rep(WellSelect[i], length(EW))
    WellC <- rep(WellSelect[i], length(X))

    #build dataframes for plots        
    dfSurvey <- data.frame(Well = WellS, MD = S, EW = EW, NS = NS, TVD = TVD)
    dfCalc <- data.frame(Well = WellC, Perf = P, X = X, Y = Y, TVDp = TVDp)
    dfSurvey <- dfSurvey[order(dfSurvey$Well, dfSurvey$MD), ]
    dfCalc <- dfCalc[order(dfCalc$Well, dfCalc$Perf), ]

    ###WORKS!!!! but just coded to save each plot and not combine
    pname <- paste0(dfSurvey$Well[i])
    p <- ggplot() + geom_point(data = dfSurvey, aes(x=EW, y=NS), shape = 2, size = 2, color = "blue1") +
    geom_point(data = dfCalc, aes(x=X, y=Y), shape = 17, size = 5, color = "Chartreuse3") + ggtitle(pname)
    ggsave(paste0(pname, ".png"), p)
    print(p)
}

希望這是有用的。 如果您還有其他需要，請告訴我。 謝謝您的幫助！

Answer 1

考慮將所有數據幀綁定到已編譯的單個數據幀中，並使用ggplot group和color參數：

專門替換for循環：

for(i in seq_along(WellSelect)) {
    ...
}

用lapply構建數據幀列表並刪除所有繪圖線（稍后再做一次）：

df_lists <- lapply(seq_along(WellSelect), function(i) {
    # ... same code

    # build dataframes for plots        
    dfSurvey <- data.frame(Well = WellS, MD = S, EW = EW, NS = NS, TVD = TVD)
    dfCalc <- data.frame(Well = WellC, Perf = P, X = X, Y = Y, TVDp = TVDp)
    dfSurvey <- dfSurvey[order(dfSurvey$Well, dfSurvey$MD), ]
    dfCalc <- dfCalc[order(dfCalc$Well, dfCalc$Perf), ]

    return(list(dfSurvey, dfCalc))   
}

# COMPILED DATAFRAMES
dfSurveyAll <- do.call(rbind, lapply(df_lists, "[[", 1))

dfCalcAll <- do.call(rbind, lapply(df_lists, "[[", 2))

然后使用組和顏色參數運行一個奇異圖

p <- ggplot() + 
       geom_point(data = dfSurveyAll, aes(x=EW, y=NS, group="Well", colour="Well"), 
                 shape = 2, size = 2) +
       geom_point(data = dfCalcAll, aes(x=X, y=Y,  group="Well", colour="Well"), 
                  shape = 17, size = 5) + ggtitle(pname)    
p

---

甚至還有的房間使用by為您進行子集由WellName因素的DS數據幀。 所以下面的for循環內for塊：

for(i in seq_along(WellSelect)) {
    S <- DS$MD[DS$WellName == WellSelect[i]]
    P <- Perf$MidPerfMD[Perf$WellName == WellSelect[i]]
    INCL <- DS$INCL[DS$WellName == WellSelect[i]]
    AZIM <- DS$AZIM[DS$WellName == WellSelect[i]]
    NS <- DS$NS[DS$WellName == WellSelect[i]]
    EW <- DS$EW[DS$WellName == WellSelect[i]]
    TVD <- DS$TVD[DS$WellName == WellSelect[i]]
    ...
    Sub1 <- DS[DS$WellName == WellSelect[i], ]
    ...
    WellS <- rep(WellSelect[i], length(EW))
    WellC <- rep(WellSelect[i], length(X)
    ...
}

可以替換by其中它的參數， 分 ，是用逆足的異常的子集化數據幀（一個單獨的數據幀）。 在此， by返回兩個datafames或等效結構作為內列表的命名列表lapply上方。

df_lists <- by(DS, DS$WellName, FUN=function(sub) {

    S <- sub$MD
    P <- Perf$MidPerfMD[Perf$WellName == sub$WellName[1]]
    INCL <- sub$INCL
    AZIM <- sub$AZIM
    NS <- sub$NS
    EW <- sub$EW
    TVD <- sub$TVD

    ...
    Sub1 <- sub
    ...
    WellS <- rep(sub$WellName[1], length(EW))
    WellC <- rep(sub$WellName[1], length(X)

    # build dataframes for plots        
    # ... same as lapply above

})