Application Center - Maplesoft

# La méthode hongroise

You can switch back to the summary page by clicking here.

M?thode hongroise

?  Andr? L?vesque

La m?thode hongroise est la mod?lisation d'un algorithme utilis? en recherche op?rationnelle qui permet de minimiser un co?t ou encore de maximiser une satisfaction suite ? une s?rie d'affectations. L'algorithme a ?t? d?velopp? en 1955 par Harold Kuhn et reprise en 1957 par James Munkres.

**************************************

 > restart: ch:="AFFECTATIONS MINIMALES": couplage:=proc() local i, j, k, p, q, C: global a, n, B, iz, jz, nz, mz, m, mi, mj, z: a:=[]: z:=1: while z<>0 do  iz:='iz':  jz:='jz':  while iz<>[] or jz<>[] do    nz:=[]:    iz:=[]:    for i from 1 to n do      p:=0:      for j from 1 to n do        if B[i,j]=0 then          p:=p+1        fi:      od:      nz:=[op(nz),p]:    od:    for i from 1 to n do      if nz[i]=1 then        iz:=[op(iz),i]      fi    od:    for i in [op(iz)] do      for j from 1 to n do        if B[i,j]=0 then          a:=[op(a),[i,j]]:          for k from 1 to n do            B[i,k]:=1:            B[k,j]:=1          od        fi      od    od:    mz:=[]:    jz:=[]:    for i from 1 to n do      q:=0:      for j from 1 to n do        if B[j,i]=0 then          q:=q+1        fi:      od:      mz:=[op(mz),q]:    od:    for i from 1 to n do      if mz[i]=1 then        jz:=[op(jz),i]      fi    od:    for i in [op(jz)] do      for j from 1 to n do        if B[j,i]=0 then          a:=[op(a),[j,i]]:          for k from 1 to n do            B[j,k]:=1:            B[k,i]:=1          od        fi      od    od:  od:  z:=0:  for i from 1 to n do    for j from 1 to n do      if B[i,j]=0 then        z:=z+1      fi    od  od:  if nops(a)0 then    C:=matrix(n,n,99999999):    for i from 1 to n do      for j from 1 to n do        p:=0:        q:=0:        if B[i,j]=0 then          for k from 1 to n do            if B[k,j]=0 then              p:=p+1:            fi:            if B[i,k]=0 then              q:=q+1:            fi:          od:          C[i,j]:=p+q+abs(p-q)/1e8+min(p,q)/1e8        fi:      od:    od:    m:=99999999:    for i from 1 to n do      for j from 1 to n do        if C[i,j]k do    nk:=k:    for i in op(lq) do      for j from 1 to n do        if X[i,j]=0 and evalb([i,j] in {op(a)})=false then          co:=[op(co),j]        fi:      od:    od:    cq:={op(co)}:    for i from 1 to n do      for j in op(cq) do              if evalb([i,j] in convert(a,set))=true and evalb(i in {cm})=true then          x:=x union {i}        fi:      od:    od:    lq:=x:    k:=nops(lq union cq):  od:  x:= {}:    for i in lq do      for j in {seq(i,i=1..n)} minus cq do        x:= x union {X[i,j]}      od    od:    if op(x minus {0})=NULL then      return    fi:    mn:=min(op(x minus {0})):    for i in lq do      for j from 1 to n do        X[i,j]:=X[i,j]-mn      od    od:    for i from 1 to n do      for j in cq do        X[i,j]:=X[i,j]+mn      od    od end proc: matrice:=proc() local i, j, k, P, x, dp, ml, lg, mc, nl, nc, ct, cp, temps: global A, B, X, a, n, lq, mn, d, dl, E, db: a:='a': n:='n': A:='A': B:='B': mn:='mn': lq:=[]: temps:=time(): if Maplets:-Tools:-Get('TB1')<>"" then  d:=Maplets:-Tools:-Get('TB1'):    if d[length(d)]<>"    " then d:=cat(d," ")    fi else  use Maplets[Tools] in  Maplets[Examples][Alert]( "Vous devez d'abord donner les indices d'affectation\nd'au moins deux ?l?ments. Par cons?quent, la troisi?me\ncase doit contenir au moins deux lignes de valeurs.")  end use:  return fi:  dl:=[]:  db:="":  dp:="":    for i from 1 to length(d) do      if (d[i]="." and dp<>".")  or (d[i]="," and dp<>",") or (d[i]="-" and dp<>"-") or d[i]="0" or d[i]="1" or d[i]="2" or d[i]="3" or d[i]="4" or d[i]="5" or d[i]="6" or d[i]="7" or d[i]="8" or d[i]="9"  then        db:=cat(convert(db,string),convert(d[i],string)):        dp:=d[i]:      elif d[i]="        " or d[i]="\t" then        db:=cat(convert(db,string),","):      elif db<>"" and d[i]="\n" then          if d[i]="\n" and d[i-1]="," then          db:=cat("[",seq(db[k], k=1..length(db)-1),"]"):          dl:=[op(dl),parse(db)]:db:=""        else          db:=cat("[",convert(db,string),"]"):          dl:=[op(dl),parse(db)]:db:=""        fi      fi    od:    B:=matrix([op(dl),parse(db)]):    nl:=linalg[rowdim](B):    nc:=linalg[coldim](B):    if nl<=1 then      Maplets[Examples][Alert]("Vous devez d'abord donner les indices d'affectation\nd'au moins deux ?l?ments. Par cons?quent, la troisi?me\ncase doit contenir au moins deux lignes de valeurs."):      return    fi:    n:=max(nl,nc):    if Maplets:-Tools:-Get('RB1')=true then k:=99999999 else k:=-99999999 fi:    A:=matrix(n,n,k):      for i from 1 to nl do        for j from 1 to nc do          if whattype(B[i,j])=indexed then            A[i,j]:=k          else            A[i,j]:=B[i,j]          fi        od      od:    n:=linalg[rowdim](A):    d:=Maplets:-Tools:-Get('TBE'):    E:=[]:    db:="":      for i from 1 to length(d) do        if d[i]<>"," and d[i]<>"        " and d[i]<>"\n" and d[i]<>"\t" then          db:=cat(convert(db,string),convert(d[i],string))        else          E:=[op(E),db]:          db:=""        fi      od:      E:=[op(E),db]:    d:=Maplets:-Tools:-Get('TBP'):    P:=[]:    db:="":      for i from 1 to length(d) do        if d[i]<>"," and d[i]<>"        " and d[i]<>"\n"  and d[i]<>"\t" then            db:=cat(convert(db,string),convert(d[i],string))        else          P:=op[op(P),db]:          db:=""        fi      od:      P:=[op(P),db]:      for i from 1 to n do        lg:="":        for j from 1 to n do          lg:=cat(convert(lg,string)," ",convert(A[i,j],string)):        od:        Set(TW1(appendline)=lg):      od:    B:=matrix(A):      if Maplets:-Tools:-Get('RB1')=false then        k:=B[1,1]:        for i from 1 to n do          for j from 1 to n do            if B[i,j]>k then              k:=B[i,j]            fi          od        od:        for i from 1 to n do          for j from 1 to n do            B[i,j]:=k-B[i,j]          od        od      fi:      for i from 1 to n do        ml:=min(seq(B[i,j],j=1..n)):        for j from 1 to n do          B[i,j]:=B[i,j]-ml        od:      od:      for j from 1 to n do        mc:=min(seq(B[i,j],i=1..n));        for i from 1 to n do          B[i,j]:=B[i,j]-mc        od:      od:      X:=matrix(B):      k:=0:      ct:=0:        while nops(a)99999999 and A[a[i,1],a[i,2]]<>-99999999 then            Maplets:-Tools:-Set(TFR(appendline)=cat(convert(E[a[i,1]], string), " -> ", convert(P[a[i,2]], string), "  (", convert(A[a[i,1],a[i,2]],string), ")")):            k:=k+A[a[i,1],a[i,2]]          fi        od:        Maplets:-Tools:-Set(TFR(appendline)=" "):        Maplets:-Tools:-Set(TFR(appendline)=cat("Indice total = ", convert(k,string))):        Maplets:-Tools:-Set(TFR(appendline)=cat("Temps = ", convert(time()-temps,CaractDec), " sec.")) end proc: max_min:=proc() local ch:  if Maplets:-Tools:-Get('RB1')=true then    ch:="AFFECTATIONS MINIMALES"  else    ch:="AFFECTATIONS MAXIMALES"  fi: Maplets:-Tools:-Set('L1'(caption)=ch): end proc: `convert/CaractDec`:= proc(x) local X, i, j: X:= sprintf(cat("%", 2*Digits+2, ".", Digits, "f"), x): for i while X[i] = " " do od: for j from length(X) by -1 while X[j] = "0" do od: if X[j] = "." then j:= j-1 fi: X[i..j] end: with(Maplets[Elements]): hongroise:=Maplet('onstartup'=RunWindow('W0'), Window['W1'](title="Aide",'layout' = 'BL2', resizable = false), BoxLayout['BL2']( BoxColumn(border=true, TextBox['TB2'](width=70,height=20,editable=false, " M?THODE HONGROISE (Algorithme d'affectation) La m?thode hongroise est un algorithme qui permet de minimiser un co?t ou de maximiser une satisfaction suite ? une s?rie d'affectations. L'algorithme a ?t? d?velopp? en 1955 par Harold Kuhn et reprise en 1957 par James Munkres. Supposons par exemple qu'un employeur vient d'accueillir cinq stagiaires ? qui il a demand? d'exprimer par une note de 1 ? 5, leurs pr?f?rences vis-?-vis de cinq postes ? pourvoir.                Poste 1  Poste 2  Poste 3  Poste 4  Poste 5                          Stagiaire 1     1        2        3        4        5   Stagiaire 2     1        4        2        5        3   Stagiaire 3     3        2        1        5        4   Stagiaire 4     1        2        3        5        4   Stagiaire 5     2        1        4        3        5 La m?thode hongroise permet d'obtenir une affectation qui r?pond le mieux aux souhaits des stagiaires.   Stagiaire 1 -> Poste 5  (indice de satisfaction 5)   Stagiaire 2 -> Poste 2  (indice de satisfaction 4)   Stagiaire 3 -> Poste 1  (indice de satisfaction 3)   Stagiaire 4 -> Poste 4  (indice de satisfaction 5)   Stagiaire 5 -> Poste 3  (indice de satisfaction 4) Indice de satisfaction global 21. MARCHE ? SUIVRE Pour obtenir la r?ponse pr?c?dente en utilisant l'application fournie, il faut:  a) cocher la case ?AFFECTATIONS MAXIMALES?  b) indiquer les ?l?ments ? affecter ? la case ? X = ?       Stagiaire 1, Stagiaire 2, Stagiaire 3, Stagiaire 4, Stagiaire 5  c) indiquer les affectations possibles ? la case ? Y = ?       Poste 1, Poste 2, Poste 3, Poste 4, Poste 5  d) indiquer les indices de satisfaction pour les diff?rentes     affections ? la derni?re case       1, 2, 3, 4, 5       1, 4, 2, 5, 3       3, 2, 1, 5, 4       1, 2, 3, 5, 4       2, 1, 4, 3, 5 Notons que les ?tapes b) et c) sont des ?tapes optionnelles. Lorsque les cases associ?es ? ces ?tapes sont vides, les ?l?ments ? affecter et les affectations possibles seront num?rot?s (1, 2, 3, ...). Les diff?rentes donn?es peuvent ?tre copi?es et coll?es ? partir d'un tableur comme Excel. La m?thode produit une seule solution optimale m?me si la solution optimale n'est pas unique. Soyez conscient que les temps de calcul augmentent rapidement. La dur?e des calculs d?pend ?videmment du nombre d'indices d'affection mais aussi de la diversit? de ces indices. Par exemple un probl?me contenant 10 000 indices d'affectation s'?chelonnant de 0 ? 10 000 prendra entre 1 et 4 minutes sur un PC cadenc? ? 3,2 Ghz. " ), Button("FERMER",CloseWindow('W1')) ) ), Window['W0'](title="Probl?me d'affectation (m?thode hongroise)", 'menubar'='MB1', resizable = false, [border=true, 'inset'=0, 'spacing'=0,  [    [      [      RadioButton['RB1']("AFFECTATIONS MINIMALES", 'value'=true,'group'='BG1'),      RadioButton['RB2']("AFFECTATIONS MAXIMALES", 'value'=false,'group'='BG1')      ],    Label(" ", font=Font('Helvetica',4)),    Label("Indiquez tous les ?l?ments ? affecter (optionnel)", font=Font('Helvetica',11)),      [      "X = ",TextField['TBE'](" X1, X2, X3, X4, X5, X6, X7, X8, X9, X10", width=60, tooltip="Tapez ou copiez et collez les ?l?ments", 'popupmenu'='P1')      ],    Label("Indiquez les diff?rentes affectations (optionnel)", font=Font('Helvetica',11)),      [      "Y = ",      TextField['TBP'](" Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8, Y9, Y10", width=60, tooltip="Tapez ou copiez et collez les ?l?ments", 'popupmenu'='P2')      ],    Label("Donnez les indices d'affection", font=Font('Helvetica',11)),      [      "X    ",      TextBox['TB1'](" 30, 60, 24, 45, 59, 61, 21, 34, 43, 86\n 44, 32, 22, 37, 45, 63, 15, 34, 35, 43\n 95, 19, 11, 95, 20, 21, 17, 53, 75, 91\n 69, 85, 86, 33, 85, 26, 25, 75, 51, 31\n 64, 56, 15, 58, 38, 70, 77, 62, 54, 88\n 27, 71, 54, 21, 74, 26, 42, 92, 52, 34\n 15, 37, 13, 95, 21, 19, 80, 80, 48, 86\n 24, 37, 59, 35, 53, 62, 86, 33, 65, 48\n 12, 50, 54, 33, 90, 78, 39, 74, 90, 76\n 59, 89, 65, 48, 94, 21, 34, 36, 25, 14 ", height=12, width=60, wrapped = false, tooltip="Tapez ou copiez et collez les indices d'affectation", 'popupmenu'='P3')      ],    "Y",      [      Button['B1']("EFFECTUER", onclick=Action(Evaluate('TFR'=""), SetOption('B1'(enabled)=false), Evaluate('function'='matrice()'), SetOption('B1'(enabled)=true))),      Label("? Andr? L?vesque", halign =left, font=Font('Helvetica',italic,10))      ]    ],    [    Label['L1']("AFFECTATIONS MINIMALES", font=Font('Helvetica', bold, 11), foreground="#31AE31"),    TextBox['TFR'](height=24, width=25, editable=false, wrapped = false)    ]  ] ],  MenuBar['MB1'](    Menu("Fichier",        MenuItem("Fermer", Shutdown())    ),    Menu("?",        MenuItem("Aide", RunWindow('W1'))    )  ),  PopupMenu['P1'](    MenuItem("Effacer", onclick = Action(SetOption('TBE' = ""), SetOption('TFR' = "")))  ),  PopupMenu['P2'](    MenuItem("Effacer", onclick = Action(SetOption('TBP' = ""), SetOption('TFR' = "")))  ),  PopupMenu['P3'](    MenuItem("Effacer", onclick = Action(SetOption('TB1' = ""), SetOption('TFR' = "")))  ) ), ButtonGroup['BG1'](onchange=Evaluate('L1'='max_min()')) ): Maplets[Display](hongroise):