R语言 如何确定一个数字在范围之外的时间?

tkclm6bt  于 2023-07-31  发布在  其他
关注(0)|答案(5)|浏览(103)

我对这个看似简单的任务感到绝望:我有一个数字向量values和一个时间向量time,我需要找出这些值在一定范围内的时间。以下是一些数据:

df <- data.frame(time= c(1,3:10), values= c(7,3:10))

字符串
对于该数据,4.5小时的数值超出了3.5 - 6.5的范围。以下是如何确定这4.5小时的可视化:
x1c 0d1x的数据
在该图中,x轴是时间,y轴是值,点是真实的测量值,虚线是范围边界3.5和6.5,实线只是帮助更好地查看范围边界何时被跨越。
我是否错过了一种明显的方法来确定值超出范围的时间?
该图是使用

threshold_low <- 3.5
threshold_high <- 6.5

ggplot(data= df, mapping= aes(time, values)) +
  geom_point() +
  geom_line() +
  geom_hline(yintercept= c(threshold_low, threshold_high), linetype= "dashed") +
  scale_x_continuous(breaks=seq(0, 10, 1)) +
  scale_y_continuous(breaks=seq(0, 10, 1))

prdp8dxp

prdp8dxp1#

如果您不想手动计算每个交叉点,一个更简单的方法是使用线性插值:

library(tidyverse)

range_df <- approx(df$time, df$values, xout = seq(1, 10, 0.001)) %>%
  as.data.frame() %>%
  setNames(names(df)) %>%
  mutate(inrange = values < threshold_high & values > threshold_low) %>%
  mutate(group = data.table::rleid(inrange)) %>%
  group_by(group) %>%
  filter(!inrange) %>%
  summarize(starts = min(time), ends = max(time), duration = ends - starts)

字符串
这导致

range_df
#> # A tibble: 3 x 4
#>   group starts  ends duration
#>   <int>  <dbl> <dbl>    <dbl>
#> 1     1   1     1.25     0.25
#> 2     3   2.75  3.5      0.75
#> 3     5   6.5  10        3.5


我们可以通过在现有图上绘制一个geom_rect来显示这些数字是正确的:

ggplot(data= df, mapping= aes(time, values)) +
  geom_point() +
  geom_line() +
  geom_rect(aes(xmin = starts, xmax = ends, ymin = -Inf, ymax = Inf),
            data = range_df, fill = 'red', alpha = 0.2, inherit.aes = FALSE) +
  geom_hline(yintercept= c(threshold_low, threshold_high), linetype= "dashed") +
  scale_x_continuous(breaks=seq(0, 10, 1)) +
  scale_y_continuous(breaks=seq(0, 10, 1))


的数据
values在目标范围内的总时间量由下式给出:

sum(range_df$duration)
#> [1] 4.50

8zzbczxx

8zzbczxx2#

一个数学方法是
1.在点之间进行线性插值
1.找到零
1.如果两个连续零之间的点福尔斯限值,则计算这两个零之间的差值
1.全部差值求和

library(dplyr)
library(rootSolve)
library(magrittr)

df <- data.frame(time= c(1,3:10), values= c(7, 3:10))

f <- approxfun(df$time, df$values)
lims <- c(3.5, 6.5)

lapply(lims, \(l) uniroot.all(\(x) f(x) - l , range(df$time))) %T>%
   {print(list(Uniroots = .))} %>%
   unlist() %>%
   c(range(df$time))%>%
   sort() %>%
   unique() %>%
   {cbind(head(., -1L), tail(., -1L))} %T>% 
   {print(list(zeros = .))} %>%
   set_colnames(paste0("x", 0:1)) %>%
   as_tibble() %>%
   mutate(is_outside = !between(f((x0 + x1) / 2), lims[1], lims[2]),
          rng = if_else(is_outside, x1 - x0, 0)) %T>%
   {print(list(signs = .))} %>%   
   summarize(time_outside = sum(rng))

# $Uniroots
# $Uniroots[[1]]
# [1] 2.75 3.50

# $Uniroots[[2]]
# [1] 1.25 6.50

# $zeros
#      [,1]  [,2]
# [1,] 1.00  1.25
# [2,] 1.25  2.75
# [3,] 2.75  3.50
# [4,] 3.50  6.50
# [5,] 6.50 10.00

# $signs
# # A tibble: 5 × 4
#      x0    x1 is_outside   rng
#   <dbl> <dbl> <lgl>      <dbl>
# 1  1     1.25 TRUE        0.25
# 2  1.25  2.75 FALSE       0   
# 3  2.75  3.5  TRUE        0.75
# 4  3.5   6.5  FALSE       0   
# 5  6.5  10    TRUE        3.5 

# # A tibble: 1 × 1
#   time_outside
#          <dbl>
# 1          4.5

字符串

zqdjd7g9

zqdjd7g93#

作为一行程序:

with(df, integrate(\(x) +(abs(approxfun(time, values)(x) - 5) > 1.5), min(time), max(time)))
#> 4.5 with absolute error < 4.3e-14

字符串

ecfdbz9o

ecfdbz9o4#

灵感来自@AllanCameron的回答(谢谢!我提出以下简短的解决办法:

precition <- .001 # Choose how detailed the calculation (interpolation) is

values_interpolated <- approx(df$time, df$values, xout= seq(1, 10, precision))$y # interpolate

sum(values_interpolated < threshold_low | values_interpolated > threshold_high) * precision
4.499

字符串

r3i60tvu

r3i60tvu5#

如注解中所建议的,如果您决定信任每对数据点之间的纯线性拟合,则只需计算线性拟合与最大或最小范围阈值的交点。这是一个基本的线性方程组。
$斜率=(y_2 -y_1)/(x_2 - x_1)$ hmmm... mathjax怎么了?
截距= y_2 -斜率 *x_2(或y_1,x_1;没关系)。
您不必测试每个段,只需测试其中一个点超出所需范围的那些段。如果两个点在同一方向上超出,则整个线段超出范围。

相关问题