ggtern: пересечение между строкой (geom_segment) и сглаженными данными (geom_smooth_tern)

Question

В настоящее время я работаю над визуализацией эксперимента по испарению. Я построил тройную фазовую диаграмму (NaCl-Na2SO4-H2O) с ggtern и данными, основанными на симуляции phreeqc. Границы фазы (красный / синий) - это сглаженные точки данных (geom_smooth_tern).

> geom_smooth_tern(data=dataTernNaCl, aes(x=NaCl, y=H2O, z=Na2SO4), method = loess, se = FALSE, color = "blue")

#Dataframe
> select(dataTernNaCl, NaCl, Na2SO4, H2O)[324:329,]
# A tibble: 6 x 3
   NaCl     Na2SO4       H2O
  <dbl>      <dbl>     <dbl>
1 0.2503361 0.03098092 0.7186830
2 0.2502058 0.03123192 0.7185623
3 0.2500746 0.03148678 0.7184386
4 0.2499421 0.03174650 0.7183114
5 0.2498056 0.03201021 0.7181842
6 0.2496680 0.03227777 0.7180542

Учитывая эту фазовую диаграмму, я хочу визуализировать путь испарения (восстановление H2O) из определенной точки P1 (на основе экспериментальных данных).

Прямое восстановление H2O прекрасно описывается как линия между 2 точками. Я использую geom_segment.

Мне нужно найти пересечение линии испарения с фазовыми границами, чтобы наконец нарисовать линию от P1 до точки пересечения.

Привет, Кристиан

Answer 1

На основании @Onyambu советую:

ключ заключался в том, чтобы ограничить optimize() внутри диапазона данных, передаваемых модели для синей линии (modelPhaseboundaryNaCl).

#function evaporation line between from starting point | input = NaCl
funEvapLine = function(x){
y <- messwerteTern
m <- (y$Ausgang_Na2SO4Ende-y$Ausgang_Na2SO4)/(y$Ausgang_NaClEnde-y$Ausgang_NaCl)
n <- y$Ausgang_Na2SO4/(y$Ausgang_NaCl * m)
m*x+n-1
  }

#function NaCl phase boundary | only works in NaCl range | input = NaCl
modelPhaseBoundaryNaCl <- loess(Na2SO4 ~ NaCl, data=dataTernNaCl)
funNaClBorder <- function(x)predict(modelPhaseBoundaryNaCl, data.frame(NaCl = x))

#function Intersection EvapLine and NaCl phase boundary | input = NaCl | output = NaCl
NaClmin <- min(dataTernNaCl$NaCl)
NaClmax <- max(dataTernNaCl$NaCl)
g <- function(x)(funNaClBorder(x) - funEvapLine(x))
intersectionNaCl <- optimise(function(x)abs(g(x)), c(NaClmin,NaClmax))$min
intersectionNa2SO4 <- funEvapLine(intersectionNa2SO4)
intersectionH2O <- 1-(intersectionNaCl+intersectionNa2SO4)