# library(dplyr) # csv ( - ; - ) table <- read.csv("example.csv",header=TRUE,row.names=1,sep=";") # unique_index <- hungarian_algorithm(table,T) # cat(paste(row.names(table[as.vector(unique_index$row),])," - ",names(table[as.vector(unique_index$col)])),sep = "\n") # cat(" -",sum(mapply(function(i, j) table[i, j], unique_index$row, unique_index$col, SIMPLIFY = TRUE))) #____________________ __________________________________ hungarian_algorithm <- function(data,optim=F){ # optim = T, if(optim==T) { data <- data %>% apply(1,function(x) (x-max(x))*(-1)) %>% t() %>% as.data.frame() optim <- F } # data <- data %>% apply(1,function(x) x-min(x)) %>% t() %>% as.data.frame() # zero_index <- which(data==0, arr.ind = T) # "" - unique_index <- from_the_beginning(zero_index) # "" , .. if(nrow(unique_index)!=nrow(data)) #.. "" - unique_index <- from_the_end(zero_index) # , if(nrow(unique_index)!=nrow(data)) { # data <- data %>% apply(2,function(x) x-min(x)) %>% as.data.frame() zero_index <- which(data==0, arr.ind = T) unique_index <- from_the_beginning(zero_index) if(nrow(unique_index)!=nrow(data)) unique_index <- from_the_end(zero_index) if(nrow(unique_index)!=nrow(data)) { #"" (! ) index <- which(apply(data,1,function(x) length(x[x==0])>1)) index2 <- which(apply(data[-index,],2,function(x) length(x[x==0])>0)) # min_from_table <- min(data[-index,-index2]) # data[-index,-index2] <- data[-index,-index2]-min_from_table # , data[index,index2] <- data[index,index2]+min_from_table zero_index <- which(data==0, arr.ind = T) unique_index <- from_the_beginning(zero_index) if(nrow(unique_index)!=nrow(data)) unique_index <- from_the_end(zero_index) # "" , .. if(nrow(unique_index)!=nrow(data)) #.. hungarian_algorithm(data,optim) else # "" unique_index } else # "" unique_index } else # "" unique_index } #_________________________________________________________________________________ #__________ "" -___________ from_the_beginning <- function(x,i=0,j=0,index = data.frame(row=numeric(),col=numeric())){ # , i, j find_zero <- x[(!x[,1] %in% i) & (!x[,2] %in% j),] if(length(find_zero)>2){ # i <- c(i,as.vector(find_zero[1,1])) # j <- c(j,as.vector(find_zero[1,2])) # data frame ( ) index <- rbind(index,setNames(as.list(find_zero[1,]), names(index))) # from_the_beginning(find_zero,i,j,index)} else rbind(index,find_zero) } #_________________________________________________________________________________ #__________ "" -___________ from_the_end <- function(x,i=0,j=0,index = data.frame(row=numeric(),col=numeric())){ find_zero <- x[(!x[,1] %in% i) & (!x[,2] %in% j),] if(length(find_zero)>2){ i <- c(i,as.vector(find_zero[nrow(find_zero),1])) j <- c(j,as.vector(find_zero[nrow(find_zero),2])) index <- rbind(index,setNames(as.list(find_zero[nrow(find_zero),]), names(index))) from_the_end(find_zero,i,j,index)} else rbind(index,find_zero) } #_________________________________________________________________________________