# add modification "assign(.tpr, tpr)" to store modified dataframe
# add parameter "tolerance" to allow flexibility in deciding point closeness
getZcurve2 <- function(dfile, tolerance = 0.01, save = FALSE) {
    # Read digitized data from Standing-Katz chart, plot it 
    # and put it in a .rda file
    # x: Ppr
    # y: z
    isNear <- function(n) abs(n - round(n, 1)) <= tolerance

    .tpr <- tools::file_path_sans_ext(dfile)
    data_file <- paste("../inst/extdata", dfile, sep = "/")
    assign(.tpr, read.table(data_file, header = TRUE))  # name same as file name
    tpr <- get(.tpr)               # get the object
    colnames(tpr)<- c("Ppr", "z")
    tpr <- tpr[order(tpr$Ppr),]            # sort Ppr
    tpr$isNear <- isNear(tpr$Ppr)# round to nearest Ppr
    tpr$Ppr_near <- ifelse(tpr$isNear, round(tpr$Ppr/.1)*.1, tpr$Ppr)
    tpr$diff <- tpr$Ppr - tpr$Ppr_near     # find the difference to nearest
    assign(.tpr, tpr)
    if (save) {
        rda_file <- paste(tools::file_path_sans_ext(dfile), "rda", sep = ".")
        rda_file <- paste("../data", rda_file, sep = "/")
        save(list = .tpr, file = rda_file)     # save with same name as string
    }
    plot(x = tpr$Ppr, y = tpr$z)                      # as rad from SK chart
    lines(x = tpr$Ppr_near, y = tpr$z, col = "blue")  # nearest rounded points
}

$T_{pr} = 1.05$

getZcurve2("sk_lp_tpr_105.txt")

$T_{pr} = 1.10$

getZcurve2("sk_lp_tpr_110.txt")

$T_{pr} = 1.20$

getZcurve2("sk_lp_tpr_120.txt")

$T_{pr} = 1.30$

getZcurve2("sk_lp_tpr_130.txt")

$T_{pr} = 1.40$

getZcurve2("sk_lp_tpr_140.txt")

$T_{pr} = 1.50$

getZcurve2("sk_lp_tpr_150.txt")

$T_{pr} = 1.70$

getZcurve2("sk_lp_tpr_170.txt")

$T_{pr} = 2.0$

getZcurve2("sk_lp_tpr_200.txt")

$T_{pr} = 2.40$

getZcurve2("sk_lp_tpr_240.txt")

Code use to build more complete function

isNear <- function(n) abs(n - round(n, 1)) < 0.01
save <- TRUE
dfile <- "tpr_105.txt"
    .tpr <- tools::file_path_sans_ext(dfile)
    data_file <- paste("../inst/extdata", dfile, sep = "/")
    assign(.tpr, read.table(data_file, header = TRUE))  # name same as file name
    tpr <- get(.tpr) 
    colnames(tpr)<- c("Ppr", "z")
        tpr <- tpr[order(tpr$Ppr),]            # sort Ppr
    tpr$Ppr_near <- round(tpr$Ppr/.1)*.1   # round to nearest Ppr
    tpr$diff <- tpr$Ppr - tpr$Ppr_near     # find the difference to nearest
    assign(.tpr, tpr)
        if (save) {
        rda_file <- paste(tools::file_path_sans_ext(dfile), "rda", sep = ".")
        rda_file <- paste("../data", rda_file, sep = "/")
        save(list = .tpr, file = rda_file)     # save with same name as string
    }
    plot(x=tpr$Ppr, y=tpr$z)                      # as rad from SK chart
    lines(x=tpr$Ppr_near, y=tpr$z, col = "blue")  # nearest rounded points

Original code (do not use. Reference only)

getZcurve <- function(dfile, save = TRUE) {
    # read txt data at Tpr=13 
    # axis
    # x: Ppr
    # y: z
    data_file <- paste("../inst/extdata", dfile, sep = "/")
    tpr <- read.table(data_file, header = TRUE)
    # change name of variables
    colnames(tpr) <- c("Ppr", "z")
    tpr <- tpr[order(tpr$Ppr),]    # sort Ppr

    tpr$Ppr_near <- round(tpr$Ppr/.1)*.1
    tpr$diff <- tpr$Ppr - tpr$Ppr_near
    if (save) {
        rda_file <- paste(tools::file_path_sans_ext(dfile), "rda", sep = ".")
        rda_file <- paste("../data", rda_file, sep = "/")
        save(tpr, file = rda_file)
    }
    plot(x=tpr$Ppr, y=tpr$z)
    lines(x=tpr$Ppr_near, y=tpr$z, col = "blue")       
}
getZcurve("tpr_15.txt")
# read txt data at Tpr=13 
# axis
# x: Ppr
# y: z
tpr13 <- read.table("../inst/extdata/tpr_13.txt", header = TRUE)
# change name of variables
colnames(tpr13) <- c("Ppr", "z")
tpr13 <- tpr13[order(tpr13$Ppr),]    # sort Ppr
library(ggplot2)
ggplot(tpr13, aes(x=Ppr, y=z)) + geom_line()
tpr13$Ppr_near <- round(tpr13$Ppr/.1)*.1
tpr13$diff <- tpr13$Ppr - tpr13$Ppr_near
save(tpr13, file = "../data/tpr13.rda")
plot(x=tpr13$Ppr, y=tpr13$z)
lines(x=tpr13$Ppr_near, y=tpr13$z, col = "blue")


f0nzie/zFactor documentation built on Aug. 2, 2019, 1:42 a.m.