길이가 다른 두 개의 문자열에 대한 근접 채점 (R에서 이중 집계 구현)

Question

R에 다음 수식을 구현하려고하는데 문제가 있습니다.

double summation equation

내 현재의 접근 방식은 다음과 같다,하지만 난 같은 점수가 완벽하게 일치로 얻을 수 있기 때문에 정확하지 두려워 (긴, 단순한 코드에 대한 유감 : 나는 아주 새로운 해요) :

query = "acut myeloid leukemia" 
document1 = "acut myeloid leukemia normal karyotyp" 
document2 = "acut myeloid leukemia" 
document3 = "acut normal karyotyp" 

Q <- unlist(strsplit(query, " ")) 
d1 <- unlist(strsplit(document1, " ")) 
d2 <- unlist(strsplit(document2, " ")) 
d3 <- unlist(strsplit(document3, " ")) 

y <- adist(d1,Q) 
double_summation1 = 0 
for (i in 1:nrow(y-1)) { 
    for (j in 1:ncol(y-1)) { 
    double_summation1 = double_summation1 + abs(i-j) 
    } 
} 
double_summation1 
scatter <- sum(do.call(pmin, lapply(1:nrow(y), function(x)y[x,]))) 
dist_d_Q1 <- scatter/double_summation1 

y <- adist(d2,Q) 
double_summation2 = 0 
for (i in 1:nrow(y-1)) { 
    for (j in 1:ncol(y-1)) { 
    double_summation2 = double_summation2 + abs(i-j) 
    } 
} 
double_summation2 
scatter <- sum(do.call(pmin, lapply(1:nrow(y), function(x)y[x,]))) 
dist_d_Q2 <- scatter/double_summation2 

y <- adist(d3,Q) 
double_summation3 = 0 
for (i in 1:nrow(y-1)) { 
    for (j in 1:ncol(y-1)) { 
    double_summation3 = double_summation3 + abs(i-j) 
    } 
} 
double_summation3 
scatter <- sum(do.call(pmin, lapply(1:nrow(y), function(x)y[x,]))) 
dist_d_Q3 <- scatter/double_summation3 

c(dist_d_Q1, dist_d_Q2, dist_d_Q3) 

[1] 23 
[1] 8 
[1] 8 
[1] 0.00 0.00 1.75 

나는 stringdist 패키지와 같은 거리 측정을하는 쉬운 방법이 있다는 것을 알고 있습니다. 그러나 저의 목표는 기본 방안으로 공개 방정식 접근법을 구현하는 것입니다. 시간 내 주셔서 감사합니다!

Answer 1

min_dist과 actual_dist을 여러 번 계산해야하므로 함수로 써야합니다. 또한 알고리즘에 최대한 가깝게 코드를 작성하십시오. 다음과 같은 것이 작동해야합니다.

min_dist <- function(d, Q) { 
    W <- intersect(d,Q) 
    n <- length(W) 
    sum(sapply(0:(n-1), function(i) sapply(0:(n-1), function(j) abs(i-j)))) 
} 

current_dist <- function(d, Q) { 
    W <- intersect(d,Q) 
    pos <- sapply(W, function(x)which(Q==x)) 
    n <- length(pos) 
    sum(sapply(1:n, function(i) sapply(1:n, function(j) abs(pos[i]-pos[j])))) 
} 

dist_d1_Q <- min_dist(d1, Q)/current_dist(d1, Q) 
dist_d2_Q <- min_dist(d2, Q)/current_dist(d2, Q) 
dist_d3_Q <- min_dist(d3, Q)/current_dist(d3, Q) 

c(dist_d1_Q, dist_d2_Q, dist_d3_Q) 
# [1] 1 1 NaN