如何通过修复输出数据表或类似方法来概括代码并提高性能？

Question

我有这个：

bb<- c ("plotly", "tidyverse", "reshape2","DT")
# load...
lapply (bb, require, character.only = TRUE) 
 
############################################### Start   
data.frame(A=c(3.7,7.8,8.9,7.0,3.4),
           B=c(2.7,8.0,1.0,1.0,2.0),
           C=c(9.1,1.5,2.7,9.0,5.0)) %>% 
  dist() -> D
###################################################### control
res<-NULL
res[[paste0("E1")]][[paste0("result",1)]] <- list(`before` = 102.66,`after` = 134.4367)
res[[paste0("E1")]][[paste0("result",2)]] <- list(`before` = 70.89,`after` = 71.53)
res[[paste0("E1")]][[paste0("result",5)]] <- list(`before` = 17.39,`after` = 26.97)

res[[paste0("E2")]][[paste0("result",1)]] <- list(`before` = 134.4367,`after` = 127.89)
res[[paste0("E2")]][[paste0("result",2)]] <- list(`before` = 71.53,`after` = 65.175)

res[[paste0("E3")]][[paste0("result",2)]] <- list(`before` = 127.89,`after` = 123.462)


########################################## Estage o
E0 <- D^2
E0
for(i in 1:length(E0) ){
    as.matrix(E0) %>%
    round(4)  %>%
    datatable(,rownames = FALSE, selection = 'none', options = list(dom = 't', lengthMenu = list(c(-1), c('All')))) -> Matrix_Result_0
}
Matrix_Result_0
########################################### Estage 1
E1<-Matrix_Result_0$x$data
for (i in 1:length(E1)){
  for(j in 1:length(res[[1]])) if(is.element(E1[i],res[[1]][[j]]$before[[1]])) E1[i]<-res[[1]][[j]]$after[[1]]
as.matrix(E1) %>%
  round(4)  %>%
  datatable(,rownames = FALSE, selection = 'none', options = list(dom = 't', lengthMenu = list(c(-1), c('All')))) %>%
  formatStyle(c(1:5), fontWeight = 'bold', Color = styleEqual(round(E1[1:i],4),replicate(i, "red"))) -> Matrix_Result_1
}
Matrix_Result_1
########################################### Estage 2
E2<-Matrix_Result_1$x$data
for (i in 1:length(E2)){
  for(j in 1:length(res[[2]])) if(is.element(E2[i],res[[2]][[j]]$before[[1]])) E2[i]<-res[[2]][[j]]$after[[1]]
  as.matrix(E1) %>%
    round(4)  %>%
    datatable(,rownames = FALSE, selection = 'none', options = list(dom = 't', lengthMenu = list(c(-1), c('All')))) %>%
    formatStyle(c(1:5), fontWeight = 'bold',Color = styleEqual(round(E2[1:i],4),replicate(i, "magenta"))) -> Matrix_Result_2
}
Matrix_Result_2
########################################### Estage 3
E3<-Matrix_Result_2$x$data
for (i in 1:length(E3)){
  for(j in 1:length(res[[3]])) if(is.element(E3[i],res[[3]][[j]]$before[[1]])) E3[i]<-res[[3]][[j]]$after[[1]]
  as.matrix(E3) %>%
    round(4)  %>%
    datatable(,rownames = FALSE, selection = 'none', options = list(dom = 't', lengthMenu = list(c(-1), c('All')))) %>%
    formatStyle(c(1:5), fontWeight = 'bold',Color = styleEqual(round(E3[1:i],4),replicate(i, "green"))) -> Matrix_Result_3
}

第一个问题：

Matrix E0 的结果对于所有其他 E1:E3 返回相同的结果。结果输出中的图像将是要返回的最小值。我必须手动表示这些值。

我真正想要返回的结果与每个分析结果的专家输出相同。

第二题：

我不能只将更改应用到与结果；
仅对更新了值的单元格着色 res[[j]][[ i ]][[ "after" ]] ，作为预期的输出；
泛化代码并提高性能。

Answer 1

你可以使用像

这样的东西

library("tidyverse", "DT")

# Start
D <- data.frame(A = c(3.7, 7.8, 8.9, 7.0, 3.4),
                B = c(2.7, 8.0, 1.0, 1.0, 2.0),
                C = c(9.1, 1.5, 2.7, 9.0, 5.0)) %>% 
  dist()

# control
res <- list(E1 = list(result1 = list(`before` = 102.66,`after` = 134.4367),
                      result2 = list(`before` = 70.89,`after` = 71.53),
                      result5 = list(`before` = 17.39,`after` = 26.97)),
            E2 = list(result1 = list(`before` = 134.4367,`after` = 127.89),
                      result2 = list(`before` = 71.53,`after` = 65.175)),
            E3 = list(result3 = list(`before` = 127.89,`after` = 123.462)))

# initializing E0
# instead of Matrix_Result-Variable store everything in a list
# the elements are named E0, E1, ...
# the first element of a E*-list is a distance-vector-object
# the second element is a symmetric distance matrix
# both rounded to four digits
res_data <- list(
  E0 = list(
    round(D^2, 4),
    as.matrix(round(D^2, 4))
    )
  )

# Now use a double loop to iterate over the "res"-list

for (i in seq_along(res)) {
  
  res_data[[names(res)[i]]][[1]] <- res_data[[i]][[1]]

  for(j in seq_along(res[[i]])) {
  
    target <- res[[i]][[c(j,1)]] == res_data[[i]][[1]]
    
    if (any(target)) {
      res_data[[i+1]][[1]][target] <- res[[i]][[c(j,2)]]
    }
  }
  
  res_data[[i+1]][[2]] <- as.matrix(res_data[[i+1]][[1]])
  
  datatable(
    res_data[[i+1]][[2]],
    rownames = FALSE, 
    selection = 'none', 
    options = list(
      dom = 't', 
      lengthMenu = list(
        c(-1), 
        c('All')
        )
      )
    ) %>% 
    print()

}

遗漏部分

我不知道如何为输出着色。我想你能弄明白。

您可能可以使用 apply 函数优化代码，但这不会提高可读性。

如何通过修复输出数据表或类似方法来概括代码并提高性能？

How generalize the code and improve performance by fixing output datatable or similar?

r

datatables