Блог

Я намеревался создать реализацию венгерского алгоритма в 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 amp; 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 amp; 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); 
})
  

Что касается пользовательского интерфейса, я вызываю «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()));
})
  

Я загрузил полный код здесь

Общая идея программы такова: stepone()

1. Принимает матрицу из предыдущей функции, которая возвращает симметричную матрицу. Назовите это «матрицей».
2. Из «матрицы» вычтите наименьшее значение каждой строки из каждой строки; и наименьшее значение в каждом столбце из каждого столбца.
3. Возвращает «матрицу»

As of now, this part works fine.

steptwo():
(Attempt the draw the least number of lines possible to cover all the zeros)

1. Import the matrix from stepone(). Call this «matrix»
2. Find the sum of the number of zeros in the rows and in the columns in «matrix». Save this under a matrix called «line_iteral».
   WHILE (total_zeros > 0) {
3. Draw «lines» to cover all the zeros by choosing the row/column with the largest number of zeros and then replacing the entire row / column in «matrix» with a large value.
4. Store the positions of the lines in a matrix «lines_to_draw» which is saved to a global reactive variable lines() so that it can be used in stepthree()
5. Repeat Step 3 (Sum the number of zeros and save it to «line iteral»)
6. Sum the total number of zeros (sum of either row in «line iteral» and save it to «total_zeros».

(Repeat steps 3-6 until total zeros = 0)
}
6. Sum the number of lines by finding the sum of entries in «lines_to_draw» and save it in a global variable «number_of_lines()
7. Return «matrix»

stepthree(): (Edit the matrix and repeat the process of covering zeros with the least number of lines until the number of lines = the number of columns

1. Импортируйте результат из steptwo(). Назовите это «матрицей».
2. Импортируйте результат из stepone(). Назовите эту матрицу «matrix_clean».

В то время как (количество строк, нарисованных в steptwo(), меньше, чем количество столбцов в матрице) {

3. Возьмите наименьшее значение из «матрицы» и сохраните его как «наименьшее»
4. Возьмите «matrix_clean», вычтите «наименьший» из всех открытых записей в «matrix_clean»
5. (координаты, где lines()[1,y] amp; lines()[2,x] == 0) и добавьте его ко всем закрытым записям (координаты, где lines()[1,y] amp; lines()[2,x] == 1).
6. Сохраните «matrix_clean» в глобальную реактивную переменную «matrix3»
7. Найдите сумму количества нулей в строках и столбцах в «матрице». Сохраните это в матрице с именем «line_iteral». WHILE (total_zeros > 0) {
8. Нарисуйте «линии», чтобы покрыть все нули, выбрав строку / столбец с наибольшим количеством нулей, а затем заменив всю строку / столбец в «матрице» большим значением.
9. Сохраните позиции строк в матрице «lines_to_draw».
10. Повторите шаг 3 (суммируйте количество нулей и сохраните его в «line iteral»)
11. Суммируйте общее количество нулей (сумма любой строки в «итерации строки» и сохраните ее в «total_zeros» } (Повторите процесс рисования линии и суммирования нулей при отсутствии нулей)
12. Суммируйте количество строк, найдя сумму записей в «lines_to_draw» и сохраните ее в глобальной переменной «number_of_lines ()»
13. Пусть «matrix_clean» будет «matrix3»
14. Пусть «matrix» будет «matrix_clean» (повторяйте шаги 3-13, пока «number_of_lines» не будет равно числу столбцов «matrix_clean») }
15. Верните «matrix_clean» в качестве окончательного ответа.

Проблема, с которой я столкнулся во время выполнения кода, заключалась в том, что реактивная функция stepthree(), казалось, вызывала себя так, как будто «number_of_lines» и «ncol (matrix_clean)» были равны, отладка с использованием print() показала мне, что по какой-то причине все stepthree вызывалось снова вместо возврата «matrix_clean»как конечный результат. Я не уверен, что я делаю что-то неправильно с тем, как ведут себя реактивные функции, или, возможно, эта ошибка связана с системной проблемой, связанной с тем, как я разработал алгоритм для запуска.

Заранее прошу прощения за беспорядочный код, поскольку я только начинаю с R. Любая помощь будет принята с благодарностью!