Data update

Task/Resistor-mesh/Ada/resistor-mesh.adb

@@ -0,0 +1,69 @@
+with Ada.Text_IO; use Ada.Text_IO;
+procedure ResistMesh is
+   H, W : constant Positive := 10;
+   rowA, colA : constant Positive := 2; -- row/col indexed from 1
+   rowB : constant Positive := 7;
+   colB : constant Positive := 8;
+
+   type Ntype is (A, B, Free);
+   type Vtype is digits 15;
+   type Node is record
+      volt : Vtype := 0.0;
+      name : Ntype := Free;
+   end record;
+   type NodeMesh is array (Positive range <>, Positive range <>) of Node;
+   package IIO is new Ada.Text_IO.Float_IO (Vtype);
+   mesh, dmesh : NodeMesh (1 .. H, 1 .. W);
+   curA, curB, diff : Vtype;
+
+   procedure set_AB (mesh : in out NodeMesh) is begin
+      mesh (rowA, colA).volt :=  1.0;  mesh (rowA, colA).name := A;
+      mesh (rowB, colB).volt := -1.0;  mesh (rowB, colB).name := B;
+   end set_AB;
+
+   function sides (i : Positive; j : Positive) return Vtype is
+      s : Integer := 0;
+   begin
+      if i /= 1 and i /= H then s := s + 2; else s := s + 1; end if;
+      if j /= 1 and j /= W then s := s + 2; else s := s + 1; end if;
+      return Vtype (s);
+   end sides;
+
+   procedure calc_diff (mesh : NodeMesh; dmesh : out NodeMesh;
+      total : out Vtype)  is
+      n : Natural;
+      v : Vtype := 0.0;
+   begin
+      total := 0.0;
+      for i in Positive range 1 .. H loop
+         for j in Positive range 1 .. W loop
+            n := 0;    v := 0.0;
+            if  i /= 1 then v := v + mesh (i - 1, j).volt; n := n + 1; end if;
+            if j /= 1 then  v := v + mesh (i, j - 1).volt; n := n + 1; end if;
+            if i < H then v := v + mesh (i + 1, j).volt; n := n + 1; end if;
+            if j < W then v := v + mesh (i, j + 1).volt; n := n + 1; end if;
+            v := mesh (i, j).volt - v / Vtype (n);
+            dmesh (i, j).volt := v;
+            if mesh (i, j).name = Free then total := total + v ** 2; end if;
+         end loop;
+      end loop;
+   end calc_diff;
+
+begin
+
+   loop
+      set_AB (mesh);
+      calc_diff (mesh, dmesh, diff);
+      exit when diff < 1.0e-40;
+      for i in Positive range 1 .. H loop
+         for j in Positive range 1 .. W loop
+            mesh (i, j).volt := mesh (i, j).volt - dmesh (i, j).volt;
+         end loop;
+      end loop;
+   end loop;
+
+   curA := dmesh (rowA, colA).volt * sides (rowA, colA);
+   curB := dmesh (rowB, colB).volt * sides (rowB, colB);
+   diff := 4.0 / (curA - curB);
+   IIO.Put (diff, Exp => 0); New_Line;
+end ResistMesh;

Task/Resistor-mesh/EasyLang/resistor-mesh.easy

@@ -0,0 +1,60 @@
+n = 10
+nn = n * n
+len g[][] nn
+for i to nn : len g[i][] nn + 1
+#
+for row = 1 to n
+   for col = 1 to n
+      node += 1
+      if row > 1
+         g[node][node] += 1
+         g[node][node - n] = -1
+      .
+      if row < n
+         g[node][node] += 1
+         g[node][node + n] = -1
+      .
+      if col > 1
+         g[node][node] += 1
+         g[node][node - 1] = -1
+      .
+      if col < n
+         g[node][node] += 1
+         g[node][node + 1] = -1
+      .
+   .
+.
+ar = 2
+ac = 2
+br = 7
+bc = 8
+a = ac + n * (ar - 1)
+b = bc + n * (br - 1)
+g[a][nn + 1] = -1
+g[b][nn + 1] = 1
+print "Nodes a: " & a & " b: " & b
+for j = 1 to nn
+   for i = j to nn
+      if g[i][j] <> 0 : break 1
+   .
+   if i = nn + 1
+      print "No solution"
+      return
+   .
+   for k = 1 to nn + 1
+      swap g[j][k] g[i][k]
+   .
+   y = g[j][j]
+   for k = 1 to nn + 1
+      g[j][k] = g[j][k] / y
+   .
+   for i = 1 to nn : if i <> j
+      y = -g[i][j]
+      for k = 1 to nn + 1
+         g[i][k] = g[i][k] + y * g[j][k]
+      .
+   .
+.
+print ""
+numfmt 0 14
+print "Resistance = " & abs (g[a][nn + 1] - g[b][nn + 1]) & " Ohm"

Task/Resistor-mesh/Fortran/resistor-mesh.f

@@ -0,0 +1,82 @@
+program resistor_mesh
+    implicit none
+    integer, parameter :: n = 10
+    integer, parameter :: nn = n * n
+    real(8) :: a(1:nn, 1:nn + 1)
+    integer :: node, row, col
+    integer :: ar, ac, anode, br, bc, bnode
+    integer :: r, j, i
+    real(8) :: y
+    real(8) :: resistance
+
+    a = 0.d0
+
+    node = 0
+    do row = 1, n
+        do col = 1, n
+            node = node + 1
+            if (row > 1) then
+                a(node, node) = a(node, node) + 1
+                a(node, node - n) = -1
+            end if
+            if (row < n) then
+                a(node, node) = a(node, node) + 1
+                a(node, node + n) = -1
+            end if
+            if (col > 1) then
+                a(node, node) = a(node, node) + 1
+                a(node, node - 1) = -1
+            end if
+            if (col < n) then
+                a(node, node) = a(node, node) + 1
+                a(node, node + 1) = -1
+            end if
+        end do
+    end do
+
+    ! These are columns and rows in the matrix to calculate the position of A and B
+    ! A is row 2 column 2
+    ! B is row 7 column 8
+    ar = 2
+    ac = 2
+    anode = ac + n * (ar - 1)
+    br = 7
+    bc = 8
+    bnode = bc + n * (br - 1)
+    a(anode, nn + 1) = -1
+    a(bnode, nn + 1) = 1
+
+    ! Solve linear system using Gauss-Jordan elimination
+    r = nn
+    do j = 1, r
+        ! Find first non-zero pivot
+        i = j
+        do while (i <= r .and. a(i, j) == 0.d0)
+            i = i + 1
+        end do
+        if (i > r) then
+            print *, "No solution!"
+            stop
+        end if
+        ! Swap rows j and i using array slicing
+        a([j, i], 1:r+1) = a([i, j], 1:r+1)
+
+        ! Scale pivot row using array operation
+        y = 1.d0 / a(j, j)
+        a(j, 1:r+1) = y * a(j, 1:r+1)
+
+        ! Eliminate in other rows using array broadcasting
+        do i = 1, r
+            if (i /= j) then
+                y = -a(i, j)
+                a(i, 1:r+1) = a(i, 1:r+1) + y * a(j, 1:r+1)
+            end if
+        end do
+    end do
+
+    resistance = abs(a(anode, nn + 1) - a(bnode, nn + 1))
+
+    print *
+    write(*, '(A,I0,A,I0,A,F15.10,A)') "Resistance between Nodes ", anode, " and ", bnode, " is ", resistance, " Ohms"
+
+end program resistor_mesh

Task/Resistor-mesh/Pluto/resistor-mesh.pluto

@@ -0,0 +1,77 @@
+class node
+    function __construct(public v, public fixed) end
+end
+
+local function set_boundary(m)
+    m[2][2].v = 1
+    m[2][2].fixed = 1
+    m[7][8].v = -1
+    m[7][8].fixed = -1
+end
+
+local function calc_diff(m, d, w, h)
+    local total = 0
+    for i = 1, h do
+        for j = 1, w do
+            local v = 0
+            local n = 0
+            if i > 1 then
+                v += m[i - 1][j].v
+                n += 1
+            end
+            if j > 1 then
+                v += m[i][j - 1].v
+                n += 1
+            end
+            if i < h then
+                v +=  m[i + 1][j].v
+                n += 1
+            end
+            if  j < w then
+                v += m[i][j + 1].v
+                n += 1
+            end
+            v = m[i][j].v - v / n
+            d[i][j].v = v
+            if m[i][j].fixed == 0 then total += v * v end
+        end
+    end
+    return total
+end
+
+local function iter(m, w, h)
+    local d = table.create(h)
+    for i = 1, h do
+        d[i] = table.create(w)
+        for j = 1, w  do d[i][j] = new node(0, 0) end
+    end
+    local cur = {0, 0, 0}
+    local diff = 1e10
+    while diff > 1e-24 do
+        set_boundary(m)
+        diff = calc_diff(m, d, w, h)
+        for i = 1, h do
+            for j = 1, w do m[i][j].v -= d[i][j].v end
+        end
+    end
+    for i = 1, h do
+        for j = 1, w do
+            local k = 0
+            if i != 1 then k += 1 end
+            if j != 1 then k += 1 end
+            if i < h  then k += 1 end
+            if j < w  then k += 1 end
+            cur[m[i][j].fixed + 2] += d[i][j].v * k
+        end
+    end
+    return (cur[3] - cur[1]) / 2
+end
+
+local S = 10
+local mesh = table.create(S)
+for i = 1, S do
+    mesh[i] = table.create(S)
+    for j = 1, S do mesh[i][j] = new node(0, 0) end
+end
+local r = 2 / iter(mesh, S, S)
+print($"R = {r}")