Привет, мне нужно написать функцию для вычисления R1, которая определяется следующим образом:
R1 = 1 - ( F(h) - h*h/2N) )
где N - количество токенов, h - точка Хирша, а F (h) - совокупные относительные частоты до этой точки. С помощью пакета quanteda мне удалось вычислить точку Хирша.
a <- c("The truck driver whose runaway vehicle rolled into the path of an express train and caused one of Taiwan’s worst ever rail disasters has made a tearful public apology.", "The United States is committed to advancing prosperity, security, and freedom for both Israelis and Palestinians in tangible ways in the immediate term, which is important in its own right, but also as a means to advance towards a negotiated two-state solution.")
a1 <- c("The 49-year-old is part of a team who inspects the east coast rail line for landslides and other risks.", "We believe that this UN agency for so-called refugees should not exist in its current format.")
a2 <- c("His statement comes amid an ongoing investigation into the crash, with authorities saying the train driver likely had as little as 10 seconds to react to the obstruction.", " The US president accused Palestinians of lacking “appreciation or respect.", "To create my data I had to chunk each text in an increasing manner.", "Therefore, the input is a list of chunked texts within another list.")
a3 <- c("We plan to restart US economic, development, and humanitarian assistance for the Palestinian people,” the secretary of state, Antony Blinken, said in a statement.", "The cuts were decried as catastrophic for Palestinians’ ability to provide basic healthcare, schooling, and sanitation, including by prominent Israeli establishment figures.","After Donald Trump’s row with the Palestinian leadership, President Joe Biden has sought to restart Washington’s flailing efforts to push for a two-state resolution for the Israel-Palestinian crisis, and restoring the aid is part of that.")
txt <-list(a,a1,a2,a3)
library(quanteda)
DFMs <- lapply(txt, dfm)
txt_freq <- function(x) textstat_frequency(x, groups = docnames(x), ties_method = "first")
Fs <- lapply(DFMs, txt_freq)
get_h_point <- function(DATA) {
fn_interp <- approxfun(DATA$rank, DATA$frequency)
fn_root <- function(x) fn_interp(x) - x
uniroot(fn_root, range(DATA$rank))$root
}
s_p <- function(x){split(x,x$group)}
tstat_by <- lapply(Fs, s_p)
h_values <-lapply(tstat_by, vapply, get_h_point, double(1))
Чтобы вычислить F (h) - совокупные относительные частоты до h_point - чтобы поместить в R1, мне нужны два значения; один из них должен быть от Fs$rank, а другой должен быть от h_values. Рассмотрим первые оригинальные тексты (tstat_by[[1]], tstat_by[[2]] и tstat_by[[3]]) и их соответствующие значения h_ (h_values[[1]], h_values[[2]] и h_values[[3]]):
fh_txt1 <- tail(prop.table(cumsum(tstat_by[[1]][["text1"]]$rank:h_values[[1]][["text1"]])), n=1)
fh_txt2 <-tail(prop.table(cumsum(tstat_by[[1]][["text2"]]$rank:h_values[[1]][["text2"]])), n=1)
...
tail(prop.table(cumsum(tstat_by[[4]][["text2"]]$rank:h_values[[4]][["text2"]])), n=1)
[1] 1
tail(prop.table(cumsum(tstat_by[[4]][["text3"]]$rank:h_values[[4]][["text3"]])), n=1)
[1] 0.75
Как видите, группировка такая же - имена документов для каждого фрагмента исходных векторов символов одинаковы (text1, text2, text3 и т. Д.). мой вопрос в том, как написать функцию для fh_txt (s), чтобы использование lapply могло быть вариантом для вычисления F (h) для R1.
Обратите внимание, что цель состоит в том, чтобы написать функцию для вычисления R1, и то, что я здесь поставил, - это то, что было сделано в этом отношении.
