Обратное время оценки в gsub

Question

Я пытаюсь сгенерировать функции, объединяющие n gaussians, и используя значения, полученные из прогона nls. Я использую gsub, чтобы заменить исходные коэффициенты на nls, используя обратные ссылки. Тем не менее, кажется, что [ по данным оценивается до \\1.

Вот MWE:

nls <- data.frame(Estimate = seq(1,3)) 
row.names(nls) <- c("a","b","c") 
gsub("(a|b|c)",paste0(" ",nls["\\1","Estimate"]," "),"a + b*x + c*x^2") 

Как вы можете видеть, замены являются NAs, в то время как призыв к НСГ dataframe представляются обоснованными:

gsub("(a|b|c)",paste0(" ","\\1","Estimate"," "),"a + b*x + c*x^2") 

Любые идеи для задержки оценка [?

Спасибо!

EDIT: для ясности, здесь полная функция теперь работает отлично (она принимает количество пиков, формулу одного пика, параметры в формуле, переменную, константу boolean и nls в качестве аргументов и возвращает формула для использования в stat_function()ggplot «s:

Generate_func <- function(peakNb,peakForm,peakParams, peakVar, constBool,nls){ 
    res <- as.data.frame(summary(nls)$coefficients, optional = T) 
    rhs <- strsplit(peakForm, "~")[[1]][[2]] 
    regex <- paste0("([*+-/\\^\\(\\)[:space:]]|^)(",paste0(peakParams, collapse = "|"),")([*+-/\\^\\(\\)[:space:]]|$)") 
    exp_names <- paste0(sapply(seq(1,peakNb),function(i){ 
    paste0(sapply(peakParams, function(j){ 
     paste0(j,i) 
    })) 
    })) 
    if(constBool){exp_names <- c("C", exp_names)} 
    func_text <- paste0(sapply(seq(1,peakNb),function(n){gsubfn(regex, x + y + z ~ paste0(x,res[paste0(y,n),"Estimate"],z), rhs)}), collapse = " + ") 
    func_text <- paste0(ifelse(constBool,paste0(res["C","Estimate"]," + "),""), func_text) 

    func <- function(x){ 
    eval(parse(text = func_text)) 
    } 
    names(formals(func)) <- c(peakVar) 

    print(func_text) 

    func 
} 

А вот пример использования (данные NLS не включены ради длины):

> testfunc <- Generate_func(3, "intensity_cnt ~ a * exp((-(energy_eV-b)^2)/(2*c^2))", c("a","b","c"), "energy_eV", constBool = T, testnls) 
[1] "1000 + 32327.6598743022 * exp((-(energy_eV-1.44676439236578)^2)/(2*0.0349194350021539^2)) + 10000 * exp((-(energy_eV-1.49449385009962)^2)/(2*0.0102269096492807^2)) + 54941.8293572164 * exp((-(energy_eV-1.5321664735001)^2)/(2*0.01763494864617^2))" 

Спасибо за вашу помощь

Answer 1

1)gsub заменяет шаблон постоянным, но то, что вы хотите сделать, - это заменить его результатом применения функции к согласованной строке. gusbfn в gsubfn package делает это. Ниже формула во втором аргументе представляет собой просто краткую форму gsubfn для функции, аргументом которой является левая сторона, а тело - правая сторона. В качестве альтернативы второй аргумент может быть выражен в обычной функции записи (function(x) nls[x,]), но за счет немного многословию:

> library(gsubfn) 
> gsubfn("a|b|c", x ~ nls[x, ], "a + b*x + c*x^2") 
[1] "1 + 2*x + 3*x^2" 

Обратите внимание, что "a|b|c" может быть получен из nls использованием paste(rownames(nls), collapse = "|") для того, чтобы избежать избыточной спецификации.

2) Хотя gsubfn упрощает это существенно, чтобы сделать это без использования gsubfnsubstitute:

> L <- as.list(setNames(nls[[1]], rownames(nls))) # L <- list(a = 1L, b = 2L, c = 3L) 
> e <- parse(text = "a + b * x + c * x^2")[[1]] # e is the text as a "call" object 
> s <- do.call(substitute, list(e, L))    # perform the substitution 
> format(s)          # convert to character 
[1] "1L + 2L * x + 3L * x^2" 

В L ы обусловлены тем фактом, что nls, как определено в этом вопросе, содержит целые числа. Преобразование их в числовой перед запуском выше, если вам не нравится, что:

nls[[1]] <- as.numeric(nls[[1]]) 

3) Другая возможность состоит в том, чтобы перебрать струны быть заменены.

> s <- "a + b*x + c*x^2" 
> for(nm in rownames(nls)) s <- gsub(nm, nls[nm, ], s) 
> s 
[1] "1 + 2*x + 3*x^2" 

Если бы мы знали, что не было больше, чем одно вхождение каждого заменить мы могли бы использовать sub вместо gsub здесь.

ОБНОВЛЕНИЕ: исправлено второе решение.

ОБНОВЛЕНИЕ 2: добавлено третье решение.

Answer 2

Вот еще один способ сделать это

gsub(paste0(row.names(nls), "(.*)", collapse=""), paste0(t(nls), paste0("\\", 1:nrow(nls)), collapse=""), "a + b*x + c*x^2" ) 
[1] "1 + 2*x + 3*x^2"