Выполнить функцию на подмножестве данных - PullRequest
0 голосов
/ 08 октября 2018

У меня есть набор данных ниже, который показывает количество автомобилей в воображаемом автосалоне.Переменная current_price - это, очевидно, цена, по которой автомобиль в настоящее время выставлен на продажу.Переменная minimum_price показывает цену жесткого пола, по которой автомобиль ни при каких обстоятельствах не должен продаваться.(Это может быть цена покупки).

Я пытаюсь создать функцию, в которой пользователь может выбрать подмножество автомобилей в базе данных (используя «пользовательские параметры», как указано ниже), а затем уменьшите или увеличьте значение Current_Price в процентах или фунтах (*).

«Параметры минимальной прибыли» задают минимальную прибыль, которая должна быть получена на всех автомобилях.В этом примере они были установлены на £ 10 и 10%.Это означает, что прибыль для каждого автомобиля должна составлять 10 фунтов стерлингов или 10% от текущей цены - в зависимости от того, какая из этих величин больше.

Параметры изменения цены определяют, на сколько цена будет двигаться и должна ли она двигаться вверх или вниз..

# Dummy data
Type <- rep(c("Car", "Van"),each=3)
Age <- as.numeric(c(2, 2, 5, 4, 8,1))
Colour <- c("Red", "Red", "Yellow", "Red", "Black", "Red")
Make <- c("Ford", "VW", "VW", "VW", "BMW", "Ford")
Current_Price <- as.numeric(c(1050, 1000, 1500, 995, 2200, 2100))
Minimum_Price <- as.numeric(c(900, 600, 500, 850, 1900, 1950))
df1 <- data.frame(Type, Age, Colour, Make, Current_Price, Minimum_Price)

# User defined parameters - price to be changed for all cars which fit below selection
Input_Type <- "Car"
Input_Min_Age <- 2 # All cars this age and above
Input_Max_Age <- 10 # All cars this age and below
Input_Colour <- "Red"
Input_Make <- c("Ford", "VW")

# Minimum profit parameters
Input_Min_Pounds <- 10
Input_Min_Percentage <- 0.10

# Price change parameters
Input_Change_Type <- "Percentage" # "Percentage" or "Pound"
Input_Change_Value <- -0.10 # "-" sign to represent price reduction

Учитывая вышесказанное, я ожидаю, что изменение строк повлияет на строки 1 и 2.Цена линии 1 должна снизиться с £ 1050 до £ 1000.Это связано с тем, что 1 000 фунтов стерлингов - это самая низкая возможная цена, при которой 10% цены составляет прибыль (900 / (1-0,10) = 1000).

Цена линии 2 должна просто снизиться на 10% до 900.

Кто-нибудь понял, как поместить это в функцию, которая будет довольно интуитивно понятна для того, кто не привык использовать R?

Ответы [ 2 ]

0 голосов
/ 10 октября 2018

В этом ответе используется data.table для поддержки изменений цены в исходном «data.frame» (как вы пояснили в комментариях к вашему вопросу), решение может выглядеть следующим образом.

Я все еще игнорирую логику ценообразования, потому что хочу сосредоточиться на аспекте удобства использования (эта специализированная логика ценообразования произвольна и не представляет особого интереса для кого-либо еще здесь, в SO; если у вас есть конкретная проблема для ее реализации, пожалуйста,откройте новый вопрос и подробно объясните проблему).

library(data.table)

data <- as.data.table(df1)

calc_price <- function(Current_Price,
                       Minimum_Price,
                       price_change_type,
                       price_change_value,
                       min_profit_pounds,
                       min_profit_percentage) {
  # TODO implement your pricing logic here...
  return(Current_Price + 1)
}

update_car_prices <- function(data,
                              filter,
                              price_change_type     = c("Percentage", "Pound"),
                              price_change_value    = 0,
                              min_profit_pounds     = 10,
                              min_profit_percentage = 0.10) {

  stopifnot(is.data.table(data))

  price_change_type <- match.arg(price_change_type)  # use the first value if none was provided
  filter_exp        <- substitute(filter)            # "parse" the passed value as expression
  # date the price using a separate function to encapsulate the logic
  data[eval(filter_exp), Current_Price := calc_price(Current_Price,
                                                     Minimum_Price,
                                                     price_change_type,
                                                     price_change_value,
                                                     min_profit_pounds,
                                                     min_profit_percentage)][]
  return(data)
}

Использование все еще похоже на мой data.frame ответ, например:

update_car_prices(data, Type == "Car" & Age >= 2 & Age <= 10 & Colour == "Red" & Make %in% c("Ford", "VW"))
update_car_prices(data, Colour == "Red")
update_car_prices(data, Colour == "Red", "Pound", 500)

Различия:

  1. Целое data.table (data) возвращается, чтобы увидеть влияние
  2. Исходный data изменен, поскольку data.table s переданы по ссылке, и я обновляюцена "по ссылке" с использованием синтаксиса data.table :=
0 голосов
/ 09 октября 2018

Этот ответ основан на data.frame ...

Ваши вопросы касаются нескольких аспектов (логика ценообразования, логика фильтрации и удобство использования).

Ясосредоточив внимание на удобстве использования (и игнорируя логику ценообразования, поскольку это лишь преднамеренная деталь).

Я вижу как минимум три варианта:

  1. Используйте строго типизированную функцию:

    get_car_prices1 <- function(data, Input_Type, Input_Min_Age, Input_Max_Age, Input_Colour, Input_Make, Input_Min_Pounds, Input_Min_Percentage)

  2. Используйте «нетипизированную» функцию с преднамеренным количеством аргументов через ... для поддержки фильтрации путем передачи только обязательных аргументов:

    get_car_prices2 <- function(data, Input_Min_Pounds, Input_Min_Percentage, ...)

  3. Использование метапрограммирования с substitute + eval

Я выбрал вариант 3 каклучший (удобный + гибкий) вариант ИМХО:

get_car_prices <- function(data,
                           filter,
                           price_change_type  = c("Percentage", "Pound"),
                           price_change_value = 1)
{
  price_change_type <- match.arg(price_change_type)  # use the first value if none was provided
  filter_exp        <- substitute(filter)            # "parse" the passed value as expression
  data_subset       <- subset(data, eval(filter_exp))
  # TODO add your pricing logic here (e. g. using "ifelse")
  return(data_subset)
}

# Usage examples:

get_car_prices(df1, Colour == "Red")
#   Type Age Colour Make Current_Price Minimum_Price
# 1  Car   2    Red Ford          1050           900
# 2  Car   2    Red   VW          1000           600
# 4  Van   4    Red   VW           995           850
# 6  Van   1    Red Ford          2100          1950

get_car_prices(df1, Type == "Car" & Age >= 2 & Age <= 10 & Colour == "Red" & Make %in% c("Ford", "VW"))
#   Type Age Colour Make Current_Price Minimum_Price
# 1  Car   2    Red Ford          1050           900
# 2  Car   2    Red   VW          1000           600

get_car_prices(df1, Colour == "Red", "Pound", 500)
# ...

get_car_prices(df1, Colour == "Red", "dumping price", 1)
# Error in match.arg(price_change_type) : 
#   'arg' should be one of “Percentage”, “Pound” 

# But: The user has to learn at least the expression logic of R and that variables (and values) are case-sensitive:
get_car_prices(df1, Colour == "red")
# [1] Type          Age           Colour        Make          Current_Price Minimum_Price
#  <0 rows> (or 0-length row.names)

# Error: Assignment operator (=) used instead of comparison operator (==)
get_car_prices(df1, Colour = "Red")
# Error in get_car_prices(df1, Colour = "Red") : 
#   unused argument (Colour = "Red")
...