Programa R para resolver TP con mi método

Question

He desarrollado un nuevo método para resolver TP, pero soy muy lento con la programación, ¿pueden ayudarme a escribir un programa para el método?

** III. ALGOTIMO DE AOCM PASO 1. Reste el costo más pequeño de cada elemento de cada fila de la tabla de transporte y colóquelo en la parte superior derecha de ese elemento.

PASO 2. Reste el costo más pequeño de cada elemento de cada columna de la tabla de transporte y colóquelo en la parte inferior derecha de ese elemento.

PASO 3. Cree una nueva matriz cuyos elementos sean el valor promedio de la parte superior derecha y la parte inferior derecha de los elementos del paso 1 y del paso 2.

PASO 4. Encuentre las penalizaciones de Fila y Columna tomando la diferencia entre el valor más pequeño y el siguiente valor más pequeño en la fila y columna.

PASO 5. Identifique la penalización más grande y asigne la cantidad máxima posible a esa celda que tenga el valor mínimo de elemento en la fila o columna correspondiente. Si hay un empate entre las penalizaciones más grandes, entonces el empate se puede romper tomando la diferencia entre el elemento más pequeño y el próximo al más pequeño, si el empate aún no se ha roto, repita el procedimiento con el siguiente al más pequeño y así sucesivamente, si el empate aún no se ha roto, seleccione arbitrariamente.

PASO 6. Repita del paso 5 al paso 6 hasta que se satisfaga el requisito de la llanta.

PASO 7. Ponga estos valores asignados en TT original en la celda correspondiente.

PASO 8. Calcule el costo de transporte de TT. Este cálculo es la suma del producto del costo unitario de transporte y la cantidad asignada. **

Answer 1

No he entendido completamente sus asignaciones después del cuarto punto, pero esto debería ayudarlo a comenzar (utilizando los datos proporcionados en su primera pregunta):

dfr <- read.table(text = "10  7 19 11
        5  5  7  8
        12  9 13 11
        8 10 11  9")

# step 1 to 2
drow <- apply(dfr, 1, function(x){x-min(x)})
dcol <- apply(dfr, 2, function(x){x-min(x)})

# 3
dmean <- (drow + dcol)/2
dmean
#>    [,1] [,2] [,3] [,4]
#> V1  4.0    1  7.5  1.5
#> V2  0.0    0  0.0  1.0
#> V3  9.5    3  5.0  3.0
#> V4  3.5    4  3.0  1.0

# 4 row & col penalties
drow_min <- apply(dmean, 1, function(x){
    xord <- x[order(x)] ;
    xord[2] - xord[1]})
drow_min
#>  V1  V2  V3  V4 
#> 0.5 0.0 0.0 2.0

dcol_min <- apply(dmean, 2, function(x){
    xord <- x[order(x)] ;
    xord[2] - xord[1]})
dcol_min
#> [1] 3.5 1.0 3.0 0.0

Entonces podrías usar ify elseestructurar en 5; whilepara el 6 y exporta tus datos de nuevo para sobresalir readr::write_excel_csv().

Buena suerte !