Related
I am working on implementing periodic boundary conditions in a finite element problem and I want to pair the nodes on boundary A with nodes on boundary B given a vector trans that lines boundary A up with boundary B. The nodes in boundary A are given in a list g1; in B they are g2. The node coordinates are looked up in mesh%nodes(:,nodenum).
I have decided to do this by creating a distance matrix for each node, which I realise is not the most efficient way, and to be honest I don't expect to save significant time by optimising this algorithm. The question is more academic.
I know that Fortran stores in column-major order, on the other hand, the array will be symmetric and when the array is completed I want to take column slices of it to find the nearest node. So the question is how should one populate this?
Here is my naive attempt.
subroutine autopair_nodes_in_groups(mesh, g1, g2, pairs, trans)
type(meshdata) :: mesh
integer(kind=sp) :: i,j
integer(kind=sp),dimension(:) :: g1,g2
integer(kind=sp),dimension(:,:) :: pairs
real(kind=dp) :: trans(3) !xyz translate
real(kind=dp) :: dist_mat(size(g1),size(g2))
real(kind=dp) :: p1(3), p2(3)
dist_mat = -1.0_wp
! make a distance matrix
do j=1,size(g2)
p2 = mesh%nodes(1:3,g2(j))-trans
do i=1,j
p1 = mesh%nodes(1:3,g1(i))
dist_mat(i,j) = norm2(p1-p2) !equivalent to norm2(n1pos+trans-n2pos)
if (i.ne.j) dist_mat(j,i) = dist_mat(i,j) !fill symmetry
end do
end do
! Remainder of routine to find nearest nodes
end subroutine autopair_nodes_in_groups
The problem as far as I can tell is that this is efficient in terms of memory access until one symmetrises the array.
To do a fast nearest-neighbor search, you should implement a tree structure that has search complexity O(log(N)) instead of looking at all point-to-point distances which are O(N^2).
Anyways, regarding symmetric matrix handling, you'll have:
! Storage size of a symmetric matrix
elemental integer function sym_size(N)
integer, intent(in) :: N
sym_size = (N*(N+1))/2
end function sym_size
! Compute pointer to an element in the symmetric matrix array
elemental integer function sym_ptr(N,i,j)
integer, intent(in) :: N,i,j
integer :: irow,jcol
! Column-major storage
irow = merge(i,j,i>=j)
jcol = merge(j,i,i>=j)
! Skip previous columns
sym_ptr = N*(jcol-1)-((jcol-1)*(jcol-2))/2
! Locate in current column
sym_ptr = sym_ptr + (irow-jcol+1)
end function sym_ptr
then do your job:
N = size(g2)
allocate(sym_dist_mat(sym_size(N)))
do j=1,size(g2)
p2 = mesh%nodes(1:3,g2(j))-trans
do i=j,size(g2)
p1 = mesh%nodes(1:3,g1(i))
sym_dist_mat(sym_ptr(N,i,j)) = norm2(p1-p2)
end do
end do
The minloc function should then look something like this (untested):
! minloc-style
pure function symmetric_minloc(N,matrix,dim) result(loc_min)
integer, intent(in) :: N
real(8), intent(in) :: matrix(N*(N+1)/2)
integer, intent(in) :: dim
real(8) :: dim_min(N),min_column
integer :: loc_min(N)
select case (dim)
! Row/column does not matter: it's symmetric!
case (1,2)
dim_min = huge(dim_row)
loc_min = -1
ptr = 0
do j=1,N
! Diagonal element m(j,j)
ptr=ptr+1
min_column = matrix(ptr)
if (min_column<=dim_min(j)) then
loc_min(j) = j
dim_min(j) = min_column
end if
! Lower-diagonal part at column j
do i=j+1,N
ptr=ptr+1
! Applies to both this column,
if (matrix(ptr)<=dim_min(j)) then
loc_min(j) = i
dim_min(j) = matrix(ptr)
end if
! And the i-th column
if (matrix(ptr)<=dim_min(i)) then
loc_min(i) = j
dim_min(i) = matrix(ptr)
end if
end do
end do
case default
! Invalid dimension
loc_min = -1
end select
end function symmetric_minloc
I want to sort the distance. for example r(1,3)< r(1,2) then r(1,3) should come first .
input file of dist.txt like this
1,2,3.5
1,3,0.5
1,4,4.7
1,5,4,5
output file of sort.txtshould be like this
1, 3, 0.5
1,2, 3.5
1,5, 4.5
1,4,4.7
here first column is i and second column j then third column is r(i,j).
So here I have wrote down one code in fortran which can do sorting for 2D array. But that code has problem If some can fix. I will be so glad.
program sort
implicit none
character CN*8,O*7
integer i,m,k,j
integer n,nmax,ind,num
integer L
parameter (n=3,m=n**2-n)
double precision xbox,rq
parameter (nmax=3091,nconf=1)
double precision atom(nmax),id(nmax),ox(nmax),oy(nmax),oz(nmax)
double precision xij,yij,zij,rij,t
double precision a(n,n)
double precision r(n,n)
open(unit=10,status='unknown',file='a.gro')
do i=1,n
read(10,'(A8,A7,1i5,3f8.3)')CN,O,num,ox(i),oy(i),oz(i)
enddo
read(10,*)xbox ! read the xbox for PBC
t=0.0d0
open(unit=3,file='dist.txt')
open(unit=4,file='2d_1d_dist.txt')
open(unit=5,file='sort.txt')
do i=1,n
do j=1,n
if(i .ne. j) then
xij=ox(i)-ox(j)
yij=oy(i)-oy(j)
zij=oz(i)-oz(j)
xij=xij - nint(xij/xbox)*xbox
yij=yij - nint(yij/xbox)*xbox
zij=zij - nint(zij/xbox)*xbox
r(i,j)=dsqrt(xij**2 + yij**2 + zij**2) !distance calculation
write(3,'(i3,2x,i3,4x,f17.15)') i,j, r(i,j)
endif
enddo
enddo
t=0.0d0
do i = 1,m-2
do j = i+1,m-1
if(i .ne. j) then
write(4,*) r(i,j)," ", r(i,j+1)
if (r(i,j) .gt. r(i,j+1)) then
t=r(i,j)
r(i,j)=r(i,j+1)
r(i,j+1)=t
endif
endif
write(5,*) r(i,j)
enddo
enddo
END program sort
Please look at the code.
The first thing I think of when I encounter such a situation is: Do I need to write my own program?
Quick answer here is no: Linux/Unix has the sort command that works just fine:
sort -t, -k3 -g dist.txt
-t, tells sort that the field separator is the comma,
-k3 tells it to sort according to the 3rd field,
-g tells it to use a general numeric sort
If I needed to do that using Fortran, I would probably read i, j, and r into separate 1-D arrays, then write a sorting routine that not only sorts r, but also returns the order. Then you can easily rearrange the i and j arrays to correspond to the same order. See this example:
program sort_r
implicit none
integer :: u
integer, parameter :: num_of_elements = 4
integer :: i(num_of_elements), j(num_of_elements)
real :: r(num_of_elements)
integer :: order(num_of_elements)
integer :: ii
open(newunit=u, file='dist.txt')
do ii=1, num_of_elements
read(u, *) i(ii), j(ii), r(ii)
end do
close(u)
order = [(ii, ii=1, num_of_elements)]
call qsort(r, first=1, last=num_of_elements, order=order)
i(:) = i(order)
j(:) = j(order)
do ii = 1, num_of_elements
write(*,'(I0,",",I0,",",F3.1)') i(ii), j(ii), r(ii)
end do
contains
recursive subroutine qsort(a, first, last, order)
real, intent(inout) :: a(:)
integer, intent(in) :: first, last
integer, intent(inout) :: order(:)
! Prerequsits:
! first >= lbound(a, 1)
! last <= lbound(a, 1)
! lbound(a, 1) == lbound(order, 1)
! ubound(a, 1) == ubound(order, 1)
real :: pivot
integer :: i, j
if (.not. first < last) return ! less than 2 elements
! Get pivot from middle to beginning of subarray.
call swap(a, first, (first+last)/2, order)
pivot = a(first)
i = first + 1
j = last
do while (j >= i)
! move up from left while elements are smaller than pivot
do while (a(i) < pivot)
i = i + 1
end do
! move down from right while elements are larger than pivot
do while (a(j) > pivot)
j = j - 1
end do
! If we moved past the other index, exit loop
if (j < i) exit
! We have found a larger than pivot element left of a smaller than
! pivot element to the right, swap the two, move the indices to next
call swap(a,i,j,order)
i = i + 1
j = j - 1
end do
! Move pivot back to centre
call swap(a,first,j, order)
call qsort(a,first=first,last=j-1,order=order)
call qsort(a,first=i,last=last,order=order)
end subroutine qsort
subroutine swap(a, i, j, order)
real, intent(inout) :: a(:)
integer, intent(in) :: i, j
integer, intent(inout) :: order(:)
real :: t
integer :: k
t = a(i)
a(i) = a(j)
a(j) = t
k = order(i)
order(i) = order(j)
order(j) = k
end subroutine swap
end program sort_r
I've never asked a question here, so please let me know if I am describing my problem enough.
I'm pretty new at Fortran and I wanted to create a recursive subroutine that would compute each square of a 3 x 3 matrix. If you are not familiar with convolution, this is a good resource: http://songho.ca/dsp/convolution/convolution2d_example.html.
I used the same values in this example to make sure I was doing it right.
The purpose of the program is to have the recursive subroutine called in the middle of two do loops (indexes both go from [0,2]). When the recusive function is called, it will find the sum of all the products of one square of the output matrix. The loops will call it 9 times to ensure that every square's value has been calculated to produce the desired output. Well, after much editing on paper, I thought that I had a pretty good idea that the subroutine would work and it seems that only the first square (0,0) was able to get its answer, -13.
I believe my problem has to do with the assignments in the subroutine. I want to continue calling the next 'temp' value to add it to the total, which will be returned to the program calling it.
Depending on the current i and j values, there might not be any multiplication needed for every turn through the recursive method, so I wanted the subroutine to find a way to continue adding temp if that was the case.
program conprac
implicit none
integer, dimension(0:2,0:2) :: mat1(0:2,0:2) = reshape((/1,4,7,2,5,8,3,6,9/),(/3,3/))
integer, dimension(0:2,0:2) :: totals(0:2,0:2) = 0
integer, dimension(2,2) :: kernal(0:2,0:2) = reshape((/1,0,-1,2,0,-2,1,0,-1/),(/3,3/))
integer :: i=0, j=0, this_total=0, total=0, m=0, n=0, k=0
!do m = 0,0
!do n = 0,1
total = 0
call calc(kernal, mat1, i, j, m, n, this_total, total)
totals(m,n) = total
!end do
!end do
write(*,*) "totals(0,0): ", totals(0,0) !-13
!write(*,*) "totals(0,1): ", totals(0,1) !-20
end program conprac
recursive subroutine calc(kernal, mat, i, j, addToi, addToj, this_total, total)
implicit none
!declare calling parameter types and definitions
!to calculate with
integer, intent(in), dimension(0:2,0:2) :: kernal, mat
integer, intent(in) :: addToi, addToj
integer, intent(out) :: i, j, this_total
!to calculate
integer, intent(out) :: total
!temp variable
integer :: temp
if (i <= 2) then
if (j > 2) then
i = i + 1
j = 0
end if
if ((i + addToi) - 1 < 0 .or. (j + addToj) - 1 < 0 .or. (i + addToi) - 1 > 2 .or. (j + addToj) - 1 > 2) then
j = j+1
call calc(kernal, mat, i, j, addToi, addToj, this_total, temp)
total = total + temp
write(*,*) "total1: ", total
else
this_total = kernal(i,j) * mat((i + addToi) - 1, (j + addToj) - 1)
j = j+1
call calc(kernal, mat, i, j, addToi, addToj, this_total, temp)
total = this_total + temp
write(*,*) "total2: ", total
end if
end if
end subroutine calc
As of right now, the do loops are commented out so I can test one value at a time up where m, n are initialized.
The parameters for the subroutine are: kernal and mat being the 2 matricies, i and j both starting at 0 when the subroutine is called, m and n values being what is added to i and j respectively to make sure that the kernal is shifted and not calculating in the same spot for all 9 squares. this_total is a holder for the product of an overlapping square to be added to the returning value total, and total is the value returned and will be sent to the totals array in the program. For the first one, it would be at index (m,n), or (0,0).
These are the outputs for the first square in totals:
m=0,n=0
I'm taking a course in Numerical Methods and I've been requested to implement the famous Monte Carlo algorithm to find pi that you can find here.
I had no difficulties in writing the code with an arbitrary number of trials:
REAL(8) FUNCTION distance(xvalue, yvalue) RESULT(dist)
IMPLICIT NONE
REAL(8), INTENT(in) :: xvalue, yvalue
dist = SQRT(xvalue**2 + yvalue**2)
END FUNCTION distance
PROGRAM ass2
IMPLICIT NONE
INTEGER, DIMENSION(1) :: SEED
REAL(8) :: p, x, y
REAL(8), EXTERNAL :: distance
REAL(8) :: pi_last, pi
INTEGER :: npc, npt, i
npc = 0
npt = 0
pi = 1.0
SEED(1) = 12345
CALL RANDOM_SEED
DO i=1, 1000000000
CALL RANDOM_NUMBER(p)
x = p
CALL RANDOM_NUMBER(p)
y = p
npt = npt + 1
IF (distance(x, y) < 1.0) THEN
npc = npc + 1
END IF
pi_last = pi
pi = 4.0*(npc*1.0)/(npt*1.0)
END DO
PRINT*, 'Pi:', pi
END PROGRAM ass2
I noticed that it converges approximately as sqrt(N of steps). Now I have to stop the algorithm at a certain precision, so I created an endless DO loop with an EXIT inside an IF statement:
REAL(8) FUNCTION distance(xvalue, yvalue) RESULT(dist)
IMPLICIT NONE
REAL(8), INTENT(in) :: xvalue, yvalue
dist = SQRT(xvalue**2 + yvalue**2)
END FUNCTION distance
PROGRAM ass2
IMPLICIT NONE
INTEGER, DIMENSION(1) :: SEED
REAL(8) :: p, x, y
REAL(8), EXTERNAL :: distance
REAL(8) :: pi_last, pi
INTEGER :: npc, npt, i
npc = 0
npt = 0
pi = 1.0
SEED(1) = 12345
CALL RANDOM_SEED
DO
CALL RANDOM_NUMBER(p)
x = p
CALL RANDOM_NUMBER(p)
y = p
npt = npt + 1
IF (distance(x, y) < 1.0) THEN
npc = npc + 1
END IF
pi_last = pi
pi = 4.0*(npc*1.0)/(npt*1.0)
IF ( ABS(pi - pi_last) < 0.000001 .AND. pi - pi_last /= 0) THEN
EXIT
END IF
END DO
PRINT*, 'Pi:', pi
END PROGRAM ass2
The problem is that this returns a value of pi that doesn't have the precision I asked for. I get the logic behind it: if I get two consecutive values far from pi but close to each other, the condition will be satisfied and the program will exit the DO statement. The problem is that I don't know how to modify it in order to get a precision decided by me. So the question is:
How do I implement this algorithm in a manner such that I can decide the precision of pi in output?
EDIT: Ok, I implemented both of your solutions and they work, but only for 10^(-1), 10^(-3) and 10^(-5). I think it's a problem of the pseudorandom sequence if for 10^(-2) and 10^(-4) it returns an incorrect value of pi.
It's not enough to specify a desired precision -- you also need to allow some chance that the precision target is not met. Then you can solve for the number of trials in (e.g.) Hoeffding's inequality to meet your desired precision with the desired probability (as you've observed, n needs to be about the square root of one over the precision to succeed with constant probability).
In an ideal setting (perfect random number generator generating real numbers in the mathematical sense) your variable npc is a random variable with binomial distribution B(n,π/4) where n is npt from your program. Its expected value is n*π/4, so you correctly compute the approximation of π as pi=4*npc/npt. Now this approximation can take all values from 0 to 4 no matter how many loop iterations you calculate, because npc can take all values from 0 to npt. For a range around π you can only give a probability (using c as shorthand for npc; P denotes the probability of an event):
P(|pi - π| < d) = P(-d < pi - π < d) = P(-d < 4*c/n - π < d) = P(n*(π-d)/4 < c < n*(π+d)/4) =
= P(c < n*(π+d)/4) - P(c < n*(π-d)/4) ~=
~= FN(n*(π+d)/4) -
FN(n*(π-d)/4) = 2F(d*√(n/(π(4-π))))-1
where FN is the probability function of the normal distribution N(nπ/4;nπ/4(1-π/4)) which approximates the above binomial distribution and F is the probability function of the standard normal distribution. Now given a deviation d and a probability p you can compute n s.t. the last term does not go below p:
n = ceil(π(4-π)(F-1((p+1)/2)/d)^2))
Then with n loop iterations you can compute the approximation pi of π to a desired precision with given probability. If we want to achieve a probability of p=99%, then the above formula simplifies to
n ~= 17.89/d2 ,
so for precision d=0.0001 roughly n=1.789E9 iterations are necessary!
Note: since a computer cannot meet the above ideal setting there is also a (theoretical) limit on the precision you can reach with this algorithm. There are only finitely many floating point numbers representable in a computer, so your points (x,y) lie on a kind of grid. The best approximation of π that can be computed with this algorithm boils down to performing your loop over all grid points in [0,1]x[0,1]. The good old C-function rand() has a resolution of 31 bits (at least in the VS stdlib). So it does not make sense to compute more than n=312 points, which gives a maximal precision of √(17.89/n) = 1.97E-9 when asking for 99% correctness.
I have a matrix, matrix_logical(50000,100000), that is a sparse logical matrix (a lot of falses, some true). I have to produce a matrix, intersect(50000,50000), that, for each pair, i,j, of rows of matrix_logical(50000,100000), stores the number of columns for which rows i and j have both "true" as the value.
Here is the code I wrote:
% store in advance the nonzeros cols
for i=1:50000
nonzeros{i} = num2cell(find(matrix_logical(i,:)));
end
intersect = zeros(50000,50000);
for i=1:49999
a = cell2mat(nonzeros{i});
for j=(i+1):50000
b = cell2mat(nonzeros{j});
intersect(i,j) = numel(intersect(a,b));
end
end
Is it possible to further increase the performance? It takes too long to compute the matrix. I would like to avoid the double loop in the second part of the code.
matrix_logical is sparse, but it is not saved as sparse in MATLAB because otherwise the performance become the worst possible.
Since the [i,j] entry counts the number of non zero elements in the element-wise multiplication of rows i and j, you can do it by multiplying matrix_logical with its transpose (you should convert to numeric data type first, e.g matrix_logical = single(matrix_logical)):
inter = matrix_logical * matrix_logical';
And it works both for sparse or full representation.
EDIT
In order to calculate numel(intersect(a,b))/numel(union(a,b)); (as asked in your comment), you can use the fact that for two sets a and b, you have
length(union(a,b)) = length(a) + length(b) - length(intersect(a,b))
so, you can do the following:
unLen = sum(matrix_logical,2);
tmp = repmat(unLen, 1, length(unLen)) + repmat(unLen', length(unLen), 1);
inter = matrix_logical * matrix_logical';
inter = inter ./ (tmp-inter);
If I understood you correctly, you want a logical AND of the rows:
intersct = zeros(50000, 50000)
for ii = 1:49999
for jj = ii:50000
intersct(ii, jj) = sum(matrix_logical(ii, :) & matrix_logical(jj, :));
intersct(jj, ii) = intersct(ii, jj);
end
end
Doesn't avoid the double loop, but at least works without the first loop and the slow find command.
Elaborating on my comment, here is a distance function suitable for pdist()
function out = distfun(xi,xj)
out = zeros(size(xj,1),1);
for i=1:size(xj,1)
out(i) = sum(sum( xi & xj(i,:) )) / sum(sum( xi | xj(i,:) ));
end
In my experience, sum(sum()) is faster for logicals than nnz(), thus its appearance above.
You would also need to use squareform() to reshape the output of pdist() appropriately:
squareform(pdist(martrix_logical,#distfun));
Note that pdist() includes a 'jaccard' distance measure, but it is actually the Jaccard distance and not the Jaccard index or coefficient, which is the value you are apparently after.