I need to generate a random array of indices, i.e., unique integers beginning from 1.
So far I have this sequential code in Fortran:
subroutine rperm3(N, p)
integer, intent(in) :: N
integer, dimension(:), intent(out) :: p
integer :: j, k, l
real :: u
call random_seed()
p = 0
do j=1,N
call random_number(u)
k = floor(j*u) + 1
p(j) = p(k)
p(k) = j
call sleep(2)
end do
end subroutine rperm3
In every iteration a random index gets generated, value from this index is assigned to the position of the current index and the old value is rewritten with the current index itself.
But is there any way to parallelize this with OpenMP? I see, that simply using !$omp parallel for is not possible, as we are using the previous values of the array, which don't have to be assigned at the time they're needed.
And if there is no way to do it, is there any other parallel algorithm doing the same thing, i.e. Generating a random array of unique integers from some range?
Related
I am writing a program which computes the LU decomposition of a matrix, with partial pivoting, and I would like the function to output several (2 or 3) matrices without running the program several times to output each one individually, which is a waste of time since it gets me everything I want in one run. Is there a way of doing this? For example, here is my function using Doolittle's algorithm, for square matrix which don't need pivoting. I want my output to be matrix l and u at once, but I know no means of doing that.
function lu_d(aa) result(l)
real, dimension (:,:) :: aa !input matrix
real, dimension (size(aa,1), size(aa,2)) :: a !keeping input variable intact
real, dimension (size(a,1), size(a,2)) :: l , u !lower and upper matrices
integer :: i,j,k !index
real :: s !auxiliar variable
a=aa
do j=1 , size(a,2)
u(1,j)=a(1,j)
end do
l(1,1)=1
do j=2, size(a,2)
l(1,j)=0
end do
do i=2, size(a,1)
l(i,1)=a(i,1)/u(1,1)
u(i,1)=0
do j=2, i-1
s=0
u(i,j)=0
do k=1, j-1
s=s+l(i,k)*u(k,j)
end do
l(i,j)=(a(i,j)-s)/u(j,j)
end do
l(i,i)=1
do j=i, size(a,2)
s=0
l(i,j)=0
do k=1, i-1
s=s+l(i,k)*u(k,j)
end do
u(i,j)=a(i,j)-s
end do
end do
end function
You could switch from using a function to using a subroutine. This way you can output values for multiple arrays in the arguments list. Additionally using the
INTENT definition when declaring variables in the subroutine, e.g.:
REAL,INTENT(IN)::a declares a and does not allow its values to be altered inside the subroutine/function
REAL,INTENT(OUT)::b declares b and disregards any values it has coming into the subroutine/function
REAL,INTENT(INOUT)::c this is the case by default, if you don't write anything.
I will assume you need the output to be l and u (rather than m), in which case the structure would look something like the one below. Note that l and m should either be declared in the main program and their size defined with respect to aa (as in the first case shown below) OR declared with an allocatable size in the main program, passed to the subroutine without being allocated and allocated within the subroutine (second example). The latter may require you to put the subroutine in a module so that the interfaces are handled properly.
First example:
SUBROUTINE lu_d(aa,l,m)
implicit none
real,intent(in):: a(:,:)
real,intent(out):: l(:,:), m(:,:)
integer:: i,j,k
real:: s
<operations>
RETURN
END SUBROUTINE lud_d
Second example:
SUBROUTINE lu_d(aa,l,m)
implicit none
real,intent(in):: a(:,:)
real,allocatable,intent(out):: l(:,:), m(:,:)
integer:: i,j,k,size_a1,size_a2
real:: s
size_a1=size(aa,1)
size_a2=size(aa,2)
allocate( l(size_a1,size_a2), m(size_a1,size_a2))
<operations>
RETURN
END SUBROUTINE lud_d
I am trying to generate a sequence of random numbers $\xi_i$ uniformly distributed in [0,1] using the built-in functions in Fortran. The sequence has to be reproducible so I want to seed the random number generator by the index $i$ (that is the position of $\xi_i$ in the sequence) rather than using the system clock for the seed. Below is my code:
module rand
contains
function generate_random(iseed) result(xi1)
!!
implicit none
integer, intent(in) :: iseed
integer, dimension(:), allocatable :: seed
integer :: i, j, n
real :: xi1
!!-generate a seed first
call random_seed(size = n)
allocate(seed(n))
seed = iseed * (/(i, i=1,n,1)/)
call random_seed(PUT = seed)
deallocate(seed)
call random_number(xi1)
!!
end function generate_random
end module rand
program test
use rand
implicit none
integer :: i, imax
imax=100
do i=1,imax
print *, generate_random(i)
enddo
end program test
However the result of this shown in the plot where $\xi_i$ is plotted vs. the index $i$ clearly has some pattern, so it is not so random after all. How to improve this, i.e., to make it "more random"?
I see you are seeding the generator before every call to random_number. This is a clear abuse and you are not supposed to do that!
You should seed the generator just once using some repeatable, but not too simple, number. Even when the clock is used as a seed it is used only once.
Often there is an additional step to increase the entropy of your time or your selected repeatable seed value. Notice how lcg() is used to increase entropy of the clock value in https://gcc.gnu.org/onlinedocs/gcc-4.8.5/gfortran/RANDOM_005fSEED.html#RANDOM_005fSEED
I am trying to compile the following simple code using Gfortran 4.7 from mac-ports (OS-X):
program main
implicit none
integer :: n = 1, clock, i
integer, dimension(1) :: iseed
! initialize the random number generator
call random_seed(size = n)
call system_clock(COUNT=clock)
iseed = clock + 37 * (/ (i - 1, i = 1, n) /)
! iseed = clock
! iseed = abs( mod((clock*181)*((1-83)*359), 104729) )
call random_seed(PUT = iseed)
end program main
and have this error:
gfortran-mp-4.7 tmp.f90
tmp.f90:17.23:
call random_seed(PUT = iseed)
1
Error: Size of 'put' argument of 'random_seed' intrinsic at (1) too small (1/12)
I don't use Fortran at all (I am a C++ guy), so would really appreciate if someone could help and make it working.
p.s. On a similar issue i found couple of forum posts, the current uncomment solution is similar to the one mentioned in this GCC bug report.
The one with abs is mentioned in this stack overflow post (added it without PID since i don't run in parallel anyway.
UPDATE:
the following works:
program main
implicit none
integer :: n = 12, clock, i
integer, dimension(:), allocatable :: iseed
! initialize the random number generator
allocate(iseed(n))
call random_seed(size = n)
call system_clock(COUNT=clock)
iseed = clock + 37 * [(i, i = 0,n-1)]
call random_seed(PUT = iseed)
end program main
To amplify somewhat on #Yossarian's comment, this
call random_seed(size = n)
returns, in n, the size of the rank 1 integer array that you have to use if you want to initialise the RNG. I'd suggest making iseed allocatable by changing its declaration to:
integer, dimension(:), allocatable :: iseed
then, after getting a value for n, allocate it:
allocate(iseed(n))
populate it with your favourite values, then put it.
You might be able to allocate and populate it in one statement like this:
allocate(iseed(n), source = clock + 37 * [(i, i = 0,n-1)])
I write might because this depends on how up to date your compiler is.
EDIT, after OP comment
No, you have not quite understood what I suggested.
Get a value for n by executing
call random_seed(size = n)
don't initialise n to 12.
Then allocate the array and populate it, either in one statement (using sourced allocation) or an allocate statement followed by an assignment.
In
allocate(iseed(n))
call random_seed(size = n)
the sequence of operations is incorrect. This sets iseed to have 12 elements (which is the value of n when the first statement is executed), and then sets n to the size of the array required by the RNG. So long as that is 12 you won't see any problems, but as soon as you port your code to another compiler, possibly even another version of the same compiler, you risk running into an RNG which requires an integer array of a different size. There is no need to hardwire a value into your code, so don't.
Now, I have a N*N matrix, mat. I also have
maskmat=(a(1),a(2),...,a(i),...a(N)).
a(i) equals 0 or 1.
If a(i)==1, the i-th colomn and i-th row of the matrix mat should be removed. If a(i)==0, we don't make any changes. Thus, we can get a submatrix accoring to the rule maskmat.
How to achieve it in Fortran?
One approach is to use vector subscripts where the subscripts come from the condition.
To get the indices of the rows and columns to be retained:
integer, allocatable :: idx(:)
idx = PACK([(i, i=1,N)], maskmat.eq.0)
and then for the matrix with bits removed
integer, allocatable :: submat(:,:)
submat = mat(idx, idx)
I have a data approximately a million record, each record have 6 floating point number. I want to find sets of records who share identical six values, and ideally I want to do it in Fortran since the rest of processing is done in Fortran. What would be the recommended approach for this? At the end i want to have mapping from original index to new index which is condensed version of these dataset without duplicate. Each record has other attributes and i am interested in aggregating those for groups based on the six attributes.
I tried to find those sets by exporting output as csv, import it into MS Access, then a query that finds those sets took 10 seconds or so to run. I wrote a code which does http://rosettacode.org/wiki/Remove_duplicate_elements#Fortran this ("linear search"?), but with million record it didnt complete after 10 min or so, i just abandoned this approach.
Approach I am thinking now is adapting ranking/sorting routine from slatec or orderpack which i assume do better than my crude code. But I am wondering if such things are already done and i can download, or if there is better approach for this.
EDIT:
I said "finding duplicate", but i actually need mapping from original data records to this reduced sets. I want to have mapping array like imap(1:n), where imap(1), imap(4), imap(5) has same values if those 6 float pt. values in original record 1, 4 and 5 are the same. Hope this is not too much a deviation from what I said originally...
This is what I ended up doing... I took code mrgrnk from ORDERPACK , and adapted for my purpose. The subroutine findmap below appears to be doing what I wanted it to do.
module fndmap
use m_mrgrnk, only:mrgrnk
implicit none
contains
subroutine findmap(stkprm, stkmap )
! given 2-d real array stkprm, find a mapping described below:
!
! (identical records are assigned with same index)
! stkmap(i) == stkmap(j) iff stkprm(:,i) == stkprm(:,j)
! (order conserved)
! if i < j and stkmap(i) /= stkmap(j), then stkmap(i) < stkmap(j)
! (new index are contiguous)
! set(stkmap) == {1,2,..,maxval(stkmap)}
!
real,dimension(:,:),intent(in) :: stkprm
integer,dimension(:), intent(out) :: stkmap
integer, dimension(size(stkprm,2)) :: irngt
integer, dimension(size(stkprm,2)) :: iwork
integer :: nrec, i, j
nrec = size(stkprm,2)
! find rank of each record, duplicate records kept
call ar_mrgrnk(stkprm, irngt)
! construct iwork array, which has index of original array where the
! record are identical, and the index is youguest
i = 1
do while(i<=nrec)
do j=i+1,nrec
if (any(stkprm(:,irngt(i))/=stkprm(:,irngt(j)))) exit
enddo
iwork(irngt(i:j-1)) = minval(irngt(i:j-1))
i = j
enddo
! now construct the map, where stkmap(i) shows index of new array
! with duplicated record eliminated, original order kept
j = 0
do i=1,nrec
if (i==iwork(i)) then
j = j+1
stkmap(i) = j
else
stkmap(i) = stkmap(iwork(i))
endif
enddo
end subroutine
recursive subroutine ar_mrgrnk(xdont, irngt)
! behaves like mrgrnk of ORDERPACK, except that array is 2-d
! each row are ranked by first field, then second and so on
real, dimension(:,:), intent(in) :: xdont
integer, dimension(:), intent(out), target :: irngt
integer, dimension(size(xdont,2)) :: iwork
integer :: nfld,nrec
integer :: i, j
integer, dimension(:), pointer :: ipt
nfld=size(xdont,1)
nrec=size(xdont,2)
! rank by the first field
call mrgrnk(xdont(1,:), irngt)
! if there's only one field, it's done
if (nfld==1) return
! examine the rank to see if multiple record has identical
! values for the first field
i = 1
do while(i<=nrec)
do j=i+1,nrec
if (xdont(1,irngt(i))/=xdont(1,irngt(j))) exit
enddo
! if one-to-one, do nothing
if (j-1>i) then
! if many-to-one,
! gather those many, and rank them
call ar_mrgrnk(xdont(2:,irngt(i:j-1)),iwork)
! rearrange my rank based on those fields to the right
ipt => irngt(i:j-1)
ipt = ipt(iwork(1:j-i))
endif
i = j
enddo
if(associated(ipt)) nullify(ipt)
end subroutine
end module