Р: Как (эффективно) параметризовать и рисовать (условные) функции?

У меня есть data.frame, где каждая строка содержит значения параметров для функции (т.е. одна функция в строке). Я хотел бы нарисовать эти функции. Функции являются условными и должны отображаться только для определенных значений и иметь перегибы (из-за минимального/максимального уровней). См. пример того, что я пытаюсь заархивировать: Условные функции

Первоначально я рассматривал возможность использования curve() или stat_function (библиотека ggplot2). Но я не мог понять, как можно было бы рисовать кривые только для определенных значений (см. a, b, c), без создания кадр данных.

Поэтому я создал функцию, которая генерирует данные графика:

N = 10000;

PrisstrukturToPlotdata = function(s){
  # Create empty data.frame:
  A <- data.frame(Site=rep(s$Site, N), bid=1:N, Saelger=rep(NA, N), Koeber=rep(NA, N), stringsAsFactors=FALSE)
  # Fill out the data.frame:
  for (i in 1:N) {

      # Don't draw below:
      if(i > s$Mindste_bud*s$Kurs) {

        # First parenthesis is condition to insure we are above min, second parenthesis is in-between min and max, and third parenthesis is condition for above max:        
        A[i, ]$Saelger = s$Saelger_Fast_salaer*s$Kurs + i*s$Saelger_Andet_pct +
          (i*s$Saelger_Variable_salaer <= s$Saelger_Min_variable_salaer*s$Kurs) * 
            s$Saelger_Min_variable_salaer*s$Kurs +
          (i*s$Saelger_Variable_salaer > s$Saelger_Min_variable_salaer | (s$Saelger_Max_variable_salaer != 0 & i*s$Saelger_Variable_salaer < s$Saelger_Max_variable_salaer*s$Kurs)) *
            i*s$Saelger_Variable_salaer
          (s$Saelger_Max_variable_salaer != 0 & i*s$Saelger_Variable_salaer >= s$Saelger_Max_variable_salaer*s$Kurs) *
            s$Saelger_Max_variable_salaer*s$Kurs;

        A[i, ]$Koeber = s$Koeber_Fast_salaer*s$Kurs + i*s$Koeber_Variable_salaer;

      }
  }
  return(A)
}

library(plyr)
Plotdata = adply(Prisstruktur, 1, PrisstrukturToPlotdata, .expand = FALSE) 

Объяснение условий: существует минимальное значение, ниже которого кривая вообще не должна строиться; if(i > s$Mindste_bud*s$Kurs)). Затем есть процент i*s$Saelger_Variable_salaer с минимальным и максимальным уровнем соответственно (чтобы усложнить ситуацию, не все функции имеют максимальное значение, те, у которых нет максимального значения, просто 0). Если процент ниже минимального, следует использовать минимальный уровень. Если процент выше максимального, то следует использовать максимальный уровень. Между ними следует использовать процент.

Приведенный выше скрипт работает нормально для N=100 или даже N=1000, но когда я перехожу к N=10000 или выше, для запуска требуется много времени. Я предполагаю, что это связано со всеми условными операторами, но я не уверен, как это сделать более эффективно?


фиктивные данные:

Site = c('A', 'B', 'C')
Mindste_bud = c(300, 0 , 0)
Saelger_Fast_salaer = c(0, 250, 2)
Saelger_Variable_salaer = c(0.12, 0.16, 0.10)
Saelger_Min_variable_salaer = c(250, 0, 0)
Saelger_Max_variable_salaer = c(0, 0, 250)
Saelger_Andet_pct = c(0, 0, 0)
Koeber_Fast_salaer = c(95, 0, 0)
Koeber_Variable_salaer = c(0.2, 0.25, 0)
Kurs = c(1, 1, 5.430)
Prisstruktur = cbind(Site, Mindste_bud, Saelger_Fast_salaer, Saelger_Variable_salaer, Saelger_Min_variable_salaer, Saelger_Max_variable_salaer, Saelger_Andet_pct, Koeber_Fast_salaer, Koeber_Variable_salaer, Kurs)

person bonna    schedule 05.03.2014    source источник
comment
Добавление некоторых фиктивных данных сделает ваш код воспроизводимым. Вам, вероятно, не нужен цикл в этой функции.   -  person Thierry    schedule 05.03.2014


Ответы (1)


Вам не нужен цикл в вашей функции. Я сомневаюсь, что вам нужны все N = 10000 точек данных, чтобы получить хороший график. Я добавил структуру в ваш код, используя больше пробелов и некоторые функции ifelse для ясности.

PrisstrukturToPlotdata <- function(s, N = 10000, Length = 101)
  n <- seq(s$Mindste_bud * s$Kurs + 1, N, length = Length)
  data.frame(
    Bid = n,
    Saelger = 
      s$Saelger_Fast_salaer * s$Kurs + 
      n * s$Saelger_Andet_pct +
      ifelse(
        n * s$Saelger_Variable_salaer <= s$Saelger_Min_variable_salaer * s$Kurs,
        s$Saelger_Min_variable_salaer * s$Kurs,
        0
      ) +
      ifelse(
        n * s$Saelger_Variable_salaer > s$Saelger_Min_variable_salaer | 
          (s$Saelger_Max_variable_salaer != 0 & 
             n * s$Saelger_Variable_salaer < s$Saelger_Max_variable_salaer * s$Kurs),
        n * s$Saelger_Variable_salaer,
        0
      ) +       
      ifelse(
        s$Saelger_Max_variable_salaer != 0 & n * s$Saelger_Variable_salaer >= s$Saelger_Max_variable_salaer * s$Kurs,
        s$Saelger_Max_variable_salaer * s$Kurs,
        0
      ),
    Koeber = s$Koeber_Fast_salaer * s$Kurs + n * s$Koeber_Variable_salaer
  )
)
person Thierry    schedule 05.03.2014