Why can't I call the second half of a mutually recursive function that's defined locally? - ats

As a follow up to Why can't generic function templates use fnx to ensure they are tail-recursive?, and after reading Compiler Friendly Tail Recursion + Tail Recursion Checking in ATS, I wanted to see if i could ensure my function either got tail-call optimized, or failed to compile. This is the function:
fun {a:t#ype} repeat {n:nat} .<n>.
( x: a
, t: int n
, f: a -> a
) : a =
if t = 0 then x
else repeat (f x, t - 1, f)
So first I made it a trivial mutually recursive function, like so:
fnx {a:t#ype} repeat1 {n:nat} .<n>.
( x: a
, t: int n
, f: a -> a
) : a =
if t = 0 then x
else repeat1 (f x, t - 1, f)
and {a:t#ype} repeat2 {n:nat} .<>.
( x: a
, t: int n
, f: a -> a
) : a = repeat1 (x, t, f)
But that doesn't compile, it seems like it doesn't like the generic type arguments. So I put the definition inside a third parent function, which has the generic argument and just calls into the mutual recursive pair.
fun {a:t#ype} repeat {n:nat} .<n>.
( x: a
, t: int n
, f: a -> a
) : a =
let
fnx repeat1 {n:nat} .<n>.
( x: a
, t: int n
, f: a -> a
) : a =
if t = 0 then x
else repeat1 (f x, t - 1, f)
and repeat2 {n:nat} .<>.
( x: a
, t: int n
, f: a -> a
) : a = repeat1 (x, t, f)
in
repeat1 (x, t, f)
end
Viola, it compiles! But then I tried calling repeat2 instead of repeat1 in the last line, like so:
fun {a:t#ype} repeat {n:nat} .<n>.
//snip...
in
repeat2 (x, t, f)
end
And this fails to compile, with error:
the dynamic identifier [repeat2] is unrecognized.
Hence, the question in the title.

When you use 'fnx' to define mutually recursive functions, only the first defined function is available for subsequent use.

Related

Why a declared and filled mwSize saves the day when a constant doesn't

I have this subroutine :
subroutine FotranDgemmMatrixMultiplication(A, B, C, m, n, p, mkl)
integer m, n, p
real*8 mkl
real*8 A(m,n), B(n,p), C(m,p)
if (mkl .ne. 1) then
C = matmul(A,B)
else
C = matmul(B,A)
endif
end
that I use in a mex gateway file as follows :
#include <fintrf.h>
C The gateway routine
subroutine mexFunction(nlhs, plhs, nrhs, prhs)
implicit none
mwPointer mxGetM, mxGetN, mxIsNumeric, mxIsLogical
mwPointer mxCreateDoubleMatrix
mwPointer plhs(*), prhs(*)
mwPointer A_pr, B_pr, C_pr, mkl_pr
mwPointer mxGetPr
integer nlhs, nrhs
real*8, allocatable, dimension(:,:) :: x, y, z
real*8 mkl
mwSize m, n, p, q, r, s
mwSize size1, size2, size3
C Check for proper number of arguments.
if (nrhs .ne. 3) then
call mexErrMsgTxt('Three inputs required.')
elseif (nlhs .ne. 1) then
call mexErrMsgTxt('One output required.')
endif
C Check to see both inputs are numeric.
if (mxIsNumeric(prhs(1)) .ne. 1) then
call mexErrMsgTxt('Input #1 is not a numeric array.')
elseif (mxIsNumeric(prhs(2)) .ne. 1) then
call mexErrMsgTxt('Input #2 is not a numeric array.')
elseif (mxIsNumeric(prhs(3)) .ne. 1) then
call mexErrMsgTxt('Input #3 is not a numeric array.')
endif
C Get the size of the input matrix #1.
m = mxGetM(prhs(1))
n = mxGetN(prhs(1))
C Get the size of the input matrix #2.
p = mxGetM(prhs(2))
q = mxGetN(prhs(2))
C Check that the sizes are compatible for a matrix product
if (n .ne. p) then
call mexErrMsgTxt('nbcol1 should be equal to nbrow2.')
endif
size1 = m*n
size2 = p*q
C Check that the input #3 is a scalar
r = mxGetM(prhs(3))
s = mxGetN(prhs(3))
if(r .ne. 1 .or. s .ne. 1) then
call mexErrMsgTxt('Input #3 is not a scalar.')
endif
C Create matrix for the return argument.
plhs(1) = mxCreateDoubleMatrix(m, q, 0)
A_pr = mxGetPr(prhs(1))
B_pr = mxGetPr(prhs(2))
mkl_pr = mxGetPr(prhs(3))
C_pr = mxGetPr(plhs(1))
allocate( x(m,n), y(p,q), z(m,q) )
C Load the data into Fortran arrays.
call mxCopyPtrToReal8(A_pr, x, size1)
call mxCopyPtrToReal8(B_pr, y, size2)
call mxCopyPtrToReal8(mkl_pr, mkl, 1) ! suspicious line
C Call the computational subroutine.
call FotranDgemmMatrixMultiplication(x, y, z, m, n, q, mkl) ! crash here
C Load the output into a MATLAB array.
size3 = m*q
call mxCopyReal8ToPtr(z, C_pr, size3)
!deallocate(x,y,z)
return
end
that executes as intended in debug but that crashes in release, the crash occuring at line :
call FotranDgemmMatrixMultiplication(x, y, z, m, n, q, mkl)
If I add a mwSize sizeOne with sizeOne = 1 and replace the suspicious line (see the code) with :
call mxCopyPtrToReal8(mkl_pr, mkl, sizeOne)
then the crash doesn't occur anymore. I don't understand what is happening as in x64 the "type" mwSize is defined (in fintrf.h) as mwpointer which itself is defined as integer*4, which should treat the "constant" 1 correctly normally.

Performance of Conway's Game of Life using the Store comonad

I've written a simple implementation of Conway's Game of Life using the Store comonad (see code below). My problem is that the grid generation is getting visibly slower from the fifth iteration onwards. Is my issue related to the fact that I'm using the Store comonad? Or am I making a glaring mistake? As far as I could tell, other implementations, which are based on the Zipper comonad, are efficient.
import Control.Comonad
data Store s a = Store (s -> a) s
instance Functor (Store s) where
fmap f (Store g s) = Store (f . g) s
instance Comonad (Store s) where
extract (Store f a) = f a
duplicate (Store f s) = Store (Store f) s
type Pos = (Int, Int)
seed :: Store Pos Bool
seed = Store g (0, 0)
where
g ( 0, 1) = True
g ( 1, 0) = True
g (-1, -1) = True
g (-1, 0) = True
g (-1, 1) = True
g _ = False
neighbours8 :: [Pos]
neighbours8 = [(x, y) | x <- [-1..1], y <- [-1..1], (x, y) /= (0, 0)]
move :: Store Pos a -> Pos -> Store Pos a
move (Store f (x, y)) (dx, dy) = Store f (x + dx, y + dy)
count :: [Bool] -> Int
count = length . filter id
getNrAliveNeighs :: Store Pos Bool -> Int
getNrAliveNeighs s = count $ fmap (extract . move s) neighbours8
rule :: Store Pos Bool -> Bool
rule s = let n = getNrAliveNeighs s
in case (extract s) of
True -> 2 <= n && n <= 3
False -> n == 3
blockToStr :: [[Bool]] -> String
blockToStr = unlines . fmap (fmap f)
where
f True = '*'
f False = '.'
getBlock :: Int -> Store Pos a -> [[a]]
getBlock n store#(Store _ (x, y)) =
[[extract (move store (dx, dy)) | dy <- yrange] | dx <- xrange]
where
yrange = [(x - n)..(y + n)]
xrange = reverse yrange
example :: IO ()
example = putStrLn
$ unlines
$ take 7
$ fmap (blockToStr . getBlock 5)
$ iterate (extend rule) seed
The store comonad per se doesn't really store anything (except in an abstract sense that a function is a “container”), but has to compute it from scratch. That clearly gets very inefficient over a couple of iterations.
You can alleviate this with no change to your code though, if you just back up the s -> a function with some memoisation:
import Data.MemoTrie
instance HasTrie s => Functor (Store s) where
fmap f (Store g s) = Store (memo $ f . g) s
instance HasTrie s => Comonad (Store s) where
extract (Store f a) = f a
duplicate (Store f s) = Store (Store f) s
Haven't tested whether this really gives acceptable performance.
Incidentally, Edward Kmett had an explicitly-memoised version in an old version of the comonad-extras package, but it's gone now. I've recently looked if that still works (seems like it does, after adjusting dependencies).

How to make a random function in fortran to generate the same random distribution into array?

I think my code below it's not exactly give me the same random distribution.
subroutine trig_random_value()
implicit none
integer :: t, z, y, x
real(real64) :: theta, r
real(real64), parameter :: PI=4.D0*DATAN(1.D0)
integer, dimension(12) :: date_time
integer, dimension(12) :: seed
call date_and_time(values=date_time)
call random_seed
seed = date_time(6) * date_time(7) + date_time(8)
call random_seed(put = seed)
do z = 1, z_size
do y = 1, y_size
do x = 1, x_size
theta = rand()*2*PI
r = 0.1*rand()
l1(1, z, y, x) = r*cos(theta)
l2(1, z, y, x) = r*sin(theta)
theta = rand()*2*PI
r = 0.1*rand()
l1(2, z, y, x) = r*cos(theta)
l2(2, z, y, x) = r*sin(theta)
end do
end do
end do
return
end subroutine trig_random_value
According to my code, I try to random value to l1(1,:,:,:), l1(2,:,:,:), l2(1,:,:,:) and l2(2,:,:,:) where l(t, x, y, z) is (3+1)-dimension array
Why do i use trigonometry function for my random function? because i want a circular randomization. If i plot distribution of l1(1,:,:,:) vs l2(1,:,:,:) or l1(2,:,:,:) vs l2(2,:,:,:) i will get circle shape distribution with radius 0.1
So, and why i tell you that this's not exactly give me a same distribution? because i was tried to measure a variance of them and i got
variance_l1_t1 = 1.6670507752921395E-003
variance_l1_t2 = 3.3313151655785292E-003
variance_l2_t1 = 4.9965623815717321E-003
variance_l2_t2 = 6.6641054728288360E-003
notice that (variance_l1_t2 - variance_l1_t1) = (variance_l2_t1 - variance_l1_t2) = (variance_l2_t2 - variance_l2_t1) = 0.00166
That's quite a weird result. In actually i should get almost the same variance value of l1(1,:,:,:), l1(2,:,:,:), l2(1,:,:,:) and l2(2,:,:,:) if this function if good random function. may be i did something wrong.
How to solve this problem?
Additional information from request:
real(real64) function find_variance(l)
implicit none
real(real64), dimension(z_size, y_size, x_size), intent(in) :: l
integer :: z, y, x
real(real64) :: l_avg = 0
real(real64) :: sum_val = 0
do z = 1, z_size
do y = 1, y_size
do x = 1, x_size
l_avg = l_avg + l(z, y, x)
end do
end do
end do
l_avg = l_avg/(z_size*y_size*x_size)
do z = 1, z_size
do y = 1, y_size
do x = 1, x_size
sum_val = sum_val + (l(z , y, x) - l_avg)**2
end do
end do
end do
find_variance = sum_val/(z_size*y_size*x_size)
return
end function find_variance
In modern Fortran, an initialization of variables such as
real(real64) :: sum_val = 0
means that sum_val is a variable with the SAVE attribute (which is similar to static in C), which is initialized only once when the program starts. It is equivalent to
real(real64), save :: sum_val = 0
The value of the SAVEed variable is kept during the entire run and it will not be initialized to 0 again. To fix this, simply replace
real(real64) :: sum_val !! this is a usual local variable
sum_val = 0 !! or sum_val = real( 0, real64 )
then I guess it should be fine. Please see this page for more details.
IMO this is one of the very confusing features of Fortran...

Haskell performance of memoization implement of dynamic programming is poor [duplicate]

I'm trying to memoize the following function:
gridwalk x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (gridwalk (x - 1) y) + (gridwalk x (y - 1))
Looking at this I came up with the following solution:
gw :: (Int -> Int -> Int) -> Int -> Int -> Int
gw f x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (f (x - 1) y) + (f x (y - 1))
gwlist :: [Int]
gwlist = map (\i -> gw fastgw (i `mod` 20) (i `div` 20)) [0..]
fastgw :: Int -> Int -> Int
fastgw x y = gwlist !! (x + y * 20)
Which I then can call like this:
gw fastgw 20 20
Is there an easier, more concise and general way (notice how I had to hardcode the max grid dimensions in the gwlist function in order to convert from 2D to 1D space so I can access the memoizing list) to memoize functions with multiple parameters in Haskell?
You can use a list of lists to memoize the function result for both parameters:
memo :: (Int -> Int -> a) -> [[a]]
memo f = map (\x -> map (f x) [0..]) [0..]
gw :: Int -> Int -> Int
gw 0 _ = 1
gw _ 0 = 1
gw x y = (fastgw (x - 1) y) + (fastgw x (y - 1))
gwstore :: [[Int]]
gwstore = memo gw
fastgw :: Int -> Int -> Int
fastgw x y = gwstore !! x !! y
Use the data-memocombinators package from hackage. It provides easy to use memorization techniques and provides an easy and breve way to use them:
import Data.MemoCombinators (memo2,integral)
gridwalk = memo2 integral integral gridwalk' where
gridwalk' x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (gridwalk (x - 1) y) + (gridwalk x (y - 1))
Here is a version using Data.MemoTrie from the MemoTrie package to memoize the function:
import Data.MemoTrie(memo2)
gridwalk :: Int -> Int -> Int
gridwalk = memo2 gw
where
gw 0 _ = 1
gw _ 0 = 1
gw x y = gridwalk (x - 1) y + gridwalk x (y - 1)
If you want maximum generality, you can memoize a memoizing function.
memo :: (Num a, Enum a) => (a -> b) -> [b]
memo f = map f (enumFrom 0)
gwvals = fmap memo (memo gw)
fastgw :: Int -> Int -> Int
fastgw x y = gwvals !! x !! y
This technique will work with functions that have any number of arguments.
Edit: thanks to Philip K. for pointing out a bug in the original code. Originally memo had a "Bounded" constraint instead of "Num" and began the enumeration at minBound, which would only be valid for natural numbers.
Lists aren't a good data structure for memoizing, though, because they have linear lookup complexity. You might be better off with a Map or IntMap. Or look on Hackage.
Note that this particular code does rely on laziness, so if you wanted to switch to using a Map you would need to take a bounded amount of elements from the list, as in:
gwByMap :: Int -> Int -> Int -> Int -> Int
gwByMap maxX maxY x y = fromMaybe (gw x y) $ M.lookup (x,y) memomap
where
memomap = M.fromList $ concat [[((x',y'),z) | (y',z) <- zip [0..maxY] ys]
| (x',ys) <- zip [0..maxX] gwvals]
fastgw2 :: Int -> Int -> Int
fastgw2 = gwByMap 20 20
I think ghc may be stupid about sharing in this case, you may need to lift out the x and y parameters, like this:
gwByMap maxX maxY = \x y -> fromMaybe (gw x y) $ M.lookup (x,y) memomap

Netwire 5 - A box cannot bounce

I am trying to convert challenge 3 ( https://ocharles.org.uk/blog/posts/2013-08-01-getting-started-with-netwire-and-sdl.html ) from netwire 4.0 to netwire 5.0 using OpenGL. Unfortunately, the box cannot bounce. The entire code is following. It seems to me that the function velocity does not work. When the box collides with a wall, it does not bounce but stops. How do I correct my program? Thanks in advance.
{-# LANGUAGE Arrows #-}
import Graphics.Rendering.OpenGL
import Graphics.UI.GLFW
import Data.IORef
import Prelude hiding ((.))
import Control.Monad.Fix (MonadFix)
import Control.Wire
import FRP.Netwire
isKeyDown :: (Enum k, Monoid e) => k -> Wire s e IO a e
isKeyDown k = mkGen_ $ \_ -> do
s <- getKey k
return $ case s of
Press -> Right mempty
Release -> Left mempty
acceleration :: (Monoid e) => Wire s e IO a Double
acceleration = pure ( 0) . isKeyDown (CharKey 'A') . isKeyDown (CharKey 'D')
<|> pure (-0.5) . isKeyDown (CharKey 'A')
<|> pure ( 0.5) . isKeyDown (CharKey 'D')
<|> pure ( 0)
velocity :: (Monad m, HasTime t s, Monoid e) => Wire s e m (Double, Bool) Double
velocity = integralWith bounce 0
where bounce c v
| c = (-v)
| otherwise = v
collided :: (Ord a, Fractional a) => (a, a) -> a -> (a, Bool)
collided (a, b) x
| x < a = (a, True)
| x > b = (b, True)
| otherwise = (x, False)
position' :: (Monad m, HasTime t s) => Wire s e m Double (Double, Bool)
position' = integral 0 >>> (arr $ collided (-0.8, 0.8))
challenge3 :: (HasTime t s) => Wire s () IO a Double
challenge3 = proc _ -> do
rec a <- acceleration -< ()
v <- velocity -< (a, c)
(p, c) <- position' -< v
returnA -< p
s :: Double
s = 0.05
y :: Double
y = 0.0
renderPoint :: (Double, Double) -> IO ()
renderPoint (x, y) = vertex $ Vertex2 (realToFrac x :: GLfloat) (realToFrac y :: GLfloat)
generatePoints :: Double -> Double -> Double -> [(Double, Double)]
generatePoints x y s =
[ (x - s, y - s)
, (x + s, y - s)
, (x + s, y + s)
, (x - s, y + s) ]
runNetwork :: (HasTime t s) => IORef Bool -> Session IO s -> Wire s e IO a Double -> IO ()
runNetwork closedRef session wire = do
pollEvents
closed <- readIORef closedRef
if closed
then return ()
else do
(st , session') <- stepSession session
(wt', wire' ) <- stepWire wire st $ Right undefined
case wt' of
Left _ -> return ()
Right x -> do
clear [ColorBuffer]
renderPrimitive Quads $
mapM_ renderPoint $ generatePoints x y s
swapBuffers
runNetwork closedRef session' wire'
main :: IO ()
main = do
initialize
openWindow (Size 1024 512) [DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24] Window
closedRef <- newIORef False
windowCloseCallback $= do
writeIORef closedRef True
return True
runNetwork closedRef clockSession_ challenge3
closeWindow
By experience, I think the trick here is the fact that you technically have to bounce a few pixels before the actual collision, because if you detect it when it happens, then the inertia put your square a little bit "in" the wall, and so velocity is constantly reversed, causing your square to be blocked.
Ocharles actually nods to it in the blog post :
If this position falls outside the world bounds, we adjust the square (with a small epsilon to stop it getting stuck in the wall) and return the collision information.
Good luck with Netwire 5, I'm playing with it too, and I just begin to like it. ;)

Resources