Circuit électrique à 180 résistances

rem ============================================================================
rem                      Maillage des résistances
rem                     Papydall le 14 / 05 / 2020
rem             Sur une idée de programme sur Rosetta Code
rem ============================================================================
rem Étant donné une grille de 10×10 noeuds interconnectés par des résistances
rem de 1 Ohm,trouver la résistance entre les points A et B.
rem ============================================================================
dim l,l3,ligne,colonne,t$
label choix
l = 21 : l3 = l/3
width 0,1400 : height 0,800
font_bold 0 : font_color 0,0,0,255 : font_size 0,12 : font_bold 0 : font_name 0,"arial"
picture 10 : width 10,900 : height 10,800 : 2d_target_is 10 : print_target_is 10
font_bold 10 : font_size 10,14 : font_color 10,255,0,0
alpha 20 : top 20,50 : left 20,width(10) + 20
font_bold 20 : font_size 20,14 : font_color 20,0,0,255
button 30 : top 30,200 : left 30,width(10)+50 : font_bold 30
caption 30,"Solution" : on_click 30,choix
button 40 : top 40,200 : left 40,width(10)+350 : font_bold 40
caption 40,"Quitter" : on_click 40,choix
alpha 50 : top 50,350 : left 50,950 : font_bold 50 : font_color 50,255,0,0
font_size 50,12
button 60 : top 60,200 : left 60,width(10)+200 : font_bold 60
caption 60,"Méthode" : on_click 60,choix
caption 0,"Circuit électrique à 180 résistances"
Grille()
t$ = "Étant donné une grille de 10×10 = 100 noeuds" + chr$(13)
t$ = t$ + "interconnectés par des résistances (180 en tout)" + chr$(13)
t$ = t$ + "de 1 Ohm comme indiqué sur le schema," + chr$(13)
t$ = t$ +"trouver la résistance entre les points A et B."
caption 20,t$
end
rem ============================================================================
Choix:
    select number_click
        case 30 : inactive 30 : Solution()
        case 40 : terminate
        case 60 : Methode()
    end_select
    
return
rem ============================================================================
SUB Solution()
     dim_local n,nn    
     dim_local g(100,101)
     dim_local node,row,col
     dim_local ar,ac,br,bc,a,b
     dim_local i,j,k,y,tmp,t$,t1$
     n = 10 : nn = n*n
     For row = 1 To n
         For col = 1 To n
             node = node + 1
             If row > 1
                g(node, node) = g(node,node) + 1
                g(node, node - n) = -1
             End_If
             If row < n
                g(node, node) = g(node,node) + 1
                g(node, node + n) = -1
             End_If
             If col > 1
                g(node, node) =  g(node,node) + 1
                g(node, node -1) = -1
             End_If
             If col < n
                g(node, node) = g(node,node) + 1
                g(node, node +1) = -1
             End_If
         Next col
     Next row
     ' Pour le calcul d'autres positions des noeuds, il suffit de modifier la
     ' ligne suivante, en indiquant les
     ' lignes (ROW : ar et br) et
     ' les colonnes (COL : ac et bc)
     ar = 2 : ac = 2 : br = 7 : bc = 8  : ' Détermination des noeuds en ROW et COL
     a = ac + n * (ar-1)                : ' noeud A  : ar,ac
     b = bc + n * (br-1)                : ' noeud B  : br,bc
     g(a, nn +1) = -1
     g(b, nn +1) = 1
     print_target_is 0
     print_locate 1000,300 : print "Noeud A : " + str$(a)
     print_locate 1000,320 : print "Noeud B : " + str$(b)    
     ' résoudre le système linéaire en utilisant la méthode de Gauss-Seidel avec pivot
     t$ = "Veuillez patienter ... Calcul en cours ... " + chr$(13)
     t$ = t$ + "<ESC> pour arrêter...... "
     For j = 1 To nn            
        caption 50,t$ + str$(j) + " / 100"  : pause 1
        For i = j To nn
            If g(i, j) <> 0 Then Exit_For
        Next i
        If i = nn +1
           print_locate 1000,350 : Print "!!! Pas de solution !!!"
            Exit_sub
        End_If
        For k = 1 To nn +1
            tmp = g(j,k) : g(j,k) = g(i,k) : g(i,k) = tmp : ' échange de g(j,k) et g(i,k)
        Next k
        y = g(j, j)
        For k = 1 To nn +1
            g(j, k) = g(j, k) / y
        Next k
        For i = 1 To nn
            If i <> j
                y = 0-g(i, j)
                For k = 1 To nn +1
                    g(i, k) = g(i, k) + y * g(j, k)
                Next k
            End_If
        Next i
        if scancode = 27 then terminate
    Next j
    caption 50,""
    print_locate 1000,400
    print "Résistance = " + str$(abs(g(a, nn +1) - g(b, nn +1))) + " Ohm"
 
END_SUB
rem ============================================================================
SUB Grille()
    for ligne = 1 to 10
        Ligne_Horizontale(50,20+80*(ligne-1))  
    next ligne
    for colonne = 1 to 10
        Ligne_Verticale((50-l3)+(colonne-1)*(70+l),35)  
    next colonne

    2d_fill_color 255,0,0
    2d_circle 120-l3+l,100,8
    2d_circle 50-l3+7*(70+l),20+80*6,8
    2d_fill_off
    print_locate 130-l3+l,70 : print "A"  
    print_locate 60-l3+7*(70+l),80*6-10 : print "B"
END_SUB
rem ============================================================================
SUB Draw_Horizontal_Resistor(x,y)
    2d_line x,y,x+l,y
    2d_rectangle x+l,y-l3,x+3*l,y+l3
    2d_line x+3*l,y,x+4*l+l3,y
END_SUB
rem ============================================================================
SUB Draw_Vertical_Resistor(x,y)    
    2d_fill_color 0,0,0
    2d_line x,y-l+5,x,y+l3    : 2d_circle x,y-l+5,5
    2d_line x,y+2*l,x,y+3*l : 2d_circle x,y+3*l,5
    2d_fill_off
    2d_rectangle x-l3,y+l3,x+l3,y+2*l          
END_SUB
rem ============================================================================
SUB Ligne_Horizontale(x,y)
    dim_local i
    for i = 1 to 9
        Draw_Horizontal_Resistor(x+(i-1)*(4*l+l3),y)
    next i
    2d_line x,y,x-l3,y  : 2d_line   x+9*(2*l+l3),y, x+9*(2*l+l3)+l3,y
END_SUB
rem ============================================================================
SUB Ligne_Verticale(x,y)
    dim_local i
    for i = 1 to 9
        Draw_Vertical_Resistor(x,y+(i-1)*80)
    next i    
END_SUB
rem ============================================================================
' Méthode de résolution
SUB Methode()
    dim_local t$
    t$ = "Plaçons une source de courant entre A et B, fournissant 1 A." + chr$(13)
    t$ = t$ + "Ensuite, nous cherchons le potentiel en A et B," + chr$(13)
    t$ = t$ + "La différence de tension entre B et A est alors la résistance"+chr$(13)
    t$ = t$ + "puisque R * I =  (V(B) - V(A)) où I est donné et nous voulons R." + chr$(13)+chr$(13)
    t$ = t$ + "Finalement, nous calculerons le potentiel à chaque nœud," + chr$(13)
    t$ = t$ + "sauf A où nous supposons qu'il est égal à 0." + chr$(13)
    t$ = t$ + "Sans cette hypothèse, il y aurait une infinité de solutions puisque le potentiel" + chr$(13)
    t$ = t$ + "est connu jusqu'à une constante." + chr$(13)
    t$ = t$ + "Pour A, nous écrirons simplement l'équation V(A) = 0." + chr$(13)+chr$(13)
    t$ = t$ + "Ainsi, pour une grille générale de p lignes et q colonnes," + chr$(13)
    t$ = t$ + "il y a  : n = p * q nœuds,donc n inconnues, et n équations." + chr$(13)
    t$ = t$ + "Écrivons la loi de Kirchhoff à chaque nœud." + chr$(13)
    t$ = t$ + "Faites attention au nœud A (équation A = 0) et au nœud B" + chr$(13)
    t$ = t$ + "(il y a une constante courant à ajouter, à partir de la source," + chr$(13)
    t$ = t$ + "qui ira dans les termes constants du système)." + chr$(13)+chr$(13)
    t$ = t$ + "Enfin, nous avons un système linéaire d'équations n x n à résoudre." + chr$(13)
    t$ = t$ + "par la méthode de Gauss-Seidel avec pivot."
    
    message t$
END_SUB
rem ===========================================================================