do loop/if statement logic - fortran

I'm working on a tic-tac-toe program. The function CHECK_WINNER is supposed to take in a board in a given state and determine if the game has been won, tied, or if players need to continue the game. CHECK_WINNER takes on different values based on the state of the board.
The block of win(n;1:3) lists the 8 possible winning configurations of a tic-tac-toe board.
I think the trouble is in the do loop. My goal is to cycle through each winning scenario for the board for each player (1 and 2) and check if a winning condition has been met. CHECK_MOVE should be 1 if player 1 wins, 2 if player 2 wins, 3 if the game is a draw, and 0 for any other case. What am I doing wrong?
program checkwinner
implicit none
integer, dimension(9) :: board
integer, external :: CHECK_WINNER
integer :: cw
!board = (/ 1,2,1,2,1,2,2,2,1 /) ! not working correctly. 1 is winner, board full; cw returns 3
!board = (/ 1,2,1,2,0,2,2,2,1 /) ! working correctly. no winner, open spaces; cw returns 0
!board = (/ 1,1,1,0,0,0,0,0,0 /) ! not working. cw should return 1; instead cw returns 0
board = (/ 2,2,2,0,0,0,0,0,0 /) ! not working
cw = CHECK_WINNER(board)
print *, board(1:3)
print *, board(4:6)
print *, board(7:9)
print *, cw
end program checkwinner
!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!
integer function CHECK_WINNER(fboard)
implicit none
integer :: i
integer, dimension(8,3) :: win
integer, dimension(9), intent(in) :: fboard
win(1,1:3) = (/ 1,2,3 /)
win(2,1:3) = (/ 4,5,6 /)
win(3,1:3) = (/ 7,8,9 /)
win(4,1:3) = (/ 1,4,7 /)
win(5,1:3) = (/ 2,5,8 /)
win(6,1:3) = (/ 3,6,9 /)
win(7,1:3) = (/ 1,5,9 /)
win(8,1:3) = (/ 3,5,7 /)
do i = 1,8
if (fboard(win(i,1)) == 1 .and. fboard(win(i,2)) == 1 .and. fboard(win(i,3)) == 1) then
CHECK_WINNER = 1
else if (fboard(win(i,1)) == 2 .and. fboard(win(i,2)) == 2 .and. fboard(win(i,3)) == 2) then
CHECK_WINNER = 2
else if ((fboard(win(i,1)) == 1 .or. fboard(win(i,1)) == 2) .and. (fboard(win(i,2)) == 1 .or. &
fboard(win(i,2)) == 2) .and. (fboard(win(i,3)) == 1 .or. fboard(win(i,3)) == 2)) then
CHECK_WINNER = 3
else
CHECK_WINNER = 0
end if
end do
end function CHECK_WINNER

So in the example you gave in your code with board = (/ 2,2,2,0,0,0,0,0,0 /) when i=1 in the do-loop of the function, it correctly sets CHECK_WINNER=2 because
fboard(win(i,1)) == 2 .and. fboard(win(i,2)) == 2 .and. fboard(win(i,3)) == 2
is true. Unfortunately when the loop gets to i=2, i=3 etc it resets CHECK_WINNER to zero because none of the win conditions match. It's the else block which is causing the problem. Change the do loop to
CHECK_WINNER = 0
do i = 1,8
if (fboard(win(i,1)) == 1 .and. fboard(win(i,2)) == 1 .and. fboard(win(i,3)) == 1) then
CHECK_WINNER = 1
else if (fboard(win(i,1)) == 2 .and. fboard(win(i,2)) == 2 .and. fboard(win(i,3)) == 2) then
CHECK_WINNER = 2
else if ((fboard(win(i,1)) == 1 .or. fboard(win(i,1)) == 2) .and. (fboard(win(i,2)) == 1 .or. &
fboard(win(i,2)) == 2) .and. (fboard(win(i,3)) == 1 .or. fboard(win(i,3)) == 2)) then
CHECK_WINNER = 3
end if
end do
so if it finds a known combination it sets CHECK_WINNER. You could also exit the loop as soon as the known combination is found using exit within each (else)if clause. (after CHECK_WINNER is set)

Related

Write the function residue l n which calculates the residue of n by l by making an iterative calculation

I want to write the function residue l n which calculates the residue of n by l by making an iterative calculation starting with n and using the items in the list in order. The calculation is as follows:
-initially the residue is the value of n
-each element e of l (taken in the order of the list) changes the residue in the following way:
if e and the residue are of the same parity (both even or both odd) then the new residue is the sum of r and e, otherwise it is the difference between r and e (r-e).
-the last residue is the result of the game.
Example: residu [1;3] 7 returns 5 as a result of the following calculations:
7 + 1 (same parity +) = 8
8 - 3 (parité différente -) = 5
This is my code but it doesn't seem to be working:
let rec residue l n =
if l = [] then 0 else
if (((List.hd l) mod 2 <> 0) && (n mod 2 <> 0 )) || (((List.hd l) mod 2 == 0) && (n mod 2 == 0 ))
then
(List.hd l) + residue (List.tl l) ((List.hd l)+ n) else
n - (List.hd l) - residue (List.tl l) (n - (List.hd l));;
residu [1;3] 7;;
- : int = 6 (The correct result should be 5)
Thank you for your help.
Here is my stab at it.
let rec residue l n =
let parity a b =
if ((a mod 2 <> 0) && (b mod 2 <> 0)) ||
((a mod 2 == 0) && (b mod 2 == 0)) then true else false in
match l, n with
| [], n -> n
| (x::xs), n -> if parity x n then residue xs (n+x) else residue xs (n-x)
Hope it helps for figuring out the problem.

if statement in do block gives error message [duplicate]

This question already has answers here:
Parse error on input 'if' when trying to use a condition inside a do block
(3 answers)
Closed 3 years ago.
I'm trying to make a very simple snake-like game where, if you try to go to a x,y coordinate you have already visited, you lose the game.
This is code that's working so far (you can move player 1 with arrowkeys and player 2 with wasd):
import UI.NCurses
main :: IO ()
main = runCurses $ do
w <- defaultWindow
updateWindow w $ do
drawBorder Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
render
loop w [] 1 1 0 0 10 10 0 0
loop :: Window -> [(Integer, Integer)] -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Curses ()
loop w list p1x p1y p1oldDx p1oldDy p2x p2y p2oldDx p2oldDy = do
e <- getEvent w (Just 100)
let coordList = updateXY e p1oldDx p1oldDy p2oldDx p2oldDy
let p1dX = coordList !! 0
let p1dY = coordList !! 1
let p2dX = coordList !! 2
let p2dY = coordList !! 3
updateWindow w $ do
moveCursor (p1y+p1dY) (p1x+p1dX)
drawString ("#")
moveCursor (p2y+p2dY) (p2x+p2dX)
drawString ("#")
render
let updatedList = list ++ [(p1y+p1dY, p1x+p1dX)] ++ [(p2y+p2dY, p2x+p2dX)]
loop w updatedList (p1x+p1dX) (p1y+p1dY) p1dX p1dY (p2x+p2dX) (p2y+p2dY) p2dX p2dY
updateXY :: Maybe Event -> Integer -> Integer -> Integer -> Integer -> [Integer]
updateXY e p1oldX p1oldY p2oldX p2oldY
| e == Just (EventSpecialKey KeyLeftArrow) = [-1, 0, p2oldX, p2oldY]
| e == Just (EventSpecialKey KeyRightArrow) = [1, 0, p2oldX, p2oldY]
| e == Just (EventSpecialKey KeyDownArrow) = [0, 1, p2oldX, p2oldY]
| e == Just (EventSpecialKey KeyUpArrow) = [0, -1, p2oldX, p2oldY]
| e == Just (EventCharacter 'a') = [p1oldX, p1oldY, -1, 0]
| e == Just (EventCharacter 'd') = [p1oldX, p1oldY, 1, 0]
| e == Just (EventCharacter 's') = [p1oldX, p1oldY, 0, 1]
| e == Just (EventCharacter 'w') = [p1oldX, p1oldY, 0, -1]
| p1oldX /= 0 = [p1oldX, 0, p2oldX, p2oldY]
| p1oldY /= 0 = [0, p1oldY, p2oldX, p2oldY]
| p2oldX /= 0 = [p1oldX, p1oldY, p2oldX, 0]
| p2oldY /= 0 = [p1oldX, p1oldY, 0, p2oldY]
| otherwise = [1, 0, 1, 0] -- Starts moving in x-direction. Change to (0,0) for stand-still
So as you move, "#" characters are put down. The above code does nothing if you go to a coordinate which already has a "#" on it, so I tried changing the loop function by adding this just before the let updatedList...:
if length (filter (==(p1x, p1y)) list) > 0 then gameOver w "player one lost"
if length (filter (==(p2x, p2y)) list) > 0 then gameOver w "player two lost"
And adding a temporary gameOver function:
gameOver w player =
updateWindow w $ do
moveCursor (10) (10)
drawString (player)
render
But when I try to load this file in GHCI I get the following error message:
parse error on input 'if'
ifs need elses. Period. You can use the when function for when you need the imperative style "if this, then do that, else do nothing," but there is no built-in syntax:
import Control.Monad
when (length (filter (==(p1x, p1y)) list) > 0) $ gameOver w "player one lost"
when (length (filter (==(p2x, p2y)) list) > 0) $ gameOver w "player two lost"
The definition of when is
when cond action = if cond then action else pure ()
In Haskell, if expressions must have both then and else clauses.
Without the else, you get the error.
Both the consequent and the alternative clause must have the same type.

If with many condition in Ocaml

I'm a beginner in oCaml and I have an error on this following function :
let rec determinant n m1 =
if n <= 2 then
detMat2 m1
else
let mat = Array.make_matrix (n-1) (n-1) 0 in
for ligne = 0 to (n-1) do
for colonne = 0 to (n-1) do
for i = 0 to (n-1) do
for j = 0 to (n-1) do
if i != (n-1) && j != (n-1) then
else if (i != ligne && j != colonne) then
mat.(i).(j) <- m1.(ligne).(colonne)
else if i != ligne && j = colonne then
mat.(i).(j) <- m1.(ligne).(colonne+1)
else if i = ligne && j != colonne then
mat.(i).(j) <- m1.(ligne+1).(colonne)
else if i = ligne && j = colonne then
mat.(i).(j) <- m1.(ligne+1).(colonne+1)
done
done
done
done;
determinant (n-1) mat;;
I get this following error :
File "s2.ml", line 65, characters 9-13:
Error: Syntax error
Thanks for your help !
As there are much fewer than 65 lines in the code excerpt you show us, the error message is clearly not the one you get from this code alone. Please take the time to create a mcve.
That said, the then branch of the if immediately following the innermost for loop is empty. You can't do that in OCaml: if there's nothing to do, it should be said explicitly by returning () (the only value of the unit type), as in
if i != (n-1) && j != (n-1) then ()
else (* do the rest *)

Transfer array from Fortran subprogram to main program

I have a subroutine that opens and reads a file. The final result is an array that contains the data from the input file in a re-organized fashion. I want to call the subroutine in the main program to use the aforementioned array.
The subroutine has all the variables necessary for it to run as a separate program declared in its file. I'm new using Fortran so I'm not sure how to correctly employ subroutines. Do I need to assign any formal variables to subroutine's first line, or should I have an empty set of parenthesis?
The subroutine is in a file (subroutine.f03) that's separate from the main program's file (main.f03).
Main program code:
PROGRAM main
IMPLICIT NONE
CALL readBasis
WRITE(*,*) basis(1,1)
END PROGRAM
Subroutine code:
SUBROUTINE readBasis()
IMPLICIT NONE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! io_open = IOSTATUS FOR OPENING THE BASIS FILE !!
!! io_red = IOSTATUS FOR READING THE BASIS FILE !!
!! atom_num = NUMBER ASSIGNED TO A PARTICULAR ATOM IN THE BASIS FILE !!
!! end_of_line = 0, DEFAULT BASIS SET INPUT FORMAT !!
!! end_of_line_1 = 0.00 DEFAULT BASIS SET INPUT FORMAT !!
!! atom_end = **** INDICATES THE END OF THE BASIS SET INFO FOR A GIVEN ATOM !!
!! primitives = NUMBER OF PRIMITIVES IN A CONTRACTION !!
!! basis_type = ANGULAR MOMENTUM ASSOCIATED WITH A CONTRACTION !!
!! expo = GAUSSIAN PRIMITIVE EXPONENT !!
!! coeff = CONTRACTION COEFFICIENT FOR AN S, P, D PRIMITIVE RESPECTIVELY IN A S, P, D SHELL !!
!! s_coeff & p_coeff = CONTRACTION COEFFICIENTS FOR S AND P PRIMITIVES IN AN SP SHELL !!
!! basis = ARRAY CONTAINING ALL OF THE BASIS SET INFORMATION. THE FORMAT IS GIVEN BELLOW: !!
!! BASIS NUMBER | PRIMITIVE TYPE | EXPONENT | S COEFF | P COEFF | D COEFF | X COORDS | Y COORDS | Z COORDS !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
INTEGER :: i, io_open, io_read, atom_num, end_of_line, primitives, gauss_i, gauss_f
INTEGER :: total_basis_functions, total_primitives, primitive_counter, primitive_num
INTEGER :: func_start, func_end, func_counter
CHARACTER (LEN=4) :: basis_type, atom_end
REAL :: scaling, end_of_line_1
REAL :: expo, coeff, s_coeff, p_coeff
REAL, ALLOCATABLE :: basis(:,:)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! atom_loop WILL LET YOU READ THE BASIS FUNCTIONS FOR EVERY ATOM !!
!! contraction_loop WILL LET YOU READ EACH BASIS FUNCTION PER ATOM !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
OPEN(UNIT=10, FILE="BASIS", STATUS="OLD", ACTION="READ", IOSTAT=io_open)
READ(10,*) total_basis_functions
READ(10,*) total_primitives
ALLOCATE(basis(total_primitives,6))
READ(10,*,IOSTAT=io_read) atom_num, end_of_line
READ(10,*) basis_type, primitives, scaling, end_of_line_1, func_start, func_end
atom_end = basis_type
primitive_num = 1
atom_loop: DO WHILE (io_read .EQ. 0)
contraction_loop: DO WHILE (atom_end .NE. "****")
orbital_type_loop: IF (basis_type == "S ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, coeff
basis(primitive_num,1) = REAL(func_counter)
basis(primitive_num,2) = REAL(0)
basis(primitive_num,3) = expo
basis(primitive_num,4) = coeff
basis(primitive_num,5) = REAL(0)
basis(primitive_num,6) = REAL(0)
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
ELSE IF (basis_type .EQ. "P ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, coeff
basis(primitive_num,1) = REAL(func_counter)
basis(primitive_num,2) = REAL(1)
basis(primitive_num,3) = expo
basis(primitive_num,4) = REAL(0)
basis(primitive_num,5) = coeff
basis(primitive_num,6) = REAL(0)
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
ELSE IF (basis_type == "D ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, coeff
basis(primitive_num, 1) = REAL(func_counter)
basis(primitive_num,2) = REAL(2)
basis(primitive_num,3) = expo
basis(primitive_num,4) = REAL(0)
basis(primitive_num,5) = REAL(0)
basis(primitive_num,6) = coeff
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
ELSE IF (basis_type .EQ. "SP ") THEN
DO func_counter = func_start, func_end
DO primitive_counter = 1, primitives
READ(10,*) expo, s_coeff, p_coeff
basis(primitive_num,1) = REAL(func_counter)
basis(primitive_num,2) = REAL(10)
basis(primitive_num,3) = expo
basis(primitive_num,4) = s_coeff
basis(primitive_num,5) = p_coeff
basis(primitive_num,6) = REAL(0)
primitive_num = primitive_num + 1
END DO
IF (func_counter .LT. func_end) THEN
DO primitive_counter = 1, primitives
BACKSPACE(10)
END DO
ELSE
CONTINUE
END IF
END DO
END IF orbital_type_loop
READ(10,*) atom_end
IF (atom_end .EQ. "****") THEN
READ(10,*,IOSTAT=io_read) atom_num, end_of_line
IF (io_read < 0) THEN
EXIT atom_loop
ELSE IF (io_read > 0) THEN
WRITE(*,*) "FILE COULD NOT BE READ."
EXIT atom_loop
ELSE
READ(10,*) basis_type, primitives, scaling, end_of_line_1, func_start, func_end
atom_end = basis_type
EXIT contraction_loop
END IF
ELSE
BACKSPACE(10)
READ(10,*) basis_type, primitives, scaling, end_of_line_1, func_start, func_end
END IF
END DO contraction_loop
END DO atom_loop
CLOSE(10)
RETURN
END SUBROUTINE
A subroutine has "dummy variables" identified in the parenthesis at its inception. These can be input or output arguements of mixed data types, i.e. a mixture of integers, integer arrays, reals ,etc.. Each dummy variable must have a data type assigned to in the variable declarations section of the subroutine, before any procedural statements. It is good practice, IMO, to use the intent modifier to ensure clarity between input and output varaibles. Varaibles that exist locally in the subroutine and are not explicitly input or ouput do not need to be in the parens but do do need to be declared, unless they have an implicit data type. Here is an example:
subroutine MEGA_SUBROUTINE(X,Y,Z,OUTPUT_ARRAY)
implicit none
real, intent(in):: X,Y,Z
real:: local_var
real, intent(out):: OUTPUT_ARRAY
! begin procedural section
! do stuff with your variables here, assign a value to output array
end subroutine MEGA_SUBROUTINE

How to count the number of 1's surrounding a given element in a 2D list with Haskell?

Suppose I have the following nested list:
list =
[[0, 1, 0],
[1, 9, 1],
[1, 1, 0]]
Assuming you are only given the x and y coordinate of 9. How do I use Haskell code to find out how many 1's surrounds the number 9?
Let me clarify a bit more, assume the number 9 is positioned at (0, 0).
What I am trying to do is this:
int sum = 0;
for(int i = -1; i <= 1; i++){
for(int j = -1; j <= 1; j++){
if(i == 0 || j == 0) continue;
sum += list[i][j];
}
}
The positions surrounding (0,0) are the following coordinates:
(-1, -1) (0, -1) (1, -1)
(-1, 0) (1, 0)
(-1, 1) (0, 1) (1, 1)
list = [[0,1,0],[1,9,1],[1,1,0]]
s x y = sum [list !! j !! i | i <- [x-1..x+1], j <- [y-1..y+1], i /= x || j /= y]
--s 1 1 --> 5
Note that I there is no error correction if the coordinates are at the edge. You could implement this by adding more conditions to the comprehension.
A list of lists isn't the most efficient data structure if things get bigger. You could consider vectors, or a Map (Int,Int) Int (especially if you have many zeros that could be left out).
[Edit]
Here is a slightly faster version:
s x y xss = let snip i zs = take 3 $ drop (i-1) zs
sqr = map (snip x) $ snip y xss
in sum (concat sqr) - sqr !! 1 !! 1
First we "snip out" the 3 x 3 square, then we do all calculations on it. Again, coordinates on the edges would lead to wrong results.
Edit: switched to summing surrounding 8 rather than surrounding 4
How often do you just want the surrounding count for just one entry? If you want it for all the entries, lists still perform fairly well, you just have to look at it holistically.
module Grid where
import Data.List (zipWith4)
-- given a grid A, generate grid B s.t.
-- B(x,y) = A(x-1,y-1) + A(x,y-1) + A(x+1,y-1)
-- + A(x-1,y) + A(x+1,y)
-- + A(x-1,y+1) + A(x,y+1) + A(x+1,y+1)
-- (where undefined indexes are assumed to be 0)
surrsum :: [[Int]] -> [[Int]]
surrsum rs = zipWith3 merge rs ([] : init rs') (tail rs' ++ [[]])
where -- calculate the 3 element sums on each row, so we can reuse them
rs' = flip map rs $ \xs -> zipWith3 add3 xs (0 : xs) (tail xs ++ [0])
add3 a b c = a+b+c
add4 a b c d = a+b+c+d
merge [] _ _ = []
-- add the left cell, right cell, and the 3-element sums above and below (zero-padded)
merge as bs cs = zipWith4 add4 (0 : init as) (tail as ++ [0]) (bs ++ repeat 0) (cs ++ repeat 0)
-- given a grid A, replace entries not equal to 1 with 0
onesOnly :: [[Int]] -> [[Int]]
onesOnly = map . map $ \e -> if e == 1 then 1 else 0
list :: [[Int]]
list = [[0, 1, 0]
,[1, 9, 1]
,[1, 1, 0]]
Now you can drop down to ghci to see it work:
*Grid Control.Monad> mapM_ (putStrLn . unwords . map show) list
0 1 0
1 9 1
1 1 0
*Grid Control.Monad> mapM_ (putStrLn . unwords . map show) $ onesOnly list
0 1 0
1 0 1
1 1 0
*Grid Control.Monad> mapM_ (putStrLn . unwords . map show) . surrsum $ onesOnly list
2 2 2
3 5 2
2 3 2