test-code/turf-working/old-attempts/turf_cvxr.R

In ttrodrigz/onezero: Analysis tools for binary (0/1) data

# TURF example in R
# Replicating https://andrewpwheeler.com/2020/10/01/a-linear-programming-example-for-turf-analysis-in-python/
# Andy Wheeler

library(CVXR)
library(tidyverse)
library(readxl)

setwd('D:\\Dropbox\\Dropbox\\Documents\\BLOG\\Posted_Python\\TURF_Analysis\\Analysis')
surv <- read.csv('demoTURF.csv', row.names=1)
read_xlsx("test-code/")


main <- c('Steak',
          'Pizza',
          'FriedChicken',
          'BBQChicken',
          'GrilledSalmon',
          'FriedHaddock',
          'LemonHaddock',
          'Roast',
          'Burger',
          'Wings')

sides <- c('CeaserSalad',
           'IcebergSalad',
           'TomatoSoup',
           'OnionSoup',
           'Peas',
           'BrusselSprouts',
           'GreenBeans',
           'Corn',
           'DeviledEggs',
           'Pickles')

desserts <- c('ChoclateIceCream',
              'VanillaIceCream',
              'ChocChipCookie',
              'OatmealCookie',
              'Brownie',
              'Blondie',
              'CherryPie')

# Renaming columns
prods <- c(main,sides,desserts)
names(surv) <- prods

# Replacing Likert Scale with 0/1
surv <- round(surv/5)
surv_n <- dim(surv)[1]
prod_n <- length(names(surv))

# Traditional TURF Analysis

k <- 5 #pick 5 items
cust_index = 1:surv_n
prod_index = 1:prod_n

cust_dec <- Variable(surv_n, integer=TRUE)
prod_dec <- Variable(prod_n, integer=TRUE)
objective <- Maximize( sum(cust_dec) )

# List to stuff the constraints
cons <- vector(mode="list", length=surv_n+5)

# Reach constraint
for (i in cust_index){
    # Get the products selected by that person
    loc_sel <- surv[i,] == 1
    prod_sel <- prod_index[loc_sel]
    # Set the constraint
    cons[[i]] <- cust_dec[i] <= sum_entries(prod_dec[prod_sel])
}

# Total number of products selected constraint
cons[[surv_n+1]] <- sum_entries(prod_dec) == k
cons[[surv_n+2]] <- cust_dec >= 0
cons[[surv_n+3]] <- cust_dec <= 1
cons[[surv_n+4]] <- prod_dec >= 0
cons[[surv_n+5]] <- prod_dec <= 1

problem <- Problem(objective, constraints = cons)
solution <- solve(problem) #this does not work!