Use apply functions with matrices and multiple vectors

user_5057346 0
Viewed 63

Say I have 10 different credit cards and have calculated the rewards pts for each based on a monthly spending pattern.

Each row in the matrix, mat1 represents a different credit card. Each column is a month in a year.

The card holder spends $7275/month. However, there are penalties if you spend more than a certain amount each year. Each card may have a different limit and penalty.

The limits and penalties for the cards are given in spend_limit and penalty. The nth element in each vector corresponds to the nth credit card in the same order as the rows in the matrix.

For example, the cumulative spending of this cardholder is:

> cum_spend_v
 [1]  7275 14550 21825 29100 36375 43650 50925 58200 65475 72750 80025 87300

and the spending limits are:

spend_limit <- c(80000, 80000, 200000, 10000, 80000, 6000, 40000, 6000, 4000, NA)

So for card #1 mat1 row1 columns 11 and 12 need to be adjusted by the penalty of 700 pts for card #1:


            1        2        3        4        5        6        7        8        9       10       11       12
 [1,]  9475.00  9475.00 30725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10025.00 10025.00

How is it possible to perform these operations using one of R's apply functions? Is purrr:map out of the picture because it doesn't directly operate on matrices?

R Script

mat1 <- 
structure(c(9475, 8375, 12808.75, 10018.75, 9475, 5337.5, 5583.2995, 
            5337.5, 5583.2995, 0, 9475, 8375, 12808.75, 10018.75, 9475, 5337.5, 
            5583.2995, 5337.5, 5583.2995, 0, 30725, 18375, 15308.75, 32518.75, 
            30725, 12837.5, 15583.2995, 5337.5, 15583.2995, 0, 10725, 8375, 
            15308.75, 12518.75, 10725, 5337.5, 5583.2995, 5337.5, 5583.2995, 
            0, 10725, 8375, 15308.75, 12518.75, 10725, 5337.5, 5583.2995, 
            5337.5, 5583.2995, 0, 10725, 8375, 15308.75, 12518.75, 10725, 
            5337.5, 5583.2995, 5337.5, 5583.2995, 0, 10725, 8375, 15308.75, 
            12518.75, 10725, 5337.5, 5583.2995, 5337.5, 5583.2995, 0, 10725, 
            8375, 15308.75, 12518.75, 10725, 5337.5, 5583.2995, 5337.5, 5583.2995, 
            0, 10725, 8375, 15308.75, 12518.75, 10725, 5337.5, 5583.2995, 
            5337.5, 5583.2995, 0, 10725, 8375, 15308.75, 12518.75, 10725, 
            5337.5, 5583.2995, 5337.5, 5583.2995, 0, 10725, 8375, 15308.75, 
            12518.75, 10725, 5337.5, 5583.2995, 5337.5, 5583.2995, 0, 10725, 
            8375, 15308.75, 12518.75, 10725, 5337.5, 5583.2995, 5337.5, 5583.2995, 
            0), .Dim = c(10L, 12L), .Dimnames = list(NULL, c("1", "2", "3", 
                                                             "4", "5", "6", "7", "8", "9", "10", "11", "12")))
# Monthly spending
monthly_spend <- 7275
cum_spend_v <- cumsum(rep(monthly_spend, 12))

# Spending limit for different cards
spend_limit <- c(80000, 80000, 200000, 10000, 80000, 6000, 40000, 6000, 4000, NA)

# Penalty for overspending
penalty <- c(700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600)



which(cum_spend_v > spend_limit[1])
purrr apply r
1 Answers

You could make matrices out of penalty as well as spendings with cards in rows and months in columns, similar to mat1. Then, using rowCumsums of the matrixStats package, just subtract both matrices at the subset p, where the cumulated spendings sums for each card exceed the spend_limit vector (which must not contain any NA).

You did just provide a monthly spending of one card, so I'll expand it a little.

spend <- c(7275, 8646, 6710, 7638, 7908, 7679, 7169, 8787, 7180, 0)
M_spend <- matrix(spend, 10, 12)

penalty <- c(700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600)
M_penalty <- matrix(penalty, 10, 12)

spend_limit <- c(80000, 80000, 200000, 10000, 80000, 6000, 40000, 6000, 4000, 0)

p <- rowCumsums(M_spend) > spend_limit
mat1[p] <- mat1[p] - M_penalty[p]

Result

mat1
#              1        2        3        4        5        6        7        8        9       10       11       12
#  [1,]  9475.00  9475.00 30725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10025.00 10025.00
#  [2,]  8375.00  8375.00 18375.00  8375.00  8375.00  8375.00  8375.00  8375.00  8375.00  7575.00  7575.00  7575.00
#  [3,] 12808.75 12808.75 15308.75 15308.75 15308.75 15308.75 15308.75 15308.75 15308.75 15308.75 15308.75 15308.75
#  [4,] 10018.75  9018.75 31518.75 11518.75 11518.75 11518.75 11518.75 11518.75 11518.75 11518.75 11518.75 11518.75
#  [5,]  9475.00  9475.00 30725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10725.00 10725.00  9625.00  9625.00
#  [6,]  4137.50  4137.50 11637.50  4137.50  4137.50  4137.50  4137.50  4137.50  4137.50  4137.50  4137.50  4137.50
#  [7,]  5583.30  5583.30 15583.30  5583.30  5583.30  4283.30  4283.30  4283.30  4283.30  4283.30  4283.30  4283.30
#  [8,]  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50  3937.50
#  [9,]  4083.30  4083.30 14083.30  4083.30  4083.30  4083.30  4083.30  4083.30  4083.30  4083.30  4083.30  4083.30
# [10,]     0.00     0.00     0.00     0.00     0.00     0.00     0.00     0.00     0.00     0.00     0.00     0.00

You can imagine that it works like overlaying both matrices and subtracting superimposed cells if p is TRUE.

Note: Instead of rowCumsums(m) you may also do apply(m, 1, cumsum), but it's slower.

user_65740380
Related