How do I finish a recursive binary search in fortran? - recursion

I am trying to find the smallest index containing the value i in a sorted array. If this i value is not present I want -1 to be returned. I am using a binary search recursive subroutine. The problem is that I can't really stop this recursion and I get lot of answers(one right and the rest wrong). And sometimes I get an error called "segmentation fault: 11" and I don't really get any results.
I've tried to delete this call random_number since I already have a sorted array in my main program, but it did not work.
program main
implicit none
integer, allocatable :: A(:)
real :: MAX_VALUE
integer :: i,j,n,s, low, high
real :: x
N= 10 !size of table
MAX_VALUE = 10
allocate(A(n))
s = 5 ! searched value
low = 1 ! lower limit
high = n ! highest limit
!generate random table of numbers (from 0 to 1000)
call Random_Seed
do i=1, N
call Random_Number(x) !returns random x >= 0 and <1
A(i)= anint(MAX_VALUE*x)
end do
call bubble(n,a)
print *,' '
write(*,10) (a(i),i=1,N)
10 format(10i6)
call bsearch(A,n,s,low,high)
deallocate(A)
end program main
The sort subroutine:
subroutine sort(p,q)
implicit none
integer(kind=4), intent(inout) :: p, q
integer(kind=4) :: temp
if (p>q) then
temp = p
p = q
q = temp
end if
return
end subroutine sort
The bubble subroutine:
subroutine bubble(n,arr)
implicit none
integer(kind=4), intent(inout) :: n
integer(kind=4), intent(inout) :: arr(n)
integer(kind=4) :: sorted(n)
integer :: i,j
do i=1, n
do j=n, i+1, -1
call sort(arr(j-1), arr(j))
end do
end do
return
end subroutine bubble
recursive subroutine bsearch(b,n,i,low,high)
implicit none
integer(kind=4) :: b(n)
integer(kind=4) :: low, high
integer(kind=4) :: i,j,x,idx,n
real(kind=4) :: r
idx = -1
call random_Number(r)
x = low + anint((high - low)*r)
if (b(x).lt.i) then
low = x + 1
call bsearch(b,n,i,low,high)
else if (b(x).gt.i) then
high = x - 1
call bsearch(b,n,i,low,high)
else
do j = low, high
if (b(j).eq.i) then
idx = j
exit
end if
end do
end if
! Stop if high = low
if (low.eq.high) then
return
end if
print*, i, 'found at index ', idx
return
end subroutine bsearch
The goal is to get the same results as my linear search. But I'am getting either of these answers.
Sorted table:
1 1 2 4 5 5 6 7 8 10
5 found at index 5
5 found at index -1
5 found at index -1
or if the value is not found
2 2 3 4 4 6 6 7 8 8
Segmentation fault: 11

There are a two issues causing your recursive search routine bsearch to either stop with unwanted output, or result in a segmentation fault. Simply following the execution logic of your program at the hand of the examples you provided, elucidate the matter:
1) value present and found, unwanted output
First, consider the first example where array b contains the value i=5 you are searching for (value and index pointed out with || in the first two lines of the code block below). Using the notation Rn to indicate the the n'th level of recursion, L and H for the lower- and upper bounds and x for the current index estimate, a given run of your code could look something like this:
b(x): 1 1 2 4 |5| 5 6 7 8 10
x: 1 2 3 4 |5| 6 7 8 9 10
R0: L x H
R1: Lx H
R2: L x H
5 found at index 5
5 found at index -1
5 found at index -1
In R0 and R1, the tests b(x).lt.i and b(x).gt.i in bsearch work as intended to reduce the search interval. In R2 the do-loop in the else branch is executed, idx is assigned the correct value and this is printed - as intended. However, a return statement is now encountered which will return control to the calling program unit - in this case that is first R1(!) where execution will resume after the if-else if-else block, thus printing a message to screen with the initial value of idx=-1. The same happens upon returning from R0 to the main program. This explains the (unwanted) output you see.
2) value not present, segmentation fault
Secondly, consider the example resulting in a segmentation fault. Using the same notation as before, a possible run could look like this:
b(x): 2 2 3 4 4 6 6 7 8 8
x: 1 2 3 4 5 6 7 8 9 10
R0: L x H
R1: L x H
R2: L x H
R3: LxH
R4: H xL
.
.
.
Segmentation fault: 11
In R0 to R2 the search interval is again reduced as intended. However, in R3 the logic fails. Since the search value i is not present in array b, one of the .lt. or .gt. tests will always evaluate to .true., meaning that the test for low .eq. high to terminate a search is never reached. From this point onwards, the logic is no longer valid (e.g. high can be smaller than low) and the code will continue deepening the level of recursion until the call stack gets too big and a segmentation fault occurs.
These explained the main logical flaws in the code. A possible inefficiency is the use of a do-loop to find the lowest index containing a searched for value. Consider a case where the value you are looking for is e.g. i=8, and that it appears in the last position in your array, as below. Assume further that by chance, the first guess for its position is x = high. This implies that your code will immediately branch to the do-loop, where in effect a linear search is done of very nearly the entire array, to find the final result idx=9. Although correct, the intended binary search rather becomes a linear search, which could result in reduced performance.
b(x): 2 2 3 4 4 6 6 7 |8| 8
x: 1 2 3 4 5 6 7 8 |9| 10
R0: L xH
8 found at index 9
Fixing the problems
At the very least, you should move the low .eq. high test to the start of the bsearch routine, so that recursion stops before invalid bounds can be defined (you then need an additional test to see if the search value was found or not). Also, notify about a successful search right after it occurs, i.e. after the equality test in your do-loop, or the additional test just mentioned. This still does not address the inefficiency of a possible linear search.
All taken into account, you are probably better off reading up on algorithms for finding a "leftmost" index (e.g. on Wikipedia or look at a tried and tested implementation - both examples here use iteration instead of recursion, perhaps another improvement, but the same principles apply) and adapt that to Fortran, which could look something like this (only showing new code, ...refer to existing code in your examples):
module mod_search
implicit none
contains
! Function that uses recursive binary search to look for `key` in an
! ordered `array`. Returns the array index of the leftmost occurrence
! of `key` if present in `array`, and -1 otherwise
function search_ordered (array, key) result (idx)
integer, intent(in) :: array(:)
integer, intent(in) :: key
integer :: idx
! find left most array index that could possibly hold `key`
idx = binary_search_left(1, size(array))
! if `key` is not found, return -1
if (array(idx) /= key) then
idx = -1
end if
contains
! function for recursive reduction of search interval
recursive function binary_search_left(low, high) result(idx)
integer, intent(in) :: low, high
integer :: idx
real :: r
if (high <= low ) then
! found lowest possible index where target could be
idx = low
else
! new guess
call random_number(r)
idx = low + floor((high - low)*r)
! alternative: idx = low + (high - low) / 2
if (array(idx) < key) then
! continue looking to the right of current guess
idx = binary_search_left(idx + 1, high)
else
! continue looking to the left of current guess (inclusive)
idx = binary_search_left(low, idx)
end if
end if
end function binary_search_left
end function search_ordered
! Move your routines into a module
subroutine sort(p,q)
...
end subroutine sort
subroutine bubble(n,arr)
...
end subroutine bubble
end module mod_search
! your main program
program main
use mod_search, only : search_ordered, sort, bubble ! <---- use routines from module like so
implicit none
...
! Replace your call to bsearch() with the following:
! call bsearch(A,n,s,low,high)
i = search_ordered(A, s)
if (i /= -1) then
print *, s, 'found at index ', i
else
print *, s, 'not found!'
end if
...
end program main
Finally, depending on your actual use case, you could also just consider using the Fortran intrinsic procedure minloc saving you the trouble of implementing all this functionality yourself. In this case, it can be done by making the following modification in your main program:
! i = search_ordered(a, s) ! <---- comment out this line
j = minloc(abs(a-s), dim=1) ! <---- replace with these two
i = merge(j, -1, a(j) == s)
where j returned from minloc will be the lowest index in the array a where s may be found, and merge is used to return j when a(j) == s and -1 otherwise.

Related

How to check if a number is palindrome in Clean

I am solving this homework of clean programming language;
The problem is we have a number of five digits and we want to check whether it's an odd palindrome or not.
I am stuck at the stage of dividing the number to five separate digits and perform a comparison with the original number, for the palindrome check. With Clean I can't loop over the number and check if it remains the same from the both sides, so I am looking for an alternative solution (Some mathematical operations).
Code block:
isOddPalindrome :: Int -> Bool
isOddPalindrome a
| isFive a <> 5 = abort("The number should be exactly five digits...")
| (/*==> Here should be the palindrome check <==*/) && (a rem 2 <> 0) = True
| otherwise = False
isFive :: Int -> Int
isFive n
| n / 10 == 0 = 1
= 1 + isFive(n / 10)
My idea is to take the number, append it's digits one by one to an empty list, then perform the reverse method on the list and check if it's the same number or not (Palindrome)
Your answer above doesn't have a stopping condition so it will result in stack overflow.
You could try this
numToList :: Int -> [Int]
numToList n
| n < 10 = [n]
= numToList (n/10) ++ [n rem 10]
Start = numToList 12345
and then like you mentioned in the answer, you can reverse it with the 'reverse' function and check if they are equal.
After hours of trying to figure out how to recursively add the digits of our number to an empty list, I did the following:
sepDigits :: Int [Int] -> [Int]
sepDigits n x = sepDigits (n/10) [n rem 10 : x]
Now I can easily check whether the reverse is equal to the initial list :) then the number is palindrome.

Julia NLopt force stops before the first iteration

I'm using NLopt for a constrained maximization problem. Regardless of the algorithm or start values, the optimization program is force stopped even before the first iteration (or so I assume because it gives me the initial value). I've attached my code here. I'm trying to find probabilities attached to a grid such that a function is maximized under some constraints. Any help is appreciated.
uk = x -> x^0.5
function objective(u,p,grd)
-p'*u.(grd)
end
function c3(grd,p)
c =[]
d =[]
for i=1:length(grd)
push!(c,quadgk(x -> (i-x)*(x <= i ? 1 : 0),0,1)[1])
push!(d,sum(p[1:i]'*(grd[1:i] .- grd[i])))
end
return append!(d-c,-p)
end
function c4(grd,p)
return (grd .* p)-quadgk(x,0,1)
end
grd = n -> collect(0:1/n:1)
opt = Opt(:LD_SLSQP,11)
inequality_constraint!(opt, p -> c3(grd(10),p))
inequality_constraint!(opt, p -> -p)
equality_constraint!(opt, p -> sum(p)-1)
equality_constraint!(opt, p -> c4(grd(10),p))
opt.min_objective = p -> objective(-uk, p, grd(10))
k = push!(ones(11)*(1/11))
(minf,minx,ret) = optimize(opt, k)
I'm not a julia developer, but I only know this, if you need exit before complete the loop for is not your best choice, you need do a while with a sentinel variable.
here you have an article that explain you how while with sentinels works
and here you have a julia example changing your for to a while with a sentinel that exit after the third loop
i = 1
third = 0
while i < length(grd) && third != 1
# of course you need change this, it is only an example that will exit in the 3 loop
if i == 3
third = 1
end
push!(c,quadgk(x -> (i-x)*(x <= i ? 1 : 0),0,1)[1])
push!(d,sum(p[1:i]'*(grd[1:i] .- grd[i])))
i += 1
end

Can I use <- instead of = in Julia?

Like in R:
a <- 2
or even better
a ← 2
which should translate to
a = 2
and if possible respect method overloading.
= is overloaded (not in the multiple dispatch sense) a lot in Julia.
It binds a new variable. As in a = 3. You won't be able to use ← instead of = in this context, because you can't overload binding in Julia.
It gets lowered to setindex!. As in, a[i] = b gets lowered to setindex!(a, b, i). Unfortunately, setindex! takes 3 variables while ← can only take 2 variables. So you can't overload = with 3 variables.
But, you can use only 2 variables and overload a[:] = b, for example. So, you can define ←(a,b) = (a[:] = b) or ←(a,b) = setindex!(a,b,:).
a .= b gets lowered to (Base.broadcast!)(Base.identity, a, b). You can overload this by defining ←(a,b) = (a .= b) or ←(a,b) = (Base.broadcast!)(Base.identity, a, b).
So, there are two potentially nice ways of using ←. Good luck ;)
Btw, if you really want to use ← to do binding (like in 1.), the only way to do it is using macros. But then, you will have to write a macro in front of every single assignment, which doesn't look very good.
Also, if you want to explore how operators get lowered in Julia, do f(a,b) = (a .= b), for example, and then #code_lowered f(x,y).
No. = is not an operator in Julia, and cannot be assigned to another symbol.
Disclaimer: You are fully responsible if you will try my (still beginner's) experiments bellow! :P
MacroHelper is module ( big thanks to #Alexander_Morley and #DanGetz for help ) I plan to play with in future and we could probably try it here :
julia> module MacroHelper
# modified from the julia source ./test/parse.jl
function parseall(str)
pos = start(str)
exs = []
while !done(str, pos)
ex, pos = parse(str, pos) # returns next starting point as well as expr
ex.head == :toplevel ? append!(exs, ex.args) : push!(exs, ex)
end
if length(exs) == 0
throw(ParseError("end of input"))
elseif length(exs) == 1
return exs[1]
else
return Expr(:block, exs...) # convert the array of expressions
# back to a single expression
end
end
end;
With module above you could define simple test "language":
julia> module TstLang
export #tst_cmd
import MacroHelper
macro tst_cmd(a)
b = replace("$a", "←", "=") # just simply replacing ←
# in real life you would probably like
# to escape comments, strings etc
return MacroHelper.parseall(b)
end
end;
And by using it you could probably get what you want:
julia> using TstLang
julia> tst```
a ← 3
println(a)
a +← a + 3 # maybe not wanted? :P
```
3
9
What about performance?
julia> function test1()
a = 3
a += a + 3
end;
julia> function test2()
tst```
a ← 3
a +← a + 3
```
end;
julia> test1(); #time test1();
0.000002 seconds (4 allocations: 160 bytes)
julia> test2(); #time test2();
0.000002 seconds (4 allocations: 160 bytes)
If you like to see syntax highlight (for example in atom editor) then you need to use it differently:
function test3()
#tst_cmd begin
a ← 3
a ← a + a + 3 # parser don't allow you to use "+←" here!
end
end;
We could hope that future Julia IDEs could syntax highlight cmd macros too. :)
What could be problem with "solution" above? I am not so experienced julian so many things. :P (in this moment something about "macro hygiene" and "global scope" comes to mind...)
But what you want is IMHO good for some domain specific languages and not to redefine basic of language! It is because readability very counts and if everybody will redefine everything then it will end in Tower of Babel...

How to write out complex numbers using Fortran specifier

I am new to Fortran and I have the following code, it basically solves a simple quadratic equation and output the solutions
!solving ax^2 + bx + c = 0
program output
implicit none
real :: a,b,c
character :: response
do
print*, 'Enter three coefficients a,b and c'
read *, a,b,c
call quad(a,b,c)
print*, 'Press Y to continue. Anykey for otherwise'
read *, response
if ( response /= 'y' .and. response /= 'Y') stop
end do
end program output
!Function to calculate Xs
subroutine quad(a,b,c)
implicit none
real :: a,b,c,xplus, xminus
xplus = ((-b)+sqrt((b**2)-(4*a*c)))/(2*a)
xminus = ((-b)-sqrt((b**2)-(4*a*c)))/(2*a)
if (xplus == xminus) then
print*, 'There exists 1 root only: '
write(*,12) xplus
12 format(2f10.2)
else
print*, 'Solutions of quadratic equation are'
write(*,10) xplus, xminus
10 format(1f10.5)
end if
end subroutine quad
This works. However, how would I go about with complex solutions. I.e, how would this line change, to make the format for complex numbers.
10 format(1f10.5)
Thank you so much.

Fortran pointer array to multiple targets

Is there a way to have in Fortran a pointer to an array pointing different targets?
The following code shows what I am trying to do, which does not work as I want since the second association overwrites the first
implicit none
integer, parameter :: n = 3
integer, target :: a(n), b(n)
integer, pointer :: c(:) => NULL()
a = 4
b = 5
c(1:n) => a(1:n)
c(n+1:2*n) => b(1:n)
c(1:2*n) = 1
print*, a
print*, b
OUTPUT (ifort)
4 1 1
1 1 1
OUTPUT (gfortran)
4 4 4
1 1 1
And, any idea why ifort and gfortran behave differently in this case?
No, there is no simple way to do this, at least as far as I can see. Maybe if you say why you are trying to do this somebody might come up with a suitable answer, for instance in my mind derived types and/or array constructors might be the way to go but without context it is difficult to say.
As for why you get different answers you accessed an array out of bounds so anything can happen:
ian#ian-pc:~/test/stack$ cat point.f90
Program point
implicit none
integer, parameter :: n = 3
integer, target :: a(n), b(n)
integer, pointer :: c(:) => NULL()
a = 4
b = 5
c(1:n) => a(1:n)
c(n+1:2*n) => b(1:n)
c(1:2*n) = 1
print*, a
print*, b
End Program point
ian#ian-pc:~/test/stack$ nagfor -C=all -C=undefined point.f90
NAG Fortran Compiler Release 5.3.1(907)
[NAG Fortran Compiler normal termination]
ian#ian-pc:~/test/stack$ ./a.out
Runtime Error: point.f90, line 14: Subscript 1 of C (value 1) is out of range (4:6)
Program terminated by fatal error
Aborted (core dumped)
Think carefully what the lines
c(1:n) => a(1:n)
c(n+1:2*n) => b(1:n)
are doing. The first line says forget about whatever c was before, now c( 1:n ) is an alias for a( 1:n ). Note the allowed indices for c run from 1 to n. Similarly the second line throws away the reference to a and says c( n+1:2*n) is an alias for b( 1:n ). Note now the indices of C run from n+1:2*n, while for b they run from 1:n, but this is fine as both have n elements and that is all that matters. However the next line says
c(1:2*n) = 1
which can not be correct as you have just said the lowest allowed index for C is n+1, and as n=3 1 is not a valid index. Thus you are out of bounds and so anything can happen.
I strongly suggest when developing you use the debugging options on the compiler - in my experience it can save you hours by avoiding this kind of thing!

Resources