Program R do rozwiązywania TP moją metodą

Question

Opracowałem nową metodę rozwiązywania TP, ale jestem bardzo powolny w programowaniu, czy możesz pomóc napisać program dla metody ???

** III. ALGOTYM KROK AOCM 1. Odejmij najmniejszy koszt od każdego elementu w każdym rzędzie stołu transportowego i umieść go na górze tego elementu.

KROK 2. Odejmij najmniejszy koszt od każdego elementu każdej kolumny tabeli transportowej i umieść go na prawym dole tego elementu.

KROK 3. Stwórz nową macierz, której elementy są średnią wartością z prawego górnego i prawego dołu elementów z kroku 1 i kroku 2.

KROK 4. Znajdź kary dla wierszy i kolumn, biorąc różnicę między najmniejszą i następną najmniejszą wartością w wierszu i kolumnie.

KROK 5. Zidentyfikuj największą karę i przypisz maksymalną możliwą ilość do tej komórki o minimalnej wartości elementu w odpowiednim wierszu lub kolumnie. Jeśli między największymi karami jest remis, remis można rozstrzygnąć, biorąc pod uwagę różnicę między najmniejszym a najbliższym najmniejszym elementem, jeśli remis nadal nie jest zerwany, powtórz procedurę z kolejną najmniejszą i tak dalej, jeśli remis nadal nie jest zerwany, wybierz dowolnie.

KROK 6. Powtarzaj kroki 5 do 6, aż do spełnienia wymagań dotyczących obręczy.

KROK 7. Umieść te przydzielone wartości w oryginalnym TT w odpowiedniej komórce.

KROK 8. Oblicz koszt transportu TT. Obliczenie to jest sumą iloczynu jednostkowych kosztów transportu i przydzielonej ilości. **

Answer 1

Nie w pełni zrozumiałem Twoje przypisania po czwartym punkcie, ale powinno to zacząć (korzystając z danych podanych w pierwszym pytaniu):

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

Następnie możesz użyć ifi elsestruktury w 5; whiledla 6 i wyeksportuj swoje dane z powrotem do doskonałości readr::write_excel_csv().

Powodzenia !