How to optimize the following algorithms

I want to write a grid library,the code like belows

data HMesh m v hf f c=HMesh{
    hmesh_get_vertices:: HMap.HashMap Int (HVertex v),
    hmesh_get_halffaces:: HMap.HashMap Int (HHalfFace hf),
    hmesh_get_faces:: HMap.HashMap Int (HFace f),
    hmesh_get_cells:: HMap.HashMap Int (HCell c),
    hmesh_get_vertices_name_id:: Int,
    hmesh_get_halffaces_name_id:: Int,
    hmesh_get_faces_name_id:: Int,
    hmesh_get_cells_name_id:: Int, 
    hmesh_get_dimension:: Int,
    hmesh_get_simplex:: Bool,
    hmesh_get_manifold_require:: Bool,
    hmesh_get_traits:: (Maybe m)
}deriving (Show)

When I create a mesh that contains 10000 triangles,my program runs well.
When I create a mesh that contains 400000 triangle, my program runs so slowly that I can’t wait for it’s result.
The every operation need to alter the mesh, I suspect Haskell needs to recalculate the data HMesh every time.

I want to know how to optimize this problem?I think the key point is to optimize the HashMap to avoid recalculate container.

Can any one give me some suggestions? This question frustrated me with haskell.

Maybe you’ll have some luck if you turn on {-# LANGUAGE StrictData #-} at the top of your module. If not then I think we’re going to need to see more code.

Thank you! but It has a new problem:
libcell:: Preclude.read:no parse.
My code is complex,the key point is to update containers frequently.such as


myhmesh_create_cell::[Int]->[Int]->HMesh m v hf f c->(HMesh m v hf f c,Maybe(HCell c))
myhmesh_create_cell vs hfs mesh =(nmesh,Just cc)
    where
        myfun::Int->HHalfFace hf->HHalfFace hf
        myfun id1 (HHalfFace id2 vers2 c2 f2 t2)=HHalfFace id2 vers2 id1 f2 t2 
        myfun1::Int->HVertex v->HVertex v
        myfun1 id1 (HVertex id2 p c2 f2 t2)=HVertex id2 p (id1:c2) f2 t2
        vs1=map ((\(Just x)->x).hmesh_get_vertex mesh) vs
        hfs1=map ((\(Just x)->x).hmesh_get_halfface mesh) hfs  
        id=hmesh_get_cells_name_id mesh 
        cc=HCell id vs hfs Nothing
        hfmap=hmesh_get_halffaces mesh
        vmap=hmesh_get_vertices mesh
        cmap=hmesh_get_cells mesh 
        nhfmap =foldr (\vv mm ->HMap.insert (hhalfface_get_id vv) vv mm) hfmap $ map (myfun id) hfs1
        nvmap=foldr (\vv mm->HMap.insert (hvertex_get_id vv) vv mm) vmap $ map (myfun1 id) vs1
        ncmap=HMap.insert id cc cmap
        nmesh= hmesh_replace_vmap nvmap. hmesh_replace_hfmap nhfmap.hmesh_replace_cmap ncmap.hmesh_replace_cnid (id+1)$mesh

 

Is it possible to optimize Haskell’s program with llvm or other tools?
This library is rewriting of high dimension grid Library in C language,at begining I’m very excited to use Haskell.
Now I’m disappointment. I have to write code interacting with c language,which means I can’t use language of pure function.

This means you’re using read somewhere (in libcell function?) that failed. You better use readMaybe to handle failures.

You’ll probably want to use strict foldl' instead of foldr as you want to perform all folds. foldr is more appropriate when your function can exit early. Make sure to use foldl' instead of foldl to not build up thunks.

This should at least improve memory efficiency, not sure what to do about the runtime performance.

Why this problem occurs when I turn on {-#LANGUAGE StrictData#-}?

Normally, a field can contain a suspended computation (called a thunk) that might eventually produce an error, so the errors will only appear if that field is actually used. StrictData will make sure that all the fields of your custom data structures are evaluated the moment they are created. So if the field with the error is not used then without StrictData the error would just remain inside the thunk, with StrictData the error appears when creating the data structure even if it is not used later.

There are still some limitations to StrictData. Most importantly it will only “peel off” one layer of the suspended computation. If you store a normal lazy list in a field then the only thing that will be forced is the first cons cell of the structure of the list (so it will determine whether the list is empty or has at least one element). But the elements of the list and the full structure will not be forced.

An important search term is “weak head normal form”, see this stackoverflow question and this wikibook section.

2 Likes

Is it necessary to use strict HashMap?

Do you really need a hashmap? Won’t a simple array also work?

If you really need a hashmap and you want to do a lot of mutations then you might want to look at mutable hashtables: https://hackage.haskell.org/package/hashtables.

Thank you very much! I learn a lot!
I’d rather choose to interact with c than mutable hashtables, because it’s equivalent.

Do you have any other suggestions?

Not really, I think this problem needs a mutable solution if you really want it to be fast. I still don’t think C is equivalent to Haskell for writing mutable code. Haskell has more safety guarantees and it obviously integrates better with other higher-level Haskell code, but it can be more annoying to write and there are some performance pitfalls. Maybe Rust is a better middle ground? Although, I think it is easier to combine C and Haskell than Rust and Haskell.

Well :heartbeat:,I got it.