闪亮的反应式呼叫自己

时间:2020-10-05 10:34:09

标签: r matrix shiny reactive

我原本打算在R中创建匈牙利算法的实现,但对反应性函数的行为感到困惑,后者使用打印语句进行调试似乎是在自我调用。

不起作用的反应函数是stepthree(),我代码的粗略要点是将矩阵传递给反应函数,这些函数将执行匈牙利算法的步骤并返回结果矩阵。

以下是反应函数的代码段:

stepthree <- reactive({
    num_lines <- number_of_lines();
    print("Step three");
    matrix_clean <- stepone(); #Taking a clean matrix from step one
    matrix <- steptwo(); #Taking the matrix which has lines drawn on it
    
    print("matrix_clean - clean matrix from step 1");
    print(matrix_clean);
    
    print("Matrix - dirty matrix from step 1");
    print(matrix);
    
    line_iteral <- data.frame(matrix(ncol=3, nrow = 2*ncol(matrix))); #create a matrix to store the number of zeros in each row and column
    colnames(line_iteral) <- c("Position","Num","Type"); 
    lines_to_draw <- lines(); #Create another matrix to store the positions of the lines (1 means line, 0 means No line); row 1 is for "rows", row 2 is for "columns"
    print("Lines to draw");
    print(lines_to_draw);
    
    while(num_lines < ncol(matrix_clean)){
        
        print("No. of lines not the same!");
        smallest <- as.numeric(min(unlist(matrix))); #Take the smallest UNCOVERED value from the Matrix w lines on it (Gave the covered elements a very high value)
        print("Smallest:");
        print(smallest);
        for(i in 1:nrow(matrix_clean)){ #Subtract the smallest value from UNCOVERED entries and add the least value to COVERED entries
            for(j in 1:ncol(matrix_clean)){
                if(lines_to_draw[1,i] == 0 & lines_to_draw[2,j]==0){
                    matrix_clean[i,j] <- matrix_clean[i,j] - smallest;
                    print(paste("Subtracted smallest value of: ", toString(smallest), " to row ", toString(i), "and column", toString(j)));
                }
                else if(lines_to_draw[1,i] == 1 & lines_to_draw[2,j] == 1){
                    matrix_clean[i,j] <- matrix_clean[i,j] + smallest;
                    print(paste("Added smallest value of: ", toString(smallest), " to row ", toString(i), "and column", toString(j)));
                }
            }
        }
        print("Saving matrix_clean");
        matrix3(matrix_clean); #Store the untouched matrix in a reactive global var
        
        lines_to_draw[1,] <- 0; #Reset the matrix which stores the position of the lines
        lines_to_draw[2,] <- 0;
        
        print("matrix_clean - edited matrix");
        print(matrix_clean);
        for(i in 1:nrow(matrix_clean)){
            line_iteral[i,1] <- i;
            line_iteral[i,2] <- sum(matrix_clean[i,] == 0);
            line_iteral[i,3] <- c("Row");
        } #Sum up all the zeros in the rows
        for(j in 1:ncol(matrix_clean)){
            line_iteral[j+ncol(matrix_clean),1] <- j;
            line_iteral[j+ncol(matrix_clean),2] <- sum(matrix_clean[,j] == 0);
            line_iteral[j+ncol(matrix_clean),3] <- c("Col");
        } #Sum up all the zeros in the columns
        total_zeros <- sum(line_iteral[1:(ncol(matrix)),2]);
        print("line_iteral line 468: ");
        print(line_iteral);
        print("Total Zeros:");
        print(total_zeros);
        while(total_zeros > 0){
            largest <- line_iteral %>% slice(which.max(Num));
            #print(largest);
            if(largest[3] == "Row"){
                matrix_clean[as.numeric(largest[1]),] <- 99999999;
                lines_to_draw[1,as.numeric(largest[1])] <- 1;
            }
            else{
                matrix_clean[,as.numeric(largest[1])] <- 99999999;
                lines_to_draw[2,as.numeric(largest[1])] <- 1;
            }
            for(i in 1:nrow(matrix_clean)){
                line_iteral[i,1] <- i;
                line_iteral[i,2] <- sum(matrix_clean[i,] == 0);
                line_iteral[i,3] <- "Row"
            } #Sum up all the zeros in the rows
            for(j in 1:ncol(matrix_clean)){
                line_iteral[j+ncol(matrix_clean),1] <- j;
                line_iteral[j+ncol(matrix_clean),2] <- sum(matrix_clean[,j] == 0);
                line_iteral[j+ncol(matrix_clean),3] <- "Col";
            } #Sum up all the zeros in the columns
            total_zeros <- sum(line_iteral[1:ncol(matrix_clean),2]);
            print("Total Zeros");
            print(total_zeros);
        }
        #print(line_iteral)
        num_lines <- sum(lines_to_draw[1,]) + sum(lines_to_draw[2,]);
        print("Number of lines:");
        print(num_lines);
        print("Lines to draw:");
        print(lines_to_draw);
        matrix <- matrix_clean;
        matrix4(matrix_clean);
        matrix_clean <- matrix3();
        print("No of columns: ");
        print(ncol(matrix_clean))
        if(num_lines == ncol(matrix_clean)){
            break;
        }
        print("Rinse and Repeat: Looping");
    }
    return(matrix_clean); 
})

对于UI,我在输出部分仅调用一次“ stepthree()”:

gg <- reactive({
    ggplot <- ggplot(data=coordinates(),mapping = aes(x="x", y="y")) + geom_point(mapping = aes(x=coordinates()[,1], y=coordinates()[,2]));
    return(ggplot);
})
output$plot <- renderPlot({
    gg();
})
output$table <- renderTable({
    coordinates();
})
output$dist_matrix_x <- renderTable({
    distance_matrix_x();
})
output$dist_matrix_y <- renderTable({
    distance_matrix_y();
})
output$combined_matrix <- renderTable({
    combined_matrix();
})
output$stepone <- DT::renderDataTable({
    DT::datatable(stepone(),options = list(lengthMenu = c(100,1000,10000), pageLength = 100));
})
output$steptwo <- DT::renderDataTable({
    DT::datatable(transposed(), options = list(lengthMenu = c(100,1000,10000), pageLength = 100)) %>% formatStyle(colnames(lines_at_step_two())[lines_at_step_two()[2,]==1], backgroundColor = "yellow") %>% formatStyle(colnames(steptwo()), valueColumns = "transposed[, 1]", target = "row", backgroundColor = styleEqual(c(1,0), c("yellow","white")));
})
output$stepthree <- DT::renderDataTable({
    DT::datatable(steptwo(), options = list(lengthMenu = c(100,1000,10000), pageLength = 100));
})
output$stepfour <- DT::renderDataTable({
    DT::datatable(stepthree(), options = list(lengthMenu = c(100,1000,10000), pageLength = 100)) 
})
output$stepfive <- DT::renderDataTable({
    DT::datatable(as.data.frame(matrix4()));
})

我已上传完整代码here

该程序的总体思想是: stepone()

  1. 从上一个函数中获取一个矩阵,该函数返回一个对称矩阵。称为“矩阵”。
  2. 从“矩阵”中,从每一行中减去每一行的最小值;和每一列中每一列的最小值。
  3. 返回“矩阵”

到目前为止,这部分工作正常。

steptwo(): (尝试绘制尽可能少的行数以覆盖所有零)

  1. 从stepone()导入矩阵。称为“矩阵”
  2. 在“矩阵”的行和列中找到零的总数。将其保存在名为“ line_iteral”的矩阵下。 全部(总计零值> 0){
  3. 通过选择数量最多的零行/列,然后用较大的值替换“矩阵”中的整个行/列,绘制“线”以覆盖所有零。
  4. 将行的位置存储在矩阵“ lines_to_draw”中,该矩阵将保存到全局反应变量lines()中,以便可以在stepthree()中使用
  5. 重复第3步(将零的总数求和,然后保存为“ line iteral”)
  6. 求和的总数为零(“行迭代”中任一行的总和,并将其保存为“ total_zeros”。

(重复步骤3-6,直到总零= 0) } 6.通过在“ lines_to_draw”中找到条目的总和来求和,并将其保存在全局变量“ number_of_lines()”中 7.返回“矩阵”

stepthree():(编辑矩阵,并重复执行以最少的行数覆盖零的过程,直到行数=列数

  1. 从steptwo()导入结果。称为“矩阵”。
  2. 从stepone()导入结果。将此矩阵称为“ matrix_clean”。

WHILE (在steptwo()中绘制的行数小于矩阵中的列数){

  1. 从“矩阵”中取最小值并将其存储为“最小”
  2. 采用“ matrix_clean”,从“ matrix_clean”中所有未发现的条目中减去“ smallest”
  3. (坐标,其中lines()[1,y]和lines()[2,x] == 0)并将其添加到所有覆盖的条目中(坐标,其中lines()[1,y]和lines()[ 2,x] == 1)。
  4. 将“ matrix_clean”保存到全局反应变量“ matrix3”
  5. 在“矩阵”的行和列中找到零的总数。将其保存在名为“ line_iteral”的矩阵下。 全部(总计零值> 0){
  6. 通过选择数量最多的零行/列,然后用较大的值替换“矩阵”中的整个行/列,绘制“线”以覆盖所有零。
  7. 将行的位置存储在矩阵“ lines_to_draw”中。
  8. 重复第3步(将零的总数求和,然后保存为“ line iteral”)
  9. 求和的总数为零(“行迭代”中任一行的总和,并将其保存为“ total_zeros” } (重复画线并在没有零的情况下对零求和的过程)
  10. 通过在“ lines_to_draw”中找到条目的总和来将行数求和并将其保存在全局变量“ number_of_lines()”中
  11. 让“ matrix_clean”成为“ matrix3”
  12. 让“ matrix”成为“ matrix_clean” (重复步骤3-13,直到“ number_of_lines”等于“ matrix_clean”的列数为止) }
  13. 返回“ matrix_clean”作为最终答案。

我在运行代码时遇到的问题是,反应性函数stepthree()似乎将自己称为“ number_of_lines”和“ ncol(matrix_clean)”相等,因此使用print()进行调试表明由于某种原因,再次调用整个step3,而不是返回“ matrix_clean”作为最终结果。我不确定响应函数的行为方式是否做错了,或者该错误是否源于系统设计算法运行方式的系统性问题。

在我刚开始使用R时,我会为代码混乱表示歉意。对您的任何帮助将不胜感激!


0 个答案:

没有答案