Finding min turning point in a data frame

user_14568947 0
Viewed 191

I have a data frame df1. I would like to find the minimum turning point at each column, where the value before and after the minimum point is larger than it. For example in x=c(2,5,3,6,1,1,1), I would like to determine that the minimum turning point is at 3, but with the min function, I am only able to find the minimum point which is 1. If there is no minimum point, I would like to get NA. Thanks.

> df
structure(list(x = c(2, 5, 3, 6, 1, 1, 1), y = c(6, 9, 3, 6, 
3, 1, 1), z = c(9, 3, 5, 1, 4, 6, 2)), row.names = c(NA, -7L), class = c("tbl_df", 
"tbl", "data.frame"))


df1>
  x     y     z
  2     6     9
  5     9     3
  3     3     5
  6     6     1
  1     3     4
  1     1     6
  1     1     2

Desired result as shown below.

df2>
 x      y      z
 3      3      1
r
3 Answers

You can use lead and lag to compare current value with previous and next value.

library(dplyr)

df %>% summarise(across(.fns = ~min(.x[which(lag(.x) > .x & lead(.x) > .x)])))

#     x     y     z
#  <dbl> <dbl> <dbl>
#1     3     3     1
user_39629140

You can use diff, get the sign than diff again to get the valleys. Use min to get the lowest valey.

#Value
sapply(df, function(x) min(x[1+which(diff(sign(diff(x))) == 2)]))
#x y z 
#3 3 1

#Position
sapply(df, function(x) {
    tt <- 1+which(diff(sign(diff(x))) == 2)
    tt[which.min(x[tt])] })
#x y z 
#3 3 4

But this will work only in case the valley is one position wide.

Am more robust solution will be using the function from Finding local maxima and minima:

peakPosition <- function(x, inclBorders=TRUE) {
  if(inclBorders) {y <- c(min(x), x, min(x))
  } else {y <- c(x[1], x)}
  y <- data.frame(x=sign(diff(y)), i=1:(length(y)-1))
  y <- y[y$x!=0,]
  idx <- diff(y$x)<0
  (y$i[c(idx,F)] + y$i[c(F,idx)] - 1)/2
}

#Value
sapply(df, function(x) min(x[ceiling(peakPosition(-x, FALSE))]))
#x y z 
#3 3 1 

#Position
sapply(df, function(x) {
    tt <- peakPosition(-x, FALSE)
    tt[which.min(x[floor(tt)])] })
#x y z 
#3 3 4

An alternative would be to use rle:

x <- c(8,9,3,3,8,1,1)
y <- rle(x)
i <- 1 + which(diff(sign(diff(y$values))) == 2)
min(y$values[i]) #Value
#[1] 3
j <- which.min(y$values[i])
1+sum(y$lengths[seq(i[j])-1]) #First Position
#[1] 3
sum(y$lengths[seq(i[j])]) #Last Position
#[1] 4
user_104885040

Alternate approach

df %>% summarise_all(~ifelse(min(.)==last(.) | min(.) == first(.), min(.[. != last(.) & . != first(.)]), min(.)))

  x y z
1 3 3 1

For returning the row_nums

df %>% mutate_all(~ifelse(min(.)==last(.) | min(.) == first(.), min(.[. != last(.) & . != first(.)]), min(.))) %>%
  mutate(id = row_number()) %>% left_join(df %>% mutate(id = row_number()), by = "id") %>%
  mutate(x_r = ifelse(x.x == x.y, row_number(), 0),
         y_r = ifelse(y.x == y.y, row_number(), 0),
         z_r = ifelse(z.x == z.y, row_number(), 0)) %>%
  select(ends_with("r")) %>% summarise_all(~min(.[. != 0]))

  x_r y_r z_r
1   3   3   4
```
user_28848590
Related