All geek questions in one place

How to return monthly minimum values ​​for each year that are less than 10 days

I have daily timers and I want to receive the minimum amount for each month of each year, but I want to make sure that the results should be at least 10 days. To be more specific, let's explain the following sample data.

>Data
        Years   Months     Days Date        A   B
    1   2003    December    1   2003-12-01  10  10
    2   2003    December    2   2003-12-02  10  10
    3   2003    December    3   2003-12-03  10  10
    4   2003    December    4   2003-12-04  10  10
    5   2003    December    5   2003-12-05  10  10
    6   2003    December    6   2003-12-06  10  10
    7   2003    December    7   2003-12-07  10  10
    8   2003    December    8   2003-12-08  3   10
    9   2003    December    9   2003-12-09  10  10
    10  2003    December    10  2003-12-10  10  10
    11  2003    December    11  2003-12-11  10  10
    12  2003    December    12  2003-12-12  10  4
    13  2003    December    13  2003-12-13  10  10
    14  2003    December    14  2003-12-14  10  10
    15  2003    December    15  2003-12-15  10  10
    16  2003    December    16  2003-12-16  10  10
    17  2003    December    17  2003-12-17  10  10
    18  2003    December    18  2003-12-18  10  10
    19  2003    December    19  2003-12-19  10  10
    20  2003    December    20  2003-12-20  10  10
    21  2003    December    21  2003-12-21  10  10
    22  2003    December    22  2003-12-22  10  10
    23  2003    December    23  2003-12-23  10  10
    24  2003    December    24  2003-12-24  10  10
    25  2003    December    25  2003-12-25  10  10
    26  2003    December    26  2003-12-26  10  10
    27  2003    December    27  2003-12-27  10  10
    28  2003    December    28  2003-12-28  10  10
    29  2003    December    29  2003-12-29  10  10
    30  2003    December    30  2003-12-30  10  10
    31  2003    December    31  2003-12-31  10  10
    32  2004    January     1   2004-01-01  10  10
    33  2004    January     2   2004-01-02  10  10
    34  2004    January     3   2004-01-03  10  10
    35  2004    January     4   2004-01-04  10  10
    36  2004    January     5   2004-01-05  10  10
    37  2004    January     6   2004-01-06  10  10
    38  2004    January     7   2004-01-07  10  10
    39  2004    January     8   2004-01-08  10  10
    40  2004    January     9   2004-01-09  10  10
    41  2004    January     10  2004-01-10  10  10
    42  2004    January     11  2004-01-11  10  10
    43  2004    January     12  2004-01-12  10  10
    44  2004    January     13  2004-01-13  10  10
    45  2004    January     14  2004-01-14  10  10
    46  2004    January     15  2004-01-15  10  10
    47  2004    January     16  2004-01-16  10  10
    48  2004    January     17  2004-01-17  10  10
    49  2004    January     18  2004-01-18  10  10
    50  2004    January     19  2004-01-19  10  10
    51  2004    January     20  2004-01-20  10  10
    52  2004    January     21  2004-01-21  10  10
    53  2004    January     22  2004-01-22  10  10
    54  2004    January     23  2004-01-23  10  10
    55  2004    January     24  2004-01-24  10  10
    56  2004    January     25  2004-01-25  5   4
    57  2004    January     26  2004-01-26  10  10
    58  2004    January     27  2004-01-27  10  10
    59  2004    January     28  2004-01-28  10  10
    60  2004    January     29  2004-01-29  10  10
    61  2004    January     30  2004-01-30  10  10
    62  2004    January     31  2004-01-31  10  10
    63  2004    February    1   2004-02-01  10  10
    64  2004    February    2   2004-02-02  5   4
    65  2004    February    3   2004-02-03  10  10
    66  2004    February    4   2004-02-04  10  10
    67  2004    February    5   2004-02-05  10  10
    68  2004    February    6   2004-02-06  10  10
    69  2004    February    7   2004-02-07  10  10
    70  2004    February    8   2004-02-08  10  10
    71  2004    February    9   2004-02-09  7   6
    72  2004    February    10  2004-02-10  10  10
    73  2004    February    11  2004-02-11  10  10
    74  2004    February    12  2004-02-12  10  10
    75  2004    February    13  2004-02-13  10  10
    76  2004    February    14  2004-02-14  10  10
    77  2004    February    15  2004-02-15  10  10
    78  2004    February    16  2004-02-16  10  10
    79  2004    February    17  2004-02-17  10  10
    80  2004    February    18  2004-02-18  10  10
    81  2004    February    19  2004-02-19  10  10
    82  2004    February    20  2004-02-20  10  10
    83  2004    February    21  2004-02-21  10  10
    84  2004    February    22  2004-02-22  10  10
    85  2004    February    23  2004-02-23  10  10
    86  2004    February    24  2004-02-24  10  10
    87  2004    February    25  2004-02-25  10  10
    88  2004    February    26  2004-02-26  10  10
    89  2004    February    27  2004-02-27  10  10
    90  2004    February    28  2004-02-28  10  10
    91  2004    February    29  2004-02-29  10  10

I want to do almost what aggregate () does

min <- aggregate(Data[5:6], by= list(Data$Months, Data$Years), FUN = min)


Group.1     Group.2 A   B
December    2003    3   4
January     2004    5   4
February    2004    5   4

BUT instead, get for Feb the minimum value for each A and B, which should be at least 10 days from the minimum value of the previous month.

So, I would like to get:

Group.1     Group.2 A   B
December    2003    3   4
January     2004    5   4
February    2004    7   6

Any ideas?

+4
source share
5 answers

- . ym, /. , . ym , , .. data.frame, s, , 10 minDate, , ix, minDate result:

ym <- split(DF, format(DF$Date, "%Y-%m"))
sapply(c("A", "B"), function(col) {
   minDate <- min(DF$Date) - 10
   result <- vector(length = length(ym)) 
   for(i in seq_along(ym)) {
       s <- subset(ym[[i]], Date >= minDate + 10)
       ix <- which.min(s[[col]])
       minDate <- s$Date[ix]
       result[i] <- min(s[[col]][ix])
   }
   setNames(result, names(ym))
})

:

        A B
2003-12 3 4
2004-01 5 4
2004-02 7 6

( "Date", "A" "B" DF, DF .)

: :

DF <-
structure(list(Years = c(2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 
2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 
2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 
2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2003L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 2004L, 
2004L, 2004L, 2004L, 2004L), Months = structure(c(1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("December", "February", 
"January"), class = "factor"), Days = c(1L, 2L, 3L, 4L, 5L, 6L, 
7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 
20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 1L, 
2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 
16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 
29L, 30L, 31L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 
25L, 26L, 27L, 28L, 29L), Date = structure(c(12387, 12388, 12389, 
12390, 12391, 12392, 12393, 12394, 12395, 12396, 12397, 12398, 
12399, 12400, 12401, 12402, 12403, 12404, 12405, 12406, 12407, 
12408, 12409, 12410, 12411, 12412, 12413, 12414, 12415, 12416, 
12417, 12418, 12419, 12420, 12421, 12422, 12423, 12424, 12425, 
12426, 12427, 12428, 12429, 12430, 12431, 12432, 12433, 12434, 
12435, 12436, 12437, 12438, 12439, 12440, 12441, 12442, 12443, 
12444, 12445, 12446, 12447, 12448, 12449, 12450, 12451, 12452, 
12453, 12454, 12455, 12456, 12457, 12458, 12459, 12460, 12461, 
12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 
12471, 12472, 12473, 12474, 12475, 12476, 12477), class = "Date"), 
    A = c(10L, 10L, 10L, 10L, 10L, 10L, 10L, 3L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 5L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 5L, 10L, 10L, 10L, 10L, 10L, 10L, 7L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L), B = c(10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 4L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 4L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 4L, 10L, 10L, 10L, 10L, 10L, 10L, 6L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 
    10L, 10L, 10L, 10L, 10L)), .Names = c("Years", "Months", 
"Days", "Date", "A", "B"), row.names = c("1", "2", "3", "4", 
"5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", 
"16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", 
"27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", 
"38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", 
"49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", 
"60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", 
"71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", 
"82", "83", "84", "85", "86", "87", "88", "89", "90", "91"), class = "data.frame")
+2

, , :)

, Month/Year

data$Months<-factor(data$Months, levels=month.name)
data$MY<-interaction(data$Months, data$Years, drop=T)


getpaddoff<-function(n) {
    function(x) {
        a<-which.min(x)+n-length(x); 
        ifelse(a>0,a,0) 
    }
}
rollright<-function(x, add=0) {
  n<-names(x)
  x<-head(c(add,x), -1)
  names(x)<-n;
  x
}

getpadoff , . rollright . getpadoff , .

, . 10- . /. , , .

paddoff <- getpaddoff(10)
ss <- split(data[c("A","B")], data$MY)
offsets <- rollright(lapply(ss, function(x) sapply(x, padoff)), 
    add=list(c(A=0, B=0)))

, , .

rr<-Map(function(d,off) {
    d<-as.matrix(d)
    stopifnot(ncol(d)==length(off))
    for(i in seq_along(off)) {
         if(off[i]>0)
             d[1:off[i],i]<-Inf
    }
    apply(d,2,min)
}, ss, offsets)
do.call(rbind,rr)


              A B
December.2003 3 4
January.2004  5 4
February.2004 7 6

, , .

+2

, nonoverlapmin. , . , /

data$Months <- factor(data$Months, levels=month.name)
data$MY <- interaction(data$Months, data$Years, drop=T)


nonoverlapmin <- function(vals, groups, dist) {
    stopifnot(length(vals)==length(groups))
    groups<-ordered(groups)
    r <- numeric(nlevels(groups))
    names(r) <- levels(groups)
    for (v in levels(groups)) {
        i <- which.min(vals[groups<=v])
        r[v] <- vals[i]
        vals[ 1:min(max(i+dist, max(which(groups==v))),length(vals))]<-Inf
    }
    r
}

,

nonoverlapmin(data$A, data$MY, 10)
# December.2003  January.2004 February.2004 
#             3             5             7 

nonoverlapmin(data$B, data$MY, 10)
# December.2003  January.2004 February.2004 
#             4             4             6

, dist Inf, . , , .

+1

I think it’s sometimes better to go back to the basics rather than trying to find the most efficient vector implementation. Remember that developer time is more important than processor time: P

A simple loop will do the trick.

read.table("Data.txt", header=T, sep="\t", stringsAsFactors=F) -> Data
result = matrix(ncol=4, nrow=0)
min_indA = -100; min_indB = -100; minA = 100; minB = 100
curMonth = "December"
curYear = 2003
for(i in 1:nrow(Data)) {
    if(curMonth == Data[i,"Months"] & curYear == Data[i,"Years"]) {
        if(Data[i,"A"] < minA & i - min_indA >= 10) {
            minA = Data[i,"A"]
            cur_indA = i
        }
        if(Data[i,"B"] < minB & i - min_indB >= 10) {
            minB = Data[i,"B"]
            cur_indB = i
        }
    } else {
        result = rbind(result, c(curYear, curMonth, minA, minB))
        minA = Data[i,"A"]; minB = Data[i,"B"]; min_indA = cur_indA; min_indB = cur_indB;
        curMonth = Data[i,"Months"]
        curYear = Data[i,"Years"]
    }
}
result = rbind(result, c(curYear, curMonth, minA, minB))

print (result)

     [,1]   [,2]       [,3] [,4]
[1,] "2003" "December" "3"  "4" 
[2,] "2004" "January"  "5"  "4" 
[3,] "2004" "February" "7"  "6"
+1
source

I think the most efficient way for this problem is a recursive function ...

#Load data
require("data.table")
Data <- fread("min10.csv")
Data <- data.table(Data)
Data[,Date:=as.Date(Date)]

Here is the function.

#Build recursive function
findmin10 <- function(Data,Var){

  Data$Var1 <- get(Var,Data)

  #Find min date for value A
  Data[,minVar:=min(Var1),by=c("Years","Months")]
  Data[,minVarDate:=(Var1==minVar)*1]
  Summ <- Data[minVarDate==1][,ord:=.I]
  Summ[,Date.Diff:=c(NA,head(as.numeric(Date[ord+1]-Date[ord]),-1))]
  To.Delete.Date <- Summ[Date.Diff<10]$Date

  #Utilize recursion until 10 day spacing requirement is met
  if (length(To.Delete.Date)!=0){
    Data <- Data[!Date%in%To.Delete.Date]
    findmin10(Data,Var=Var)
  } else {
    return(Summ[,list(Years,Months,Var1,VarName=Var)])
  }
}

Get results for multiple variables using lapply

#Run through multiple variables you want to find the min 10 for
outtable <- rbindlist(lapply(c("A","B"),FUN=function(x) findmin10(Data=Data,Var=x)))

Extract the results in the desired format.

#Cast it out to make it look like desired result
library("reshape2")
dcast.data.table(outtable,Years+Months~VarName,value.var="Var1")

#    Years   Months A B
# 1:  2003 December 3 4
# 2:  2004 February 7 6
# 3:  2004  January 5 4
+1
source

Source: https://habr.com/ru/post/1542971/

More articles:


All Articles