Search code examples
rmatrixcalculated-columnsdiagonal

Diagonal sum with constraints in r

I want to extract cells with the two constraints.

first, extract data[i,j+@] if sum(data[i,j+@])<5, else extract data[i+1,j].

second, I want to set the constraint value of each row is 5, I want to work on the next row if the sum up to the second column is more than 10. The start row can be start with 5.

it can be more easy to understand with the figure below.

the green one is the first iteration of the work i want to, and red and yellow are the second and third iteration respectively.

the result what i want to is below.

X1  X2  X3  X4  X5  X6  X7  X8  X9
5   1.847652137 1.593196753 1.038744382 2.392577214 1.929800297 2.00485602  1.365284847 2.071210757 0.961210097
10  1.844405755 1.796177057 1.000318509 2.236319316 1.993847864 2.06124419  1.334352788 2.136264508 1.187134575
15  1.840050479 1.917357779 1.017851743 2.212746581 2.092042634 1.94601942  1.320106097 2.029994348 1.214182727
20  1.909398459 1.737023355 0.998872288 2.199635485 2.112443388 1.945944311 1.264014072 2.101753344 1.221846304
25  1.835888833 1.500481202 0.977172242 2.252597257 1.9836639   1.981422844 1.312695726 2.059200235 1.186026763
30  1.864937958 1.702083702 0.824693691 2.34185367  2.005003283 2.042903214 1.329264708 2.093476876 1.200883904
35  1.860653591 1.797731242 0.950537406 2.245353372 1.994555492 1.825519322 1.355424824 2.156744119 1.175993981
40  1.884274248 1.635847889 1.169642735 2.269898328 1.975265537 1.553298242 1.615854357 2.05323242  1.098031592
45  1.886826057 1.811210946 1.061251733 2.280645314 1.988672647 1.557977089 1.66754175  2.044207552 1.0112728
50  1.831184163 1.894325674 0.840784273 2.271033072 1.939068714 1.637609662 1.661725542 2.014112901 0.921453048
55  1.814208298 1.506889498 0.882503502 2.2606704   1.867075707 1.606874174 1.70215241  2.082384915 0.94171228
60  1.840268898 1.540609758 0.984783168 2.245115137 1.845533017 1.584807408 1.635959069 2.064869319 0.950706804
65  1.83516395  1.373207762 0.822749722 2.241155251 1.900521615 1.564088673 1.604834287 2.041777787 0.954724586
70  1.815817966 1.844931506 1.019619889 2.33141441  1.86220601  1.551023075 1.601418379 2.002273876 0.957165881
75  1.853140166 7.098379135 1.182675991 2.322268357 1.813515351 1.615939602 1.696614356 2.035073751 0.958010381
80  1.798210945 2.222645814 0.969712319 2.240342429 1.913167003 1.668853612 1.697958527 2.093574065 0.957251029
85  1.800217051 6.402182459 0.860639426 2.246098499 1.907598223 1.682098292 1.745796169 2.121305706 0.954894171
90  1.803848201 1.837969653 1.102897318 2.129789813 2.043044807 1.735093642 1.666707881 2.129939238 0.950959419
95  1.773136099 1.81561362  1.063019374 2.101027448 2.068051192 1.741234984 1.560080567 2.035059171 0.945479261
100 1.726054688 2.336579799 1.191580262 2.171114687 2.000358256 1.941099801 1.344295317 2.148571187 0.938498408
105 1.732335377 1.525364359 0.997056804 2.22337609  1.992471357 1.947338911 1.29520691  2.118027771 0.924464116
110 1.712195122 2.147877272 1.236796081 2.19147367  1.98315409  1.971128342 1.406685721 2.150012062 0.894661016
115 1.850123948 1.655380701 1.182880578 2.193327785 1.89713277  1.98215189  1.291643391 2.11847296  1.056295377

------------------what i want to---------

    x1      x2      x3      x4      x5      x6      x7      x8      x9  
1   1.847652137 1.593196753 1.038744382 2.392577214 1.993847864 2.06124419 1.320106097  2.029994348 1.214182727

enter image description here

Solution 
  • # read in data
dat <- structure(list(x1 = c(2, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1), 
                      x2 = c(2, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1), 
                      x3 = c(1.1, 1.1, 3, 1.1, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2), 
                      x4 = c(2.4, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.6, 2.6, 2.6, 2.6, 2.6), 
                      x5 = c(2, 2.1, 2.2, 2.1, 2.1, 2.1, 2.2, 2.2, 2.2, 2.2, 2.2, 2.2), 
                      x6 = c(2.1, 2.2, 2.2, 2.3, 2.3, 2.3, 2.3, 2.3, 2.3, 2.3, 2.3, 2.4), 
                      x7 = c(1.4, 1.4, 1.4, 1.4, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5), 
                      x8 = c(2.2, 2.2, 2.2, 2.2, 2.2, 2.2, 2.2, 2.3, 2.3, 2.3, 2.3, 2.3), 
                      x9 = c(1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.4, 1.4, 1.4)), 
                 .Names = c("x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9"), 
                 class = "data.frame", 
                 row.names=c("5","10","15","20","25","30","35","40","45","50","55","60"))
# number of desired result rows
iterate = 3
# empty matrix to fill
RESULT <- matrix(NA, nrow = iterate, ncol = ncol(dat))

    The Loop is really about checking if we've hit our target and then keeping track of what has already been capture in the RESULTS for the i * 5 constraints, but because row i will start at k (the iteration) we don't want to start doing 3 * 5 for the first check, so we do which(i == k:n) to get back to 1 * 5. 

    extract <- function(dat, iterate = 3, sum.increment = 5){
  dat <- as.matrix(dat)
  n <- nrow(dat)
  p <- ncol(dat)
  RESULT <- matrix(NA, nrow = iterate, ncol = p)
  for(k in 1:iterate){
    x <- 1  
    for(i in k:n){
      if(x == 1){
        hit <- which(cumsum(dat[i,]) > sum.increment)[1]
      } else {
        hit <- which(cumsum( # 
          c(RESULT[k,c(1:ifelse(hit>p,p,hit))], # keep track of previous values
            dat[i,-c(1:(x-1))]) # to cumulatively sum with new values
        ) > sum.increment * which(i == k:n))[1]
      }

      hit <- ifelse(is.na(hit) | hit > p, p, hit) # end of the matrix
      RESULT[k,c(x:hit)] <- unlist(dat[i,c(x:hit)])
      if(hit == p) break # if we're at the end of the cols, start the next iteration
      x <- hit + 1
    }
  }
  if(!is.null(colnames(dat))) colnames(RESULT) <- colnames(dat)
  return(RESULT)
}
extract(dat, iterate = 3, sum.increment = 5)

    The result here

    RESULT
#      x1  x2  x3  x4  x5  x6  x7  x8  x9
#[1,] 2.0 2.0 1.1 2.5 2.1 2.2 1.4 2.2 1.3
#[2,] 2.1 2.1 1.1 2.5 2.2 2.2 1.4 2.2 1.3
#[3,] 2.1 2.1 3.0 2.5 2.1 2.3 1.5 2.2 1.3