2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,6 +1,10 @@
|
|||
[[image:resistor-mesh.svg]]
|
||||
[[image:resistor-mesh.svg|300px||right]]
|
||||
|
||||
Given 10 × 10 grid nodes interconnected by 1Ω resistors as shown,
|
||||
find the resistance between point A and B.
|
||||
;Task:
|
||||
Given <big> 10×10 </big> grid nodes (as shown in the image) interconnected by <big> 1Ω </big> resistors as shown,
|
||||
<br>find the resistance between point '''A''' and '''B'''.
|
||||
|
||||
See also [[http://xkcd.com/356/]]
|
||||
|
||||
;See also:
|
||||
* (humor, nerd sniping) [http://xkcd.com/356/ xkcd.com cartoon]
|
||||
<br><br>
|
||||
|
|
|
|||
31
Task/Resistor-mesh/Haskell/resistor-mesh.hs
Normal file
31
Task/Resistor-mesh/Haskell/resistor-mesh.hs
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
{-# LANGUAGE ParallelListComp #-}
|
||||
import Numeric.LinearAlgebra (linearSolve, toDense, (!), flatten)
|
||||
import Data.Monoid ((<>), Sum(..))
|
||||
|
||||
rMesh n (ar, ac) (br, bc)
|
||||
| n < 2 = Nothing
|
||||
| any (\x -> x < 1 || x > n) [ar, ac, br, bc] = Nothing
|
||||
| otherwise = between a b <$> voltage
|
||||
where
|
||||
a = (ac - 1) + n*(ar - 1)
|
||||
b = (bc - 1) + n*(br - 1)
|
||||
|
||||
between x y v = abs (v ! a - v ! b)
|
||||
|
||||
voltage = flatten <$> linearSolve matrixG current
|
||||
|
||||
matrixG = toDense $ concat [ element row col node
|
||||
| row <- [1..n], col <- [1..n]
|
||||
| node <- [0..] ]
|
||||
|
||||
element row col node =
|
||||
let (Sum c, elements) =
|
||||
(Sum 1, [((node, node-n), -1)]) `when` (row > 1) <>
|
||||
(Sum 1, [((node, node+n), -1)]) `when` (row < n) <>
|
||||
(Sum 1, [((node, node-1), -1)]) `when` (col > 1) <>
|
||||
(Sum 1, [((node, node+1), -1)]) `when` (col < n)
|
||||
in [((node, node), c)] <> elements
|
||||
|
||||
x `when` p = if p then x else mempty
|
||||
|
||||
current = toDense [ ((a, 0), -1) , ((b, 0), 1) , ((n^2-1, 0), 0) ]
|
||||
|
|
@ -2,9 +2,11 @@ nodes=: 10 10 #: i. 100
|
|||
nodeA=: 1 1
|
||||
nodeB=: 6 7
|
||||
|
||||
NB. verb to pair up coordinates along a specific offset
|
||||
conn =: [: (#~ e.~/@|:~&0 2) ([ ,: +)"1
|
||||
ref =: ~. nodeA,nodes-.nodeB
|
||||
wiring=: /:~ ref i. ,/ nodes conn"2 1 (,-)=i.2
|
||||
Yii=: _1 _1 }. (* =@i.@#) #/.~ {."1 wiring
|
||||
Yij=: - _1 _1 }. 1:`(<"1@[)`]}&(+/~ 0*i.1+#ref) wiring
|
||||
Y=: Yii+Yij
|
||||
|
||||
ref =: ~. nodeA,nodes-.nodeB NB. all nodes, with A first and B omitted
|
||||
wiring=: /:~ ref i. ,/ nodes conn"2 1 (,-)=i.2 NB. connected pairs (indices into ref)
|
||||
Yii=: (* =@i.@#) #/.~ {."1 wiring NB. diagonal of Y represents connections to B
|
||||
Yij=: -1:`(<"1@[)`]}&(+/~ 0*i.1+#ref) wiring NB. off diagonal of Y represents wiring
|
||||
Y=: _1 _1 }. Yii+Yij
|
||||
|
|
|
|||
28
Task/Resistor-mesh/J/resistor-mesh-4.j
Normal file
28
Task/Resistor-mesh/J/resistor-mesh-4.j
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
3 3 #: i.9
|
||||
0 0
|
||||
0 1
|
||||
0 2
|
||||
1 0
|
||||
1 1
|
||||
1 2
|
||||
2 0
|
||||
2 1
|
||||
2 2
|
||||
(3 3 #: i.9) conn 0 1
|
||||
0 0
|
||||
0 1
|
||||
|
||||
0 1
|
||||
0 2
|
||||
|
||||
1 0
|
||||
1 1
|
||||
|
||||
1 1
|
||||
1 2
|
||||
|
||||
2 0
|
||||
2 1
|
||||
|
||||
2 1
|
||||
2 2
|
||||
|
|
@ -20,7 +20,7 @@ sub force-v(@v) {
|
|||
|
||||
sub calc_diff(@v, @d, Int $w, Int $h) {
|
||||
my $total = 0;
|
||||
for ^$h X ^$w -> $i, $j {
|
||||
for (flat ^$h X ^$w) -> $i, $j {
|
||||
my @neighbors = grep *.defined, @v[$i-1][$j], @v[$i][$j-1], @v[$i+1][$j], @v[$i][$j+1];
|
||||
my $v = [+] @neighbors;
|
||||
@d[$i][$j] = $v = @v[$i][$j] - $v / +@neighbors;
|
||||
|
|
@ -37,12 +37,12 @@ sub iter(@v, Int $w, Int $h) {
|
|||
while $diff > 1e-24 {
|
||||
force-v(@v);
|
||||
$diff = calc_diff(@v, @d, $w, $h);
|
||||
for ^$h X ^$w -> $i, $j {
|
||||
for (flat ^$h X ^$w) -> $i, $j {
|
||||
@v[$i][$j] -= @d[$i][$j];
|
||||
}
|
||||
}
|
||||
|
||||
for ^$h X ^$w -> $i, $j {
|
||||
for (flat ^$h X ^$w) -> $i, $j {
|
||||
@cur[ @fixed[$i][$j] + 1 ]
|
||||
+= @d[$i][$j] * (?$i + ?$j + ($i < $h - 1) + ($j < $w - 1));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,40 +1,46 @@
|
|||
/*REXX pgm calculates resistance between any 2 points on a resister grid*/
|
||||
numeric digits 20 /*use moderate digits (precision)*/
|
||||
minVal = (1'e-' || (digits()*2)) / 1 /*calculate the threshold min val*/
|
||||
if 1=='f1'x then ohms = 'ohms' /*EBCDIC machine? Use 'ohms'. */
|
||||
else ohms = 'ea'x /* ASCII machine? Use Greek Ω.*/
|
||||
parse arg high wide Arow Acol Brow Bcol .
|
||||
say 'minVal = ' format(minVal,,,,0) ; say
|
||||
say 'resistor mesh is of size: ' wide "wide, " high 'high.' ; say
|
||||
say 'point A is at (row,col): ' Arow","Acol
|
||||
say 'point B is at (row,col): ' Brow","Bcol
|
||||
/*REXX program calculates the resistance between any two points on a resister grid.*/
|
||||
numeric digits 20 /*use moderate decimal digs (precision)*/
|
||||
minVal = (1'e-' || (digits()*2)) / 1 /*calculate the threshold minimul value*/
|
||||
if 1=='f1'x then ohms = 'ohms' /*EBCDIC machine? Then use 'ohms'. */
|
||||
else ohms = 'ea'x /* ASCII " " " Greek Ω.*/
|
||||
parse arg high wide Arow Acol Brow Bcol . /*obtain optional arguments from the CL*/
|
||||
if high=='' | high=="," then high=10 /*Not specified? Then use the default.*/
|
||||
if wide=='' | wide=="," then wide=10 /* " " " " " " */
|
||||
if Arow=='' | Arow=="," then Arow= 2 /* " " " " " " */
|
||||
if Acol=='' | Acol=="," then Acol= 2 /* " " " " " " */
|
||||
if Brow=='' | Brow=="," then Brow= 7 /* " " " " " " */
|
||||
if Bcol=='' | Bcol=="," then Bcol= 8 /* " " " " " " */
|
||||
say ' minimum value = ' translate(format(minVal, , , , 0), "e", 'E'); say
|
||||
say ' resistor mesh is of size: ' wide "wide, " high 'high' ; say
|
||||
say ' point A is at (row,col): ' Arow"," Acol
|
||||
say ' point B is at (row,col): ' Brow"," Bcol
|
||||
@.=0; cell.=1
|
||||
do until $ <= minVal; $=0; v = 0
|
||||
do until $ <= minVal; v = 0
|
||||
@.Arow.Acol = +1 ; cell.Arow.Acol = 0
|
||||
@.Brow.Bcol = -1 ; cell.Brow.Bcol = 0
|
||||
|
||||
do i=1 for high; im=i-1; ip=i+1
|
||||
do j=1 for wide; jm=j-1; jp=j+1; n=0; v=0
|
||||
if i\==1 then do; v=v+@.im.j; n=n+1; end
|
||||
if j\==1 then do; v=v+@.i.jm; n=n+1; end
|
||||
if i<high then do; v=v+@.ip.j; n=n+1; end
|
||||
if j<wide then do; v=v+@.i.jp; n=n+1; end
|
||||
v=@.i.j-v/n; #.i.j=v; if cell.i.j then $=$+v*v
|
||||
end /*j*/
|
||||
end /*i*/
|
||||
do r=1 for High
|
||||
do c=1 for Wide; @.r.c = @.r.c - #.r.c
|
||||
end /*c*/
|
||||
end /*r*/
|
||||
$=0
|
||||
do i=1 for high; im=i - 1; ip=i + 1
|
||||
do j=1 for wide; jm=j - 1; jp=j + 1; n=0; v=0
|
||||
if i\==1 then do; v=v + @.im.j; n=n + 1; end
|
||||
if j\==1 then do; v=v + @.i.jm; n=n + 1; end
|
||||
if i<high then do; v=v + @.ip.j; n=n + 1; end
|
||||
if j<wide then do; v=v + @.i.jp; n=n + 1; end
|
||||
v=@.i.j - v/n; #.i.j=v; if cell.i.j then $=$ + v*v
|
||||
end /*j*/
|
||||
end /*i*/
|
||||
do r=1 for High
|
||||
do c=1 for Wide; @.r.c = @.r.c - #.r.c
|
||||
end /*c*/
|
||||
end /*r*/
|
||||
end /*until*/
|
||||
say
|
||||
Acur = #.Arow.Acol * sides(Arow,Acol)
|
||||
Bcur = #.Brow.Bcol * sides(Brow,Bcol)
|
||||
say 'resistance between point A and point B is: ' 4/(Acur-Bcur) ohms
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────sides subroutine────────────────────*/
|
||||
sides: parse arg i,j; !=0; if i\==1 & i\==high then !=!+2
|
||||
else !=!+1
|
||||
if j\==1 & j\==wide then !=!+2
|
||||
else !=!+1
|
||||
return !
|
||||
say ' resistance between point A and point B is: ' 4/(Acur-Bcur) ohms
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sides: parse arg row,col; z=0; if row\==1 & row\==high then z=z + 2
|
||||
else z=z + 1
|
||||
if col\==1 & col\==wide then z=z + 2
|
||||
else z=z + 1
|
||||
return z
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue