perturb(3f) - [M_orderpack:PERMUTATION] generate a random permutation
of an array leaving elements close to initial locations
Subroutine Perturb (INOUTVALS, CLOSENESS)
${TYPE} (kind=${KIND}), Intent (InOut) :: INOUTVALS(:)
Real, Intent (In) :: CLOSENESS
Where ${TYPE}(kind=${KIND}) may be
o Real(kind=real32)
o Real(kind=real64)
o Integer(kind=int32)
o Character(kind=selected_char_kind("DEFAULT"),len=*)
Shuffle the array INOUTVALS randomly, leaving elements close to their initial locations.
Nearbyness is controlled by CLOSENESS. The relative proportion of initial order and random order is defined as 1-CLOSENESS / CLOSENESS, thus when CLOSENESS = 0, there is no change in the order whereas the new order is fully random when CLOSENESS = 1.
Note this differs from adding random noise to the values. The original values remain unchanged, their order is just perturbed.
Internally, the routine creates a real array of the indices of INOUTVALS() perturbed by random values that are based on the size of CLOSENESS. The new array is then ranked using RANK(3f) and the resulting index is used to permute the input array.
INOUTVALS Array of values to perturb.
CLOSENESS Proportion of closeness, constrained to the range 0.0(no
change) to 1.0(fully random).
Sample program:
program demo_perturb
! generate a random perturbation of an array
use M_orderpack, only : perturb
implicit none
character(len=*),parameter :: g='(*(g0,1x))'
integer,allocatable :: xout(:,:)
integer :: isz, i
isz=200
! randomly perturb location of values
!
! make an array with three initially identical rows of
! values perturbed by different amounts
if(allocated(xout))deallocate(xout)
allocate(xout(3,isz))
xout(1,:)=[(i,i=isz,1,-1)]*10
xout(2,:)=xout(1,:)
xout(3,:)=xout(1,:)
! perturb each row a different amount
call perturb(xout(1,:),0.0)
call perturb(xout(2,:),0.1)
call perturb(xout(3,:),1.0)
! show values
write(*,'(a)')'count unchanged perturbed random'
do i=1,size(xout,dim=2)
write(*,'(*(i8,1x))')i,xout(:,i)
enddo
char: block
character(len=:),allocatable :: cdont(:)
cdont=[character(len=20) :: 'a', 'be', 'car', 'dam','fan','gas','egg']
isz=size(cdont)
write(*,g)'Original.................:',(trim(cdont(i)),i=1,isz)
call perturb(cdont,1.0)
write(*,g)'Perturbed ...............:',(trim(cdont(i)),i=1,isz)
write(*,g)
endblock char
end program demo_perturb
Results:
count unchanged perturbed random
1 2000 1980 80
2 1990 1990 580
3 1980 1890 1690
4 1970 1900 1340
5 1960 1920 1260
6 1950 1950 1220
7 1940 1880 160
8 1930 1960 1620
9 1920 1860 540
10 1910 1930 1300
11 1900 1940 1190
. . . .
. . . .
. . . .
. . . .
189 120 80 1200
190 110 150 800
191 100 120 1430
192 90 170 1410
193 80 140 370
194 70 90 1720
195 60 10 830
196 50 100 1670
197 40 20 470
198 30 70 1020
199 20 60 1540
200 10 30 1810
Original.................: a be car dam fan gas egg
Perturbed ...............: a be gas dam fan car egg
Michel Olagnon, 2000-2012
John Urban, 2022.04.16
CC0-1.0
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=real64), | intent(inout), | Dimension (:) | :: | INOUTVALS | ||
| real, | intent(in) | :: | CLOSENESS |
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=real32), | intent(inout), | Dimension (:) | :: | INOUTVALS | ||
| real, | intent(in) | :: | CLOSENESS |
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer(kind=int32), | intent(inout), | Dimension (:) | :: | INOUTVALS | ||
| real, | intent(in) | :: | CLOSENESS |
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(kind=f_char, len=*), | intent(inout), | Dimension (:) | :: | INOUTVALS | ||
| real, | intent(in) | :: | CLOSENESS |