使用sapply（）在两个参数上循环uniroot（）

Question

该函数根据给定的直径，流量和长度计算管道中的压力损失。

hazwil2 <- function(diam, flow, leng){
  psi2=((1/(2.31*100))*1050*((flow/140)^1.852)*leng*diam^-4.87)
  return(psi2)
}

我正在寻找将压力损失保持在2 psi之内的最小直径。直径范围在2到12英寸之间。使用uniroot（）和两个任意值作为流和长度：

intercept   = 2L
uniroot(
  function(x) hazwil2(x, 100, 400) - intercept ,
  interval = c(2, 12)
)$root

现在我正在尝试在流和长度值的数据集上循环uniroot

data <- read.csv(
  text = 
  "leng,flow
  100, 100
  200, 100
  300, 100
  100, 150
  200, 150
  300, 150
  100, 200
  200, 200
  300, 200",
  stringsAsFactors = FALSE
)

Answer 1

考虑推广对 f 和 l 参数的 unitroot 调用，并将其传递给mapply（ m < / strong>适用），沿元素的等长向量（即数据帧的列，流和长度）逐元素进行迭代：

find_root <- function(f, l) {
  intercept <- 2L
  uniroot(
    function(x) hazwil2(x, f, l) - intercept ,
    interval = c(2, 12)
  )$root
}

data$root <- mapply(find_root, data$flow, data$leng)

data
#   leng flow     root
# 1  100  100 2.681145
# 2  200  100 3.091243
# 3  300  100 3.359606
# 4  100  150 3.128141
# 5  200  150 3.606602
# 6  300  150 3.919727
# 7  100  200 3.489780
# 8  200  200 4.023564
# 9  300  200 4.372916

对于可能会引起根本问题的较大集合，请考虑将函数调用包装在tryCatch中以返回NA：

data <- expand.grid(leng = seq(100, 1000, by=100), flow = seq(10, 200, by=10))
data$root <- mapply(function(l,f) tryCatch(find_root(l,f), error=function(e) NA), 
                    data$flow, data$leng)

输出

head(data, 20)

#    leng flow     root
# 1   100   10       NA
# 2   200   10       NA
# 3   300   10       NA
# 4   400   10       NA
# 5   500   10       NA
# 6   600   10       NA
# 7   700   10       NA
# 8   800   10       NA
# 9   900   10       NA
# 10 1000   10       NA
# 11  100   20       NA
# 12  200   20       NA
# 13  300   20       NA
# 14  400   20       NA
# 15  500   20 2.023187
# 16  600   20 2.100367
# 17  700   20 2.167915
# 18  800   20 2.228178
# 19  900   20 2.282705
# 20 1000   20 2.332653

Answer 2

这是基于@Parfait的答案，其中包括在previous question期间想到的一些图表。第一张图将 x 和 y 坐标设置为flow和leng，并显示降至2 PSI以下所需的最小直径。

data$diam_min        <- purrr::map2_dbl(.x=data$flow, .y=data$leng, ~find_root(f=.x, l=.y))
data$diam_min_pretty <- sprintf("diam min:\n%0.2f", data$diam_min)

library(ggplot2);  library(magrittr)
ggplot(data, aes(x=flow, y=leng, label=diam_min_pretty)) +
  geom_text()

第二张图将leng的每个值都绘制为轮廓线，并且最小直径在 y 轴上替换。空心点代表Optimize function in R with constraints的解决方案。

tidyr::crossing(leng=c(100, 200, 300, 400), flow=100:200) %>% 
  dplyr::mutate(
    diam_min = purrr::map2_dbl(.x=flow, .y=leng, ~find_root(.x, .y)),
    leng     = factor(leng)
  ) %>% 
  ggplot(aes(x=flow, y=diam_min, color=leng)) +
  geom_line() +
  annotate("point", x=100, y=find_root(f=100, l=400), size=4, shape=1)

我still not sure是您要如何选择最理想的值（从该集合中获得<2 psi），但是也许这些视觉关系会有所帮助。