I am trying to port this pseudocode into NetLogo, and finding it difficult because NetLogo requires a literal to be used as a list index, rather than allowing a variable containing the index value (such as index in the code below) to be used. I tried the array extension, and it likewise doesn't allow a variable to be used for an array index.
Basically, my goal is to
identify elements that differ in the lists of two agents
randomly select one of the elements that will change for both agents.
Any ideas of how to do this in NetLogo?
; Have an agent interact with some another culture if they
; are similar enough that the agent accepts the influence
; and if the event passes some degree of randomness. In
; ’ jump ’ mode we take the exact culture value of the other
; culture , in ’ shift ’ mode we shift closer to that culture.
function interactWith Culture ( agent , other_culture ) {
similarity = calculateSimilarity ( agent. culture , other_culture )
chance = uniform Random ( min = 0 , max = 1)
if ( similarity > minimum_similarity and chance < similarity ) {
index = findDifferingElement (agent. culture , other_culture )
if ( interaction_method == ’ jump ’) {
agent. culture[ index ] = other_culture [ index ]
} else {
difference = agent. culture[ index ] - other_culture [ index ]
agent. culture[ index ] = agent. culture[ index ] -
difference * shift_degree
}
}
}
I have a function of some variables, which will yield an array consisted of both negative and positive values (Real). But since only positive values are physically meaningful to me, I want to set all negative values inside the array to be zero.
I have provided my code related to this function below:
The reason I declare a temporary variable 'res' is that I try to build in an IF-ELSE in the position I marked in code as follows:
If (res >= 0) Then
result = res
Else
result = 0
End If
But the error says a scalar-valued expression for S_A if required here.
If instead of res we use res(il,ir) is used,
If (res(il,ir) >= 0) Then
result(il,ir) = res(il,ir)
Else
result = 0
End If
the error says error #6351: The number of subscripts is incorrect.
Is there any way to implement this idea?
Function somefunction(x,y,il,ir) Result(result)
!! ---- begin of declaration ---------------------------
Implicit None
!! boundary indices
Integer, Intent ( in ) :: il,ir
!! the vars
Real ( kind = rk ), Intent ( in ), Dimension ( il:ir ) :: x,y
!! the result
Real ( kind = rk ), Dimension ( il:ir ) :: result
!! temp vars
Real ( kind = rk ), Dimension ( il:ir ) :: res
!! loop index
Integer :: i
!! ---- end of declaration -----------------------------
res = x+y
SA = S_A
!!IF-ELSE!!
End Function somefunction
If you want to have an if statement element wise on an array, you should use the where statement, for example:
program min0
implicit none
real :: res(5, 5), result(5, 5)
call random_number(res)
res=res-0.5
print '(5(F5.2,X))', res
where (res>=0)
result = res
elsewhere
result = 0
end where
print *, '---------------------------------------'
print '(5(F5.2,X))', result
end program min0
I don't know why you get a subscript error, it might help if you tell us which line of the code the error occurs. But of course in the second code, you update a single element of result if res is larger than 0, but set the whole array result to 0 if it isn't. This is almost certainly not what you want.
Cheers
The function appears to take in X and Y dimensioned from (il:if)... say from (3:6), so a vector. However the index later says (il,ir) which means it is a 2 dimensional array.
WHERE seems like a good choice. Another would be a logical MASK to associate the where-positions. It makes sense is PACK and unpack are usd,
Why even say what size the vectors are?
ELEMENTAL Function somefunction(x,y) Result(Res)
!! ---- begin of declaration ---------------------------
Implicit None
Real ( kind = rk ), Intent (IN), Dimension (:) :: x,y
!! the result
Real ( kind = rk ), Dimension ( il:ir ) :: res
!! loop index
Integer :: i
!! ---- end of declaration -----------------------------
res = x+y
WHERE res <= 0
Res = 0
ENDWHERE
!!IF-ELSE!!
End Function somefunction
Then on the calling side... call the function over the range of undecided you want.
Z(1:5) = somefunction(X(1:5),Y(1:5))
I have to develop a linear interpolation program, but keep getting these errors.
Here is the source code:
!Interpolation program for exercise 1 of portfolio
PROGRAM interpolation
IMPLICIT NONE
!Specify table 1 for test of function linter
REAL, DIMENSION (5):: x,f
!Specify results for table 1 at intervals of 1
REAL, DIMENSION (10):: xd, fd
!Specify table 2 to gain linter results
REAL, DIMENSION (9):: xx,ff
!Specify results for table 2 of at intervals of 0.25
REAL, DIMENSION (36):: xxd, ffd
INTEGER :: i, j
!Write values for table dimensions
!Enter x values for Table 1
x(1)=-4.0
x(2)=-2.0
x(3)=0.0
x(4)=2.0
x(5)=4.0
f(1)=28.0
f(2)=11.0
f(3)=2.0
f(4)=1.0
f(5)=8.0
xd(1)=-4.0
xd(2)=-3.0
xd(3)=-1.0
xd(4)=0.0
xd(5)=1.0
xd(6)=2.0
xd(7)=3.0
xd(9)=4.0
!Print Table 1 Array
PRINT *,"Entered Table Values are", x,f
PRINT *,"Interpolation Results for Table 1", xd, fd
END PROGRAM
SUBROUTINE interpol(x,f, xd,fd)
DO i=1, 5
DO j=1, 5
IF (x(j) < xd(i) .AND. xd(i) <= x(j+1)) THEN
fd=linterp (x(j),x(j+1),f(j))
END IF
END DO
END DO
END SUBROUTINE interpol
!Linear Interpolation function
FUNCTION linterp(x(i),x(i+1),f(i),f(i+1),x)
linterp=f(i)+((x-x(i))/(x(i+1)-x(i)))*(f(i+1)-f(i))
END FUNCTION
With it giving these errors;
lin.f90:55:18: Error: Expected formal argument list in function definition at (1)
lin.f90:56:19:
linterp=f(i)+((x-x(i))/(x(i+1)-x(i)))*(f(i+1)-f(i))
1
Error: Expected a right parenthesis in expression at (1)
lin.f90:57:3:
END FUNCTION
1
Error: Expecting END PROGRAM statement at (1)
Could anyone please point me in the right direction?
It is exactly what the compiler complains about: you are missing a right parenthesis.
Either remove the superfluous left (:
linterp=f(i)+ ( x-x(i) ) / ( x(i+1)-x(i) )* ( f(i+1)-f(i) )
or add another )
linterp=f(i)+ ( (x-x(i)) ) / ( x(i+1)-x(i) )* ( f(i+1)-f(i) )
Note that I removed another miss-placed ) in the middle part.
Apart from that, your function declaration is broken! You cannot have x(i) in the declaration!
Try:
real FUNCTION linterp(xI,xIp1,fI,fIp1,x)
implicit none
real, intent(in) :: xI,xIp1,fI,fIp1,x
linterp = fI + (x-xI)/(xIp1-xI)*(fIp1-fI)
END FUNCTION
Alternatively, you can provide the whole arrays (including its length N) and the current index:
real FUNCTION linterp(x,f,N,i,xx)
implicit none
integer, intent(in) :: N
real, intent(in) :: x(N), f(N), xx
integer, intent(in) :: i
linterp = f(i) + (xx-x(i))/( x(i+1)-x(i) )*( f(i+1)-f(i) )
END FUNCTION
In addition to everything Alexander said. You also need to make sure that you have the same amount of inputs in your function declaration as you do when you call it:
fd=linterp (x(j),x(j+1),f(j))
has two less inputs than in your function declaration:
FUNCTION linterp(x(i),x(i+1),f(i),f(i+1),x)
Also, don't forget to add an index to fd, either i or j:
fd(i)=linterp (x(j),x(j+1),f(j))
otherwise you're replacing the entire array with the linterp result every time.
So I'm trying to come up with a clever way to make this program read a catalog and take anything falling within specific spatial "grid" boxes and average the data in that box together. I'll paste my horrid attempt below and hopefully you'll see what I'm trying to do. I can't get the program to work correctly (it gets stuck in a loop somewhere that I haven't debugged), and before I bang my head against it anymore I want to know if this looks like a logical set of operations for what I'm looking to do, or if there is a better way to accomplish this.
Edit: To clarify, the argument section is for the trimming parameters---"lmin lmax bmin bmax" set the overall frame, and "deg" sets the square-degree increments.
program redgrid
implicit none
! Variable declarations and settings:
integer :: ncrt, c, i, j, k, count, n, iarg, D, db, cn
real :: dsun, pma, pmd, epma, epmd, ra, dec, degbin
real :: V, Per, Amp, FeH, EBV, Dm, Fi, FeHav, EBVav
real :: lmin, lmax, bmin, bmax, l, b, deg, lbin, bbin
real :: bbinmax, bbinmin, lbinmax, lbinmin
character(len=60) :: infile, outfile, word, name
parameter(D=20000)
dimension :: EBV(D), FeH(D), lbinmax(D), bbinmax(D)
dimension :: bbinmin(D), lbinmin(D)
103 format(1x,i6,4x,f6.2,4x,f6.2,4x,f7.2,3x,f6.2,4x,f5.2,4x,f5.2,4x,f5.2,4x,f6.4)
3 continue
iarg=iargc()
if(iarg.lt.7) then
print*, 'Usage: redgrid infile outfile lmin lmax bmin bmax square_deg'
stop
endif
call getarg(1, infile)
call getarg(2, outfile)
call getarg(3, word)
read(word,*) lmin
call getarg(4, word)
read(word,*) lmax
call getarg(5, word)
read(word,*) bmin
call getarg(6, word)
read(word,*) bmax
call getarg(7, word)
read(word,*) deg
open(unit=1,file=infile,status='old',err=3)
open(unit=2,file=outfile,status='unknown')
write(2,*)"| l center | b center | [Fe/H] avg | E(B-V) avg | "
FeHav = 0.0
EBVav = 0.0
lbinmin(1) = lmin
bbinmin(1) = bmin
degbin = (bmax-bmin)/deg
db = NINT(degbin)
do j = 1, db
bbinmax(j) = bbinmin(j) + deg
lbinmax(j) = lbinmin(j)*cos(bbinmax(j))
print*, lbinmin(j), bbinmin(j), db
cn = 1
7 continue
read(1,*,err=7,end=8) ncrt, ra, dec, l, b,&
V, dsun, FeH(cn), EBV(cn)
if(b.ge.bbinmin(j).and.b.lt.bbinmax(j)) then
if(l.ge.lbinmin(j).and.l.lt.lbinmax(j)) then
FeHav = FeHav + FeH(cn)
EBVav = EBVav + EBV(cn)
cn = cn + 1
end if
end if
goto 7
8 continue
FeHav = FeHav/cn
EBVav = EBVav/cn
write(2,*) lbinmax(j), bbinmax(j), FeHav, EBVav
bbinmin(j+1) = bbinmin(j) + deg
lbinmin(j+1) = lbinmin(j) + deg
end do
close(1)
close(2)
end program redgrid
Below is a small section of the table I'm working with. "l" and "b" are the two coordinates I am working with---they are angular, hence the need to make the grid components "b" and "l*cos(b)." For each 0.5 x 0.5 degree section, I need to have averages of E(B-V) and [Fe/H] within that block. When I write the file all I need are four columns: the two coordinates where the box is located, and the two averages for that box.
| Ncrt | ra | dec | l | b | V | dkpc | [Fe/H] | E(B-V) |
7888 216.53 -43.85 -39.56 15.78 15.68 8.90 -1.19 0.1420
7889 217.49 -43.13 -38.61 16.18 16.15 10.67 -1.15 0.1750
7893 219.16 -43.26 -37.50 15.58 15.38 7.79 -1.40 0.1580
Right now, the program gets stuck somewhere in the loop cycle. I've pasted the terminal output that happens when I run it, along with the command line I'm running it with. Please let me know if I can help clarify. This is a pretty complex problem for a Fortran rookie such as myself---perhaps I'm missing some fundamental knowledge that would make it much easier. Anyways, thanks in advance.
./redgrid table2.above redtest.trim -40 0 15 30 0.5
-40.0000000 15.0000000 30 0.00000000 0.00000000
-39.5000000 15.5000000 30 -1.18592596 0.353437036
^it gets stuck after two lines.
I assume that the program does what you want it to do, but you are looking for a few things to tidy the code up.
Well first up, I'd fix up the indentation.
Secondly, I'd not use unit numbers below 10.
INTEGER, PARAMETER :: in_unit = 100
INTEGER, PARAMETER :: out_unit = 101
...
OPEN(unit=in_unit, file=infile, status='OLD")
...
READ(in_unit, *) ...
...
CLOSE(in_unit)
Thirdly, I'd not use GOTOs and labels. You can do that in a loop far easier:
INTEGER :: read_status
DO j = 1, db
...
read_loop : DO
READ(in_unit, *, IOSTAT=read_status) ...
IF (read_status == -1) THEN ! EOF
EXIT read_loop
ELSEIF (read_status /= 0) THEN
CYCLE read_loop
ENDIF
...
END DO read_loop
...
END DO
There are a few dangers in your code, and even in this one above: It can lead to infinite loops. For example, if the opening of infile fails (e.g. the file doesn't exist), it loops back to label 3, but nothing changes, so it will eventually again try to open the same file, and probably have the same error.
Same above: If READ repeatedly fails without advancing, and without the error being an EOF, then the read loop will not terminate.
You have to think about what you want your program to do when something like this happens, and code it in. (For example: Print an error message and STOP if it can't open the file.)
You have a very long FORMAT statement. You can leave it like that, though I'd probably try to shorten it a bit:
103 FORMAT(I7, 2F10.2, F11.2, 4F9.2, F10.4)
This should be the same line, as numbers are usually right-aligned. You can also use strings as a format, so you could also do something like this:
CHARACTER(LEN=*), PARAMETER :: data_out_form = &
'(I7, 2F10.2, F11.2, 4F9.2, F10.4)'
WRITE(*, data_out_form) var1, var2, var3, ...
and again, that's one less label.
I am have a problem using my for loop with crystal reports fields.
With my for i am trying to extract all the SQLExpressionFieldDefinition's from my report .
In order to do that , i am geting the count of the SQLExpressionFieldDefinition in the report.
The for loop works perfect until it reaches it last iteration.Then it trows Invalid index.
In other words SQLExpressionFieldDefinition->Count = 5 for exemple , the first 4 iteration work ,when it reaches the 5th the invalid index problem appears.
Here is the code :
for ( nIterator = 1; nIterator <= rpt->DataDefinition->SQLExpressionFields->Count; nIterator++ )
{
SQLExpressionFieldDefinition
*sqlExpressionFieldDefinition = rpt->DataDefinition->SQLExpressionFields->get_Item(nIterator);
strText = sqlExpressionFieldDefinition->Text;}
Waiting for your answers.Thanks.
Indexers for arrays should start at value 0, not at 1, and end at value Count - 1.
Crystal Reports is no exception to this rule.
for (nIterator=0; nIterator < rpt->DataDefinition->SQLExpressionFields->Count; nIterator++ )