variants of EMD:extrema

extrema_c.R

extrema_c = function (y, ndata = length(y), ndatam1 = ndata - 1){
	minindex <- maxindex <- NULL
	nextreme <- 0
	cross <- NULL
	ncross <- 0
	z1 <- sign(diff(y))
	index1 <- seq(1, ndatam1)[z1 != 0]
	z1 <- z1[z1 != 0]
	if(!(is.null(index1) || all(z1 == 1) || all(z1 == -1))){
		index1 <- index1[c(z1[-length(z1)] != z1[-1], FALSE)] + 1
		z1 <- z1[c(z1[-length(z1)] != z1[-1], FALSE)]
		nextreme <- length(index1)
		if(nextreme >= 2){
			for(i in 1:(nextreme - 1)){
				tmpindex <- index1[i]:(index1[i + 1] - 1)
				if(z1[i] > 0){
					tmpindex <- tmpindex[y[index1[i]] == y[tmpindex]]
					maxindex <- c(maxindex, c(min(tmpindex), max(tmpindex))) 
				}else{
					tmpindex <- tmpindex[y[index1[i]] == y[tmpindex]]
					minindex <- c(minindex, c(min(tmpindex), max(tmpindex)))
				}
			}
		}
		tmpindex <- index1[nextreme]:ndatam1
		if(z1[nextreme] > 0){
			tmpindex <- tmpindex[y[index1[nextreme]] == y[tmpindex]]
			maxindex <- c(maxindex, c(min(tmpindex), max(tmpindex)))
		}
		else {
			tmpindex <- tmpindex[y[index1[nextreme]] == y[tmpindex]]
			minindex <- c(minindex, c(min(tmpindex), max(tmpindex)))
		}
		if(!(all(sign(y) >= 0) || all(sign(y) <= 0) || all(sign(y) == 0))){
			index1 <- c(1, index1)
			for(i in 1:nextreme){
				if(y[index1[i]] == 0){
					tmp <- c(index1[i]:index1[i + 1])[y[index1[i]:index1[i+1]] == 0]
					cross <- c(cross, c(min(tmp), max(tmp)))
				}else{
					if(y[index1[i]] * y[index1[i + 1]] < 0){
						tmp <- min(c(index1[i]:index1[i + 1])[y[index1[i]] * y[index1[i]:index1[i + 1]] <= 0])
						if(y[tmp] == 0){
							tmp <- c(tmp:index1[i + 1])[y[tmp:index1[i+1]] == 0]
							cross <- c(cross, c(min(tmp), max(tmp)))
						}else{
							cross <- c(cross, c(tmp - 1, tmp))
						}
					}
				}
			}
			if(any(y[index1[nextreme + 1]] * y[index1[nextreme+1]:ndata] <= 0)){
				tmp <- min(c(index1[nextreme + 1]:ndata)[y[index1[nextreme+1]] * y[index1[nextreme + 1]:ndata] <= 0])
				if(y[tmp] == 0){
					tmp <- c(tmp:ndata)[y[tmp:ndata] == 0]
					cross <- c(cross, c(min(tmp), max(tmp)))
				}else{
					cross <- c(cross, c(tmp - 1, tmp))
				}
			}
			ncross <- nrow(cross)
		}
	}
	list(
		minindex = minindex
		, maxindex = maxindex
		, nextreme = nextreme
		, cross = cross
		, ncross = ncross
	)
}

extrema_c2.R

extrema_c2 = function (y, ndata = length(y), ndatam1 = ndata - 1){
	c1 <- c2 <- c3 <- c4 <- c5 <- c6 <- c7 <- c8 <- c9 <- c10 <- c11 <- c12 <- c13 <- c14 <- c15 <- c16 <- c17 <- c18 <- c19 <- c20 <- c21 <- c22 <- c23 <- c24 <- c25 <- c26 <- function(...){
		c(...)
	}
	minindex <- maxindex <- NULL
	nextreme <- 0
	cross <- NULL
	ncross <- 0
	z1 <- sign(diff(y))
	index1 <- seq(1, ndatam1)[z1 != 0]
	z1 <- z1[z1 != 0]
	if(!(is.null(index1) || all(z1 == 1) || all(z1 == -1))){
		index1 <- index1[c1(z1[-length(z1)] != z1[-1], FALSE)] + 1
		z1 <- z1[c2(z1[-length(z1)] != z1[-1], FALSE)]
		nextreme <- length(index1)
		if(nextreme >= 2){
			for(i in 1:(nextreme - 1)){
				tmpindex <- index1[i]:(index1[i + 1] - 1)
				if(z1[i] > 0){
					tmpindex <- tmpindex[y[index1[i]] == y[tmpindex]]
					maxindex <- c3(maxindex, c4(min(tmpindex), max(tmpindex))) 
				}else{
					tmpindex <- tmpindex[y[index1[i]] == y[tmpindex]]
					minindex <- c5(minindex, c6(min(tmpindex), max(tmpindex)))
				}
			}
		}
		tmpindex <- index1[nextreme]:ndatam1
		if(z1[nextreme] > 0){
			tmpindex <- tmpindex[y[index1[nextreme]] == y[tmpindex]]
			maxindex <- c7(maxindex, c8(min(tmpindex), max(tmpindex)))
		}
		else {
			tmpindex <- tmpindex[y[index1[nextreme]] == y[tmpindex]]
			minindex <- c9(minindex, c10(min(tmpindex), max(tmpindex)))
		}
		if(!(all(sign(y) >= 0) || all(sign(y) <= 0) || all(sign(y) == 0))){
			index1 <- c11(1, index1)
			for(i in 1:nextreme){
				if(y[index1[i]] == 0){
					tmp <- c12(index1[i]:index1[i + 1])[y[index1[i]:index1[i+1]] == 0]
					cross <- c13(cross, c14(min(tmp), max(tmp)))
				}else{
					if(y[index1[i]] * y[index1[i + 1]] < 0){
						tmp <- min(c15(index1[i]:index1[i + 1])[y[index1[i]] * y[index1[i]:index1[i + 1]] <= 0])
						if(y[tmp] == 0){
							tmp <- c16(tmp:index1[i + 1])[y[tmp:index1[i+1]] == 0]
							cross <- c17(cross, c18(min(tmp), max(tmp)))
						}else{
							cross <- c19(cross, c20(tmp - 1, tmp))
						}
					}
				}
			}
			if(any(y[index1[nextreme + 1]] * y[index1[nextreme+1]:ndata] <= 0)){
				tmp <- min(c21(index1[nextreme + 1]:ndata)[y[index1[nextreme+1]] * y[index1[nextreme + 1]:ndata] <= 0])
				if(y[tmp] == 0){
					tmp <- c22(tmp:ndata)[y[tmp:ndata] == 0]
					cross <- c23(cross, c24(min(tmp), max(tmp)))
				}else{
					cross <- c25(cross, c26(tmp - 1, tmp))
				}
			}
			ncross <- nrow(cross)
		}
	}
	list(
		minindex = minindex
		, maxindex = maxindex
		, nextreme = nextreme
		, cross = cross
		, ncross = ncross
	)
}