fei-cocoapi (empty) → 0.2.0
raw patch · 12 files changed
+1715/−0 lines, 12 filesdep +JuicyPixelsdep +JuicyPixels-extradep +JuicyPixels-repa
Dependencies added: JuicyPixels, JuicyPixels-extra, JuicyPixels-repa, aeson, attoparsec, base, bytestring, conduit, containers, criterion, directory, exceptions, fei-base, fei-cocoapi, fei-dataiter, filepath, lens, mtl, random-fu, repa, storable-tuple, store, time, transformers-base, vector
Files
- LICENSE +29/−0
- cbits/maskApi.c +231/−0
- cbits/maskApi.h +60/−0
- examples/Mask.hs +87/−0
- examples/Profiling.hs +23/−0
- fei-cocoapi.cabal +89/−0
- src/MXNet/Coco/Index.hs +28/−0
- src/MXNet/Coco/Mask.hs +99/−0
- src/MXNet/Coco/Raw.chs +315/−0
- src/MXNet/Coco/Types.hs +166/−0
- src/MXNet/NN/DataIter/Anchor.hs +236/−0
- src/MXNet/NN/DataIter/Coco.hs +352/−0
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, Jiasen Wu+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ cbits/maskApi.c view
@@ -0,0 +1,231 @@+/**************************************************************************+* Microsoft COCO Toolbox. version 2.0+* Data, paper, and tutorials available at: http://mscoco.org/+* Code written by Piotr Dollar and Tsung-Yi Lin, 2015.+* Licensed under the Simplified BSD License [see coco/license.txt]+**************************************************************************/+#include "maskApi.h"+#include <math.h>+#include <stdlib.h>++uint umin( uint a, uint b ) { return (a<b) ? a : b; }+uint umax( uint a, uint b ) { return (a>b) ? a : b; }++void rleInit( RLE *R, siz h, siz w, siz m, uint *cnts ) {+ R->h=h; R->w=w; R->m=m; R->cnts=(m==0)?0:malloc(sizeof(uint)*m);+ siz j; if(cnts) for(j=0; j<m; j++) R->cnts[j]=cnts[j];+}++void rleFree( RLE *R ) {+ free(R->cnts); R->cnts=0;+}++void rlesInit( RLE **R, siz n ) {+ siz i; *R = (RLE*) malloc(sizeof(RLE)*n);+ for(i=0; i<n; i++) rleInit((*R)+i,0,0,0,0);+}++void rlesFree( RLE **R, siz n ) {+ siz i; for(i=0; i<n; i++) rleFree((*R)+i); free(*R); *R=0;+}++void rleEncode( RLE *R, const byte *M, siz h, siz w, siz n ) {+ siz i, j, k, a=w*h; uint c, *cnts; byte p;+ cnts = malloc(sizeof(uint)*(a+1));+ for(i=0; i<n; i++) {+ const byte *T=M+a*i; k=0; p=0; c=0;+ for(j=0; j<a; j++) { if(T[j]!=p) { cnts[k++]=c; c=0; p=T[j]; } c++; }+ cnts[k++]=c; rleInit(R+i,h,w,k,cnts);+ }+ free(cnts);+}++void rleDecode( const RLE *R, byte *M, siz n ) {+ siz i, j, k; for( i=0; i<n; i++ ) {+ byte v=0; for( j=0; j<R[i].m; j++ ) {+ for( k=0; k<R[i].cnts[j]; k++ ) *(M++)=v; v=!v; }}+}++void rleMerge( const RLE *R, RLE *M, siz n, int intersect ) {+ uint *cnts, c, ca, cb, cc, ct; int v, va, vb, vp;+ siz i, a, b, h=R[0].h, w=R[0].w, m=R[0].m; RLE A, B;+ if(n==0) { rleInit(M,0,0,0,0); return; }+ if(n==1) { rleInit(M,h,w,m,R[0].cnts); return; }+ cnts = malloc(sizeof(uint)*(h*w+1));+ for( a=0; a<m; a++ ) cnts[a]=R[0].cnts[a];+ for( i=1; i<n; i++ ) {+ B=R[i]; if(B.h!=h||B.w!=w) { h=w=m=0; break; }+ rleInit(&A,h,w,m,cnts); ca=A.cnts[0]; cb=B.cnts[0];+ v=va=vb=0; m=0; a=b=1; cc=0; ct=1;+ while( ct>0 ) {+ c=umin(ca,cb); cc+=c; ct=0;+ ca-=c; if(!ca && a<A.m) { ca=A.cnts[a++]; va=!va; } ct+=ca;+ cb-=c; if(!cb && b<B.m) { cb=B.cnts[b++]; vb=!vb; } ct+=cb;+ vp=v; if(intersect) v=va&&vb; else v=va||vb;+ if( v!=vp||ct==0 ) { cnts[m++]=cc; cc=0; }+ }+ rleFree(&A);+ }+ rleInit(M,h,w,m,cnts); free(cnts);+}++void rleArea( const RLE *R, siz n, uint *a ) {+ siz i, j; for( i=0; i<n; i++ ) {+ a[i]=0; for( j=1; j<R[i].m; j+=2 ) a[i]+=R[i].cnts[j]; }+}++void rleIou( RLE *dt, RLE *gt, siz m, siz n, byte *iscrowd, double *o ) {+ siz g, d; BB db, gb; int crowd;+ db=malloc(sizeof(double)*m*4); rleToBbox(dt,db,m);+ gb=malloc(sizeof(double)*n*4); rleToBbox(gt,gb,n);+ bbIou(db,gb,m,n,iscrowd,o); free(db); free(gb);+ for( g=0; g<n; g++ ) for( d=0; d<m; d++ ) if(o[g*m+d]>0) {+ crowd=iscrowd!=NULL && iscrowd[g];+ if(dt[d].h!=gt[g].h || dt[d].w!=gt[g].w) { o[g*m+d]=-1; continue; }+ siz ka, kb, a, b; uint c, ca, cb, ct, i, u; int va, vb;+ ca=dt[d].cnts[0]; ka=dt[d].m; va=vb=0;+ cb=gt[g].cnts[0]; kb=gt[g].m; a=b=1; i=u=0; ct=1;+ while( ct>0 ) {+ c=umin(ca,cb); if(va||vb) { u+=c; if(va&&vb) i+=c; } ct=0;+ ca-=c; if(!ca && a<ka) { ca=dt[d].cnts[a++]; va=!va; } ct+=ca;+ cb-=c; if(!cb && b<kb) { cb=gt[g].cnts[b++]; vb=!vb; } ct+=cb;+ }+ if(i==0) u=1; else if(crowd) rleArea(dt+d,1,&u);+ o[g*m+d] = (double)i/(double)u;+ }+}++void rleNms( RLE *dt, siz n, uint *keep, double thr ) {+ siz i, j; double u;+ for( i=0; i<n; i++ ) keep[i]=1;+ for( i=0; i<n; i++ ) if(keep[i]) {+ for( j=i+1; j<n; j++ ) if(keep[j]) {+ rleIou(dt+i,dt+j,1,1,0,&u);+ if(u>thr) keep[j]=0;+ }+ }+}++void bbIou( BB dt, BB gt, siz m, siz n, byte *iscrowd, double *o ) {+ double h, w, i, u, ga, da; siz g, d; int crowd;+ for( g=0; g<n; g++ ) {+ BB G=gt+g*4; ga=G[2]*G[3]; crowd=iscrowd!=NULL && iscrowd[g];+ for( d=0; d<m; d++ ) {+ BB D=dt+d*4; da=D[2]*D[3]; o[g*m+d]=0;+ w=fmin(D[2]+D[0],G[2]+G[0])-fmax(D[0],G[0]); if(w<=0) continue;+ h=fmin(D[3]+D[1],G[3]+G[1])-fmax(D[1],G[1]); if(h<=0) continue;+ i=w*h; u = crowd ? da : da+ga-i; o[g*m+d]=i/u;+ }+ }+}++void bbNms( BB dt, siz n, uint *keep, double thr ) {+ siz i, j; double u;+ for( i=0; i<n; i++ ) keep[i]=1;+ for( i=0; i<n; i++ ) if(keep[i]) {+ for( j=i+1; j<n; j++ ) if(keep[j]) {+ bbIou(dt+i*4,dt+j*4,1,1,0,&u);+ if(u>thr) keep[j]=0;+ }+ }+}++void rleToBbox( const RLE *R, BB bb, siz n ) {+ siz i; for( i=0; i<n; i++ ) {+ uint h, w, x, y, xs, ys, xe, ye, xp, cc, t; siz j, m;+ h=(uint)R[i].h; w=(uint)R[i].w; m=R[i].m;+ m=((siz)(m/2))*2; xs=w; ys=h; xe=ye=0; cc=0;+ if(m==0) { bb[4*i+0]=bb[4*i+1]=bb[4*i+2]=bb[4*i+3]=0; continue; }+ for( j=0; j<m; j++ ) {+ cc+=R[i].cnts[j]; t=cc-j%2; y=t%h; x=(t-y)/h;+ if(j%2==0) xp=x; else if(xp<x) { ys=0; ye=h-1; }+ xs=umin(xs,x); xe=umax(xe,x); ys=umin(ys,y); ye=umax(ye,y);+ }+ bb[4*i+0]=xs; bb[4*i+2]=xe-xs+1;+ bb[4*i+1]=ys; bb[4*i+3]=ye-ys+1;+ }+}++void rleFrBbox( RLE *R, const BB bb, siz h, siz w, siz n ) {+ siz i; for( i=0; i<n; i++ ) {+ double xs=bb[4*i+0], xe=xs+bb[4*i+2];+ double ys=bb[4*i+1], ye=ys+bb[4*i+3];+ double xy[8] = {xs,ys,xs,ye,xe,ye,xe,ys};+ rleFrPoly( R+i, xy, 4, h, w );+ }+}++int uintCompare(const void *a, const void *b) {+ uint c=*((uint*)a), d=*((uint*)b); return c>d?1:c<d?-1:0;+}++void rleFrPoly( RLE *R, const double *xy, siz k, siz h, siz w ) {+ /* upsample and get discrete points densely along entire boundary */+ siz j, m=0; double scale=5; int *x, *y, *u, *v; uint *a, *b;+ x=malloc(sizeof(int)*(k+1)); y=malloc(sizeof(int)*(k+1));+ for(j=0; j<k; j++) x[j]=(int)(scale*xy[j*2+0]+.5); x[k]=x[0];+ for(j=0; j<k; j++) y[j]=(int)(scale*xy[j*2+1]+.5); y[k]=y[0];+ for(j=0; j<k; j++) m+=umax(abs(x[j]-x[j+1]),abs(y[j]-y[j+1]))+1;+ u=malloc(sizeof(int)*m); v=malloc(sizeof(int)*m); m=0;+ for( j=0; j<k; j++ ) {+ int xs=x[j], xe=x[j+1], ys=y[j], ye=y[j+1], dx, dy, t, d;+ int flip; double s; dx=abs(xe-xs); dy=abs(ys-ye);+ flip = (dx>=dy && xs>xe) || (dx<dy && ys>ye);+ if(flip) { t=xs; xs=xe; xe=t; t=ys; ys=ye; ye=t; }+ s = dx>=dy ? (double)(ye-ys)/dx : (double)(xe-xs)/dy;+ if(dx>=dy) for( d=0; d<=dx; d++ ) {+ t=flip?dx-d:d; u[m]=t+xs; v[m]=(int)(ys+s*t+.5); m++;+ } else for( d=0; d<=dy; d++ ) {+ t=flip?dy-d:d; v[m]=t+ys; u[m]=(int)(xs+s*t+.5); m++;+ }+ }+ /* get points along y-boundary and downsample */+ free(x); free(y); k=m; m=0; double xd, yd;+ x=malloc(sizeof(int)*k); y=malloc(sizeof(int)*k);+ for( j=1; j<k; j++ ) if(u[j]!=u[j-1]) {+ xd=(double)(u[j]<u[j-1]?u[j]:u[j]-1); xd=(xd+.5)/scale-.5;+ if( floor(xd)!=xd || xd<0 || xd>w-1 ) continue;+ yd=(double)(v[j]<v[j-1]?v[j]:v[j-1]); yd=(yd+.5)/scale-.5;+ if(yd<0) yd=0; else if(yd>h) yd=h; yd=ceil(yd);+ x[m]=(int) xd; y[m]=(int) yd; m++;+ }+ /* compute rle encoding given y-boundary points */+ k=m; a=malloc(sizeof(uint)*(k+1));+ for( j=0; j<k; j++ ) a[j]=(uint)(x[j]*(int)(h)+y[j]);+ a[k++]=(uint)(h*w); free(u); free(v); free(x); free(y);+ qsort(a,k,sizeof(uint),uintCompare); uint p=0;+ for( j=0; j<k; j++ ) { uint t=a[j]; a[j]-=p; p=t; }+ b=malloc(sizeof(uint)*k); j=m=0; b[m++]=a[j++];+ while(j<k) if(a[j]>0) b[m++]=a[j++]; else {+ j++; if(j<k) b[m-1]+=a[j++]; }+ rleInit(R,h,w,m,b); free(a); free(b);+}++char* rleToString( const RLE *R ) {+ /* Similar to LEB128 but using 6 bits/char and ascii chars 48-111. */+ siz i, m=R->m, p=0; long x; int more;+ char *s=malloc(sizeof(char)*m*6);+ for( i=0; i<m; i++ ) {+ x=(long) R->cnts[i]; if(i>2) x-=(long) R->cnts[i-2]; more=1;+ while( more ) {+ char c=x & 0x1f; x >>= 5; more=(c & 0x10) ? x!=-1 : x!=0;+ if(more) c |= 0x20; c+=48; s[p++]=c;+ }+ }+ s[p]=0; return s;+}++void rleFrString( RLE *R, char *s, siz h, siz w ) {+ siz m=0, p=0, k; long x; int more; uint *cnts;+ while( s[m] ) m++; cnts=malloc(sizeof(uint)*m); m=0;+ while( s[p] ) {+ x=0; k=0; more=1;+ while( more ) {+ char c=s[p]-48; x |= (c & 0x1f) << 5*k;+ more = c & 0x20; p++; k++;+ if(!more && (c & 0x10)) x |= -1 << 5*k;+ }+ if(m>2) x+=(long) cnts[m-2]; cnts[m++]=(uint) x;+ }+ rleInit(R,h,w,m,cnts); free(cnts);+}
+ cbits/maskApi.h view
@@ -0,0 +1,60 @@+/**************************************************************************+* Microsoft COCO Toolbox. version 2.0+* Data, paper, and tutorials available at: http://mscoco.org/+* Code written by Piotr Dollar and Tsung-Yi Lin, 2015.+* Licensed under the Simplified BSD License [see coco/license.txt]+**************************************************************************/+#pragma once++typedef unsigned int uint;+typedef unsigned long siz;+typedef unsigned char byte;+typedef double* BB;+typedef struct { siz h, w, m; uint *cnts; } RLE;++/* Initialize/destroy RLE. */+void rleInit( RLE *R, siz h, siz w, siz m, uint *cnts );+void rleFree( RLE *R );++/* Initialize/destroy RLE array. */+void rlesInit( RLE **R, siz n );+void rlesFree( RLE **R, siz n );++/* Encode binary masks using RLE. */+void rleEncode( RLE *R, const byte *mask, siz h, siz w, siz n );++/* Decode binary masks encoded via RLE. */+void rleDecode( const RLE *R, byte *mask, siz n );++/* Compute union or intersection of encoded masks. */+void rleMerge( const RLE *R, RLE *M, siz n, int intersect );++/* Compute area of encoded masks. */+void rleArea( const RLE *R, siz n, uint *a );++/* Compute intersection over union between masks. */+void rleIou( RLE *dt, RLE *gt, siz m, siz n, byte *iscrowd, double *o );++/* Compute non-maximum suppression between bounding masks */+void rleNms( RLE *dt, siz n, uint *keep, double thr );++/* Compute intersection over union between bounding boxes. */+void bbIou( BB dt, BB gt, siz m, siz n, byte *iscrowd, double *o );++/* Compute non-maximum suppression between bounding boxes */+void bbNms( BB dt, siz n, uint *keep, double thr );++/* Get bounding boxes surrounding encoded masks. */+void rleToBbox( const RLE *R, BB bb, siz n );++/* Convert bounding boxes to encoded masks. */+void rleFrBbox( RLE *R, const BB bb, siz h, siz w, siz n );++/* Convert polygon to encoded mask. */+void rleFrPoly( RLE *R, const double *xy, siz k, siz h, siz w );++/* Get compressed string representation of encoded mask. */+char* rleToString( const RLE *R );++/* Convert from compressed string representation of encoded mask. */+void rleFrString( RLE *R, char *s, siz h, siz w );
+ examples/Mask.hs view
@@ -0,0 +1,87 @@+module Main where++import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString as SBS+import Control.Lens ((^.), (^?), ix)+import qualified Data.Vector as V+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Unboxed as UV+import qualified Data.Aeson as Aeson+import qualified Data.Array.Repa as RP+import Data.Array.Repa ((:.)(..), Z(..))+import qualified Data.Array.Repa.Repr.ForeignPtr as RF+import Codec.Picture as JP+import Codec.Picture.Repa+import qualified Data.Store as Store+import Control.Exception.Base++import MXNet.Coco.Mask+import MXNet.Coco.Types+import MXNet.Coco.Index++data Y8++class ToDynamicImage a where+ toDynamicImage :: Img a -> DynamicImage++instance ToDynamicImage Y8 where+ toDynamicImage (Img arr0) = ImageY8 $ JP.Image w h (SV.unsafeFromForeignPtr0 (RF.toForeignPtr arr) (h*w*z) )+ where + (Z :. h :. w :. z) = RP.extent arr+ arr = RP.computeS arr0 + +readFromCache path = do+ bs <- SBS.readFile path+ Store.decodeIO bs++readFromJson path = do+ bs <- BS.readFile path+ case Aeson.decode' bs of+ Nothing -> error $ "cannot parse annotation file: " ++ path+ Just inst -> return inst++store path obj = do + SBS.writeFile path (Store.encode obj)+ return obj++readAnnotations path =+ readFromCache cache_file `catch` (\ e -> do+ let _ = e :: IOException+ readFromJson path >>= + store cache_file)+ where+ cache_file = "./instance.store"++annotatino_file = "/home/jiasen/dschungel/coco/annotations/instances_train2017.json"++main = do+ inst <- readAnnotations annotatino_file+ mapM_ (\cat -> putStrLn $ cat ^. odc_name) $ allCats inst + let anno = V.head $ allAnns inst+ imgId = anno ^. ann_image_id+ img = V.head $ V.filter (\img -> img ^. img_id == imgId) (inst ^. images)+ height = img ^. img_height+ width = img ^. img_width+ + store "./imgs.store" $ inst ^. images+ store "./anns.store" $ inst ^. annotations+ store "./cats.store" $ inst ^. categories+ ++ -- putStrLn $ show imgId++ -- crle <- case anno ^. ann_segmentation of + -- SegRLE cnts _ -> frUncompressedRLE cnts height width+ -- SegPolygon polys -> frPoly (map SV.fromList polys) height width++ -- mask <- decode crle++ -- let Z :. c :. w :. h = RP.extent mask+ -- maskHW = RP.backpermute (Z :. h :. w :. c) (\ (Z :. c :. w :. h) -> Z :. h :. w :. c) mask+ -- maskImg = toDynamicImage $ (Img $ RP.map (*255) maskHW :: Img Y8)++ -- savePngImage "a.png" maskImg++ -- putStrLn $ img ^. img_file_name+ -- putStrLn $ img ^. img_flickr_url+ -- putStrLn $ img ^. img_coco_url
+ examples/Profiling.hs view
@@ -0,0 +1,23 @@+import Criterion.Main+import Criterion.Main.Options+import Data.Store+import qualified Data.IntSet as Set+import qualified Data.ByteString as BS+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as UV+import Data.Array.Repa ((:.)(..), Z (..), fromUnboxed, computeUnboxedP, computeUnboxedS)++import MXNet.NN.DataIter.Anchor++main = do+ goodIndices <- BS.readFile "examples/goodIndices.bin" >>= decodeIO :: IO (V.Vector Int)+ gtBoxes <- BS.readFile "examples/gtBoxes.bin" >>= decodeIO :: IO (V.Vector (UV.Vector Float))+ anchors <- BS.readFile "examples/anchors.bin" >>= decodeIO :: IO (V.Vector (UV.Vector Float))+ goodIndices <- return $ Set.fromList $ V.toList goodIndices :: IO Set.IntSet+ gtBoxes <- return $ V.map (fromUnboxed (Z:.(5::Int))) gtBoxes+ anchors <- return $ V.map (fromUnboxed (Z:.(4::Int))) anchors++ defaultMain+ [ bench "computeUnboxedP" $ whnfIO $ computeUnboxedP $ overlapMatrix goodIndices gtBoxes anchors+ , bench "computeUnboxedS" $ whnf computeUnboxedS $ overlapMatrix goodIndices gtBoxes anchors+ ]
+ fei-cocoapi.cabal view
@@ -0,0 +1,89 @@+name: fei-cocoapi+version: 0.2.0+synopsis: Cocodataset with cocoapi+description: Haskell binding for the cocoapi in c+homepage: http://github.com/pierric/fei-cocoapi+license: BSD3+license-file: LICENSE+author: Jiasen Wu+maintainer: jiasenwu@hotmail.com+copyright: Copyright: (c) 2019 Jiasen Wu+category: Machine Learning, AI+build-type: Simple+cabal-version: 1.24+extra-source-files: cbits/*.h, cbits/*.c++Library+ exposed-modules: MXNet.Coco.Types+ MXNet.Coco.Mask+ MXNet.Coco.Index+ MXNet.NN.DataIter.Coco+ MXNet.NN.DataIter.Anchor+ other-modules: MXNet.Coco.Raw+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010+ default-extensions: GADTs,+ TypeFamilies,+ OverloadedLabels,+ FlexibleContexts,+ StandaloneDeriving,+ DeriveGeneric,+ TypeOperators+ build-depends: base >= 4.7 && < 5.0+ , storable-tuple+ , vector >= 0.12+ , mtl >= 2.2+ , lens >= 4.12+ , transformers-base >= 0.4.4+ , aeson >= 1.2+ , containers >= 0.5+ , bytestring >= 0.10+ , exceptions >= 0.8.3+ , time < 2.0+ , repa >= 3.4+ , JuicyPixels+ , JuicyPixels-repa+ , JuicyPixels-extra+ , aeson >= 1.0 && <1.5+ , attoparsec (>=0.13.2.2 && <0.14)+ , lens >= 4.12+ , conduit >= 1.2 && < 1.4+ , store+ , filepath+ , directory+ , random-fu+ , fei-base+ , fei-dataiter+ Build-tools: c2hs+ c-sources: cbits/maskApi.c+ include-dirs: cbits/+ includes: maskApi.h++Executable mask+ hs-source-dirs: examples+ main-is: Mask.hs+ default-language: Haskell2010+ build-depends: base >= 4.7 && < 5.0,+ fei-cocoapi,+ bytestring,+ lens,+ aeson,+ vector,+ JuicyPixels,+ JuicyPixels-repa,+ repa,+ store++Executable profiling+ hs-source-dirs: examples+ main-is: Profiling.hs+ default-language: Haskell2010+ build-depends: base >= 4.7 && < 5.0,+ fei-cocoapi,+ criterion,+ store,+ repa,+ bytestring,+ vector,+ containers
+ src/MXNet/Coco/Index.hs view
@@ -0,0 +1,28 @@+module MXNet.Coco.Index where++import Control.Lens ((^.))+import qualified Data.Vector as V (Vector, filter, null, head)++import MXNet.Coco.Types++allCats :: Instance -> V.Vector Category+allCats = (^. categories)++allAnns :: Instance -> V.Vector Annotation+allAnns = (^. annotations)++catByName :: String -> V.Vector Category -> Maybe Category+catByName name = vecToMaybe . V.filter (\cat -> cat ^. odc_name == name)++annsByCat :: Category -> V.Vector Annotation -> V.Vector Annotation+annsByCat cat = V.filter (\ann -> ann ^. ann_category_id == cat ^. odc_id )++annsByImg :: Image -> V.Vector Annotation -> V.Vector Annotation+annsByImg img = V.filter (\ann -> ann ^. ann_image_id == img ^. img_id )++annByCatImg :: Image -> Category -> V.Vector Annotation -> Maybe Annotation+annByCatImg img cat = vecToMaybe . annsByCat cat . annsByImg img++vecToMaybe :: V.Vector a -> Maybe a+vecToMaybe vec | V.null vec = Nothing+ | otherwise = Just $ V.head vec
+ src/MXNet/Coco/Mask.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE TypeOperators #-}+module MXNet.Coco.Mask where++import Data.Word+import qualified Data.ByteString as BS+import Data.Array.Repa (Array, Z(..), (:.)(..), DIM1, DIM2, DIM3, extent)+import Data.Array.Repa.Repr.Unboxed+import qualified Data.Vector.Unboxed as UV (convert, length)+import qualified Data.Vector.Storable as SV (Vector, map, unsafeCast)++import MXNet.Coco.Raw++-- mask should be of 3 dimension and in CWH order+type Mask = Array U DIM3 Word8+type Area = Array U DIM1 Word32+type Iou = Array U DIM2 Double+type BBox = Array U DIM2 Double+type Poly = SV.Vector Double++data CompactRLE = CompactRLE Int Int [BS.ByteString]++encode :: Mask -> IO CompactRLE+encode mask = do+ let Z :. n :. w :. h = extent mask+ -- assuming Word8 are identical with CUChar+ rles <- rleEncode (SV.map fromIntegral $ UV.convert $ toUnboxed mask) h w n+ CompactRLE h w <$> mapM rleToString rles++decode :: CompactRLE -> IO Mask+decode im@(CompactRLE h w bss) = do+ let n = length bss+ rles <- frString im+ raw <- rleDecode rles h w+ return $ + fromUnboxed (Z :. n :. w :. h) $+ UV.convert $+ SV.map fromIntegral raw++merge :: CompactRLE -> Bool -> IO CompactRLE+merge im intersect = do+ let CompactRLE h w bss = im+ n = length bss+ if n > 1 then do+ rles <- frString im+ orle <- rleMerge rles intersect+ bs <- rleToString orle+ return $ CompactRLE h w [bs]+ else + return im++area :: CompactRLE -> IO Area+area im@(CompactRLE _ _ bss) = do+ let num = length bss+ rles <- frString im+ as <- rleArea rles num+ -- assuming the area can be represented as Word32+ return $ + fromListUnboxed (Z :. num) $+ map fromIntegral $ as++iouRLEs :: CompactRLE -> CompactRLE -> [Bool] -> IO Iou+iouRLEs dt gt iscrowd = do+ dt_rles <- frString dt+ gt_rles <- frString gt+ ((m, n), arr) <- rleIou dt_rles gt_rles iscrowd+ return $ fromListUnboxed (Z :. n :. m) arr++iouBBs :: BBox -> BBox -> [Bool] -> IO Iou+iouBBs bb1 bb2 iscrowd = do+ let bb1' = BB $ SV.unsafeCast $ UV.convert $ toUnboxed bb1+ bb2' = BB $ SV.unsafeCast $ UV.convert $ toUnboxed bb2+ ((m, n), arr) <- bbIou bb1' bb2' iscrowd+ return $ fromListUnboxed (Z :. n :. m) arr++toBBox :: CompactRLE -> IO BBox+toBBox im = do+ rles <- frString im+ BB bb <- rleToBbox rles+ let bb' = UV.convert $ SV.unsafeCast bb+ return $ fromUnboxed (Z :. UV.length bb' :. 4) bb'++frBBox :: BBox -> Int -> Int -> IO CompactRLE+frBBox bb h w = do+ rles <- rleFrBbox (BB $ SV.unsafeCast $ UV.convert $ toUnboxed bb) h w+ CompactRLE h w <$> mapM rleToString rles++frPoly :: [Poly] -> Int -> Int -> IO CompactRLE+frPoly polys h w = do+ rles <- mapM (\poly -> rleFrPoly (SV.unsafeCast poly) h w) polys+ CompactRLE h w <$> mapM rleToString rles++frUncompressedRLE :: [Int] -> Int -> Int -> IO CompactRLE+frUncompressedRLE raw h w = do+ orle <- rleInit h w (map fromIntegral raw)+ crle <- rleToString orle+ return $ CompactRLE h w [crle]++frString :: CompactRLE -> IO [RLE]+frString (CompactRLE h w bss) = mapM (\bs -> rleFrString bs h w) bss
+ src/MXNet/Coco/Raw.chs view
@@ -0,0 +1,315 @@+{-# LANGUAGE ScopedTypeVariables #-}+module MXNet.Coco.Raw where++import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.C.Types+import Foreign.C.String (CString)+import Foreign.Marshal.Array+import Foreign.Marshal.Alloc+import Foreign.Storable.Tuple ()+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Storable.Mutable as SVM+import qualified Data.ByteString as BS+import Control.Exception ++#include "maskApi.h"++data RLE = RLE {+ _rle_h :: Int,+ _rle_w :: Int,+ _rle_m :: Int,+ _rle_cnts :: ForeignPtr CUInt+}++makeRLE :: (Ptr () -> IO ()) -> IO RLE+makeRLE a = makeRLEs 1 a >>= return . head++makeRLEs :: Int -> (Ptr () -> IO ()) -> IO [RLE]+makeRLEs num a = allocaBytesAligned (num * {#sizeof RLE #}) {#alignof RLE#} (\prle -> do+ a prle+ go num prle [])+ where+ go 0 _ rles = return $ reverse rles+ go n prle rles = do+ rle <- peekRLE prle+ go (n-1) (prle `plusPtr` {#sizeof RLE#}) (rle : rles)++ peekRLE prle = do+ h <- fromIntegral <$> {#get RLE->h #} prle+ w <- fromIntegral <$> {#get RLE->w #} prle+ m <- fromIntegral <$> {#get RLE->m #} prle+ raw_c <- {#get RLE->cnts #} prle+ mgr_c <- newForeignPtr finalizerFree raw_c+ return $ RLE h w m mgr_c++withRLE :: RLE -> (Ptr () -> IO a) -> IO a+withRLE rle = withRLEs [rle]++withRLEs :: [RLE] -> (Ptr () -> IO a) -> IO a+withRLEs rles = withRLEsLen (length rles) rles++withRLEsLen :: Int -> [RLE] -> (Ptr () -> IO a) -> IO a+withRLEsLen num rles a = do+ allocaBytesAligned (num * {#sizeof RLE#}) {#alignof RLE#} $ \prles -> do+ go prles rles+ ret <- a prles+ mapM_ (touchForeignPtr . _rle_cnts) rles+ return ret+ where + go _ [] = return ()+ go prles (rle : nrles) = do+ pokeRLE prles rle+ go (prles `plusPtr` {#sizeof RLE#}) nrles++ -- must touch _rle_cnts after using the prle+ pokeRLE prle (RLE h w m c) = do+ {#set RLE.h #} prle (fromIntegral h)+ {#set RLE.w #} prle (fromIntegral w)+ {#set RLE.m #} prle (fromIntegral m)+ {#set RLE.cnts #} prle (unsafeForeignPtrToPtr c)++svUnsafeWith :: Storable a => SV.Vector a -> (Ptr a -> IO b) -> IO b+svUnsafeWith = SV.unsafeWith++newtype BB = BB (SV.Vector (CDouble, CDouble, CDouble, CDouble))++{#pointer BB as PtrBB #}++{#fun rleInit as rleInit_+ {+ `Ptr ()',+ `Int',+ `Int',+ `Int',+ id `Ptr CUInt'+ } -> `()'+#}++rleInit :: Int -> Int -> [CUInt] -> IO RLE+rleInit h w cnts = do+ makeRLE (\pr -> withArrayLen cnts (\m pc -> rleInit_ pr h w m pc))++-- cause the storage owned by rle to be freed immediately,+-- without not calling the c-api rleFree+rleFree :: RLE -> IO ()+rleFree rle = finalizeForeignPtr (_rle_cnts rle)++{#fun rleEncode as rleEncode_+ {+ `Ptr ()',+ id `Ptr CUChar',+ `Int',+ `Int',+ `Int'+ } -> `()'+#}+ +rleEncode :: SV.Vector CUChar -> Int -> Int -> Int -> IO [RLE]+rleEncode m h w n = do+ makeRLEs n (\ prle ->+ svUnsafeWith m (\pm -> do + rleEncode_ prle (castPtr pm) h w n))++{#fun rleDecode as rleDecode_+ {+ `Ptr ()',+ id `Ptr CUChar',+ `Int'+ } -> `()'+#}++rleDecode :: [RLE] -> Int -> Int -> IO (SV.Vector CUChar)+rleDecode rles h w = do+ let n = length rles + size = n * h * w+ mv <- SVM.new size+ SVM.unsafeWith mv $ (\ptr -> do+ withRLEsLen n rles $ \prles -> do+ rleDecode_ prles ptr n)+ SV.unsafeFreeze mv++{#fun rleMerge as rleMerge_+ {+ `Ptr ()',+ `Ptr ()',+ `Int',+ `Bool'+ } -> `()'+#}++rleMerge :: [RLE] -> Bool -> IO RLE+rleMerge rles intersect = do+ let num = length rles+ withRLEsLen num rles $ \prles -> + makeRLE $ \porle ->+ rleMerge_ prles porle num intersect++{#fun rleArea as rleArea_+ {+ withRLEs* `[RLE]',+ `Int',+ id `Ptr CUInt'+ } -> `()'+#}++rleArea :: [RLE] -> Int -> IO [CUInt]+rleArea r n = do+ allocaArray n (\pa -> do+ rleArea_ r n pa+ peekArray n pa)+ +{#fun rleIou as rleIou_+ {+ `Ptr ()',+ `Ptr ()',+ `Int',+ `Int',+ svUnsafeWith* `SV.Vector CUChar',+ id `Ptr CDouble'+ } -> `()'+#}++rleIou :: [RLE] -> [RLE] -> [Bool] -> IO ((Int,Int), [Double])+rleIou dt gt iscrowd = do+ let m = length dt+ n = length gt+ c = length iscrowd+ assert (n == c) $ allocaArray (m*n) $ \po -> + withRLEsLen m dt $ \pdt -> + withRLEsLen n gt $ \pgt -> do + rleIou_ pdt pgt m n (SV.fromList $ map (toEnum . fromEnum) iscrowd) po+ raw <- peekArray (m * n) po+ return $ ((m,n), map realToFrac raw)++{#fun rleNms as rleNms_+ {+ withRLEs* `[RLE]',+ `Int',+ id `Ptr CUInt',+ `CDouble'+ } -> `()'+#}++rleNms :: [RLE] -> Double -> IO [Bool]+rleNms dt thr = do+ let n = length dt+ allocaArray n $ \keep -> do+ rleNms_ dt n keep (realToFrac thr)+ map (>0) <$> peekArray n keep++{#fun bbIou as bbIou_+ {+ `PtrBB',+ `PtrBB',+ `Int',+ `Int',+ svUnsafeWith* `SV.Vector CUChar',+ id `Ptr CDouble'+ } -> `()'+#}++bbIou :: BB -> BB -> [Bool] -> IO ((Int,Int), [Double])+bbIou (BB dt) (BB gt) iscrowd = do+ let m = SV.length dt+ n = SV.length gt+ c = length iscrowd+ assert (n == c) $ allocaArray (m*n) $ \po ->+ svUnsafeWith dt $ \pdt -> svUnsafeWith gt $ \pgt -> do+ bbIou_ (castPtr pdt) (castPtr pgt) m n (SV.fromList $ map (toEnum . fromEnum) iscrowd) po+ raw <- peekArray (m * n) po+ return $ ((m,n), map realToFrac raw)++{#fun bbNms as bbNms_+ {+ `PtrBB',+ `Int',+ id `Ptr CUInt',+ `CDouble'+ } -> `()'+#}++bbNms :: BB -> Double -> IO [Bool]+bbNms (BB dt) thr = do+ let n = SV.length dt+ svUnsafeWith dt $ \pbb -> + allocaArray n $ \keep -> do+ bbNms_ (castPtr pbb) n keep (realToFrac thr)+ map (>0) <$> peekArray n keep++{#fun rleToBbox as rleToBbox_+ {+ withRLEs* `[RLE]',+ `PtrBB',+ `Int'+ } -> `()'+#}++rleToBbox :: [RLE] -> IO BB+rleToBbox r = do+ let n = length r+ mbb <- SVM.new n+ SVM.unsafeWith mbb $ \pbb -> rleToBbox_ r (castPtr pbb) n+ BB <$> SV.unsafeFreeze mbb++{#fun rleFrBbox as rleFrBbox_+ {+ `Ptr ()',+ `PtrBB',+ `Int',+ `Int',+ `Int'+ } -> `()'+#}++rleFrBbox :: BB -> Int -> Int -> IO [RLE]+rleFrBbox (BB bb) h w = do+ let n = SV.length bb+ makeRLEs n $ \prles -> svUnsafeWith bb $ \pbb -> do+ rleFrBbox_ prles (castPtr pbb) h w n++{#fun rleFrPoly as rleFrPoly_+ {+ `Ptr ()',+ id `Ptr CDouble',+ `Int',+ `Int',+ `Int'+ } -> `()'+#}++rleFrPoly :: SV.Vector (CDouble, CDouble) -> Int -> Int -> IO RLE+rleFrPoly xy h w = do+ let k = SV.length xy+ makeRLE $ \prle -> svUnsafeWith xy $ \pxy -> do+ rleFrPoly_ prle (castPtr pxy) k h w++{#fun rleToString as ^+ {+ withRLE* `RLE'+ } -> `BS.ByteString' peekAndFreeCString*+#}++peekAndFreeCString :: Ptr CChar -> IO BS.ByteString+peekAndFreeCString cstr = do+ hstr <- BS.packCString cstr+ free cstr+ return hstr++{#fun rleFrString as rleFrString_+ {+ `Ptr ()',+ withByteString* `BS.ByteString',+ `Int',+ `Int'+ } -> `()'+#}++rleFrString :: BS.ByteString -> Int -> Int -> IO RLE+rleFrString bs h w = do+ makeRLE $ (\pr -> rleFrString_ pr bs h w)++withByteString :: BS.ByteString -> (CString -> IO a) -> IO a+withByteString = BS.useAsCString
+ src/MXNet/Coco/Types.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module MXNet.Coco.Types where++import Control.Applicative+import Data.Aeson+import qualified Data.Attoparsec.Text as A+import Data.Time.Calendar (Day, fromGregorianValid)+import Data.Time (LocalTime(..), TimeOfDay(..))+import Data.Bits ((.&.))+import Data.Char (ord)+import Data.Vector (Vector)+import Control.Lens (makeLenses)+import GHC.Generics (Generic)+import Data.Store (Store)++data Instance = Instance {+ _info :: Info,+ _images :: Vector Image,+ _annotations :: Vector Annotation,+ _licenses :: Vector License,+ _categories :: Vector Category+} deriving Generic++instance Store Instance++instance FromJSON Instance where+ parseJSON = withObject "Instance" $ \v -> Instance+ <$> v .: "info"+ <*> v .: "images"+ <*> v .: "annotations"+ <*> v .: "licenses"+ <*> v .: "categories"++data Info = Info {+ _info_year :: Int,+ _info_version :: String,+ _info_description :: String,+ _info_contributor :: String,+ _info_url :: String,+ _info_date_created :: CocoDay+} deriving Generic++instance Store Info++instance FromJSON Info where+ parseJSON = withObject "Info" $ \v -> Info+ <$> v .: "year"+ <*> v .: "version"+ <*> v .: "description"+ <*> v .: "contributor"+ <*> v .: "url"+ <*> v .: "date_created"++data License = License {+ _lic_id :: Int,+ _lic_name :: String,+ _lic_url :: String+} deriving Generic++instance Store License++instance FromJSON License where+ parseJSON = withObject "License" $ \v -> License+ <$> v .: "id"+ <*> v .: "name"+ <*> v .: "url"++data Image = Image {+ _img_id :: !Int, + _img_width :: !Int, + _img_height :: !Int, + _img_file_name :: !String, + _img_license :: !Int, + _img_flickr_url :: !String, + _img_coco_url :: !String,+ _img_date_captured :: !LocalTime+} deriving (Generic, Show)++deriving instance Generic TimeOfDay+deriving instance Generic LocalTime+instance Store TimeOfDay+instance Store LocalTime+instance Store Image++instance FromJSON Image where+ parseJSON = withObject "Image" $ \v -> Image+ <$> v .: "id"+ <*> v .: "width"+ <*> v .: "height"+ <*> v .: "file_name"+ <*> v .: "license"+ <*> v .: "flickr_url"+ <*> v .: "coco_url"+ <*> v .: "date_captured"++data Annotation = AnnObjectDetection {+ _ann_id :: !Int,+ _ann_image_id :: !Int,+ _ann_category_id :: !Int,+ _ann_segmentation :: !Segmentation,+ _ann_area :: !Float,+ _ann_bbox :: !(Float, Float, Float, Float)+} deriving Generic++instance Store Annotation++instance FromJSON Annotation where+ parseJSON = withObject "Annotation" $ \v -> AnnObjectDetection+ <$> v .: "id"+ <*> v .: "image_id"+ <*> v .: "category_id"+ <*> v .: "segmentation"+ <*> v .: "area"+ <*> v .: "bbox"++data Segmentation = SegRLE { _seg_counts :: [Int], _seg_size :: (Int, Int)} | SegPolygon [[Double]]+ deriving Generic++instance Store Segmentation++instance FromJSON Segmentation where+ parseJSON value = (withObject "RLE" (\v -> SegRLE <$> v .: "counts" <*> v .: "size") value) <|>+ (withArray "Polygon" (\v -> SegPolygon <$> parseJSONList (Array v)) value)++data Category = CatObjectDetection {+ _odc_id :: Int,+ _odc_name :: String,+ _odc_supercategory :: String+} deriving Generic++instance Store Category++instance FromJSON Category where+ parseJSON = withObject "Category" $ \v -> CatObjectDetection+ <$> v .: "id"+ <*> v .: "name"+ <*> v .: "supercategory"++newtype CocoDay = CocoDay Day deriving Generic++instance Store CocoDay++instance FromJSON CocoDay where+ parseJSON = withText "Day" $ \t -> case A.parseOnly (day <* A.endOfInput) t of+ Left err -> fail $ "could not parse date: " ++ err+ Right r -> return r+ where+ day = do+ y <- (A.decimal <* A.char '/') <|> fail "date must be of form YYYY/MM/DD"+ m <- (twoDigits <* A.char '/') <|> fail "date must be of form YYYY/MM/DD"+ d <- twoDigits <|> fail "date must be of form YYYY/MM/DD"+ maybe (fail "invalid date") return (CocoDay <$> fromGregorianValid y m d)+ twoDigits = do+ a <- A.digit+ b <- A.digit+ let c2d c = ord c .&. 15+ return $! c2d a * 10 + c2d b++makeLenses ''Instance+makeLenses ''Info+makeLenses ''License+makeLenses ''Image+makeLenses ''Annotation+makeLenses ''Segmentation+makeLenses ''Category
+ src/MXNet/NN/DataIter/Anchor.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE TemplateHaskell #-}+module MXNet.NN.DataIter.Anchor where++import qualified Data.IntSet as Set+import Control.Exception+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as UV+import qualified Data.Vector.Unboxed.Mutable as UVM+import Control.Lens (view, makeLenses)+import Control.Monad.Reader+import Data.Random (shuffleN, runRVar, StdRandom(..))+import Data.Array.Repa (Array, DIM1, DIM2, D, U, (:.)(..), Z (..), All(..), (+^), fromListUnboxed)+import qualified Data.Array.Repa as Repa++-- import Debug.Trace++type Anchor r = Array r DIM1 Float+type GTBox r = Array r DIM1 Float++data Configuration = Configuration {+ _conf_anchor_scales :: [Int],+ _conf_anchor_ratios :: [Float],+ _conf_allowed_border :: Int,+ _conf_fg_num :: Int, + _conf_batch_num :: Int,+ _conf_bg_overlap :: Float,+ _conf_fg_overlap :: Float+} deriving Show+makeLenses ''Configuration++anchors :: MonadReader Configuration m => + Int -> Int -> Int -> m (V.Vector (Anchor U))+anchors stride width height = do+ scales <- view conf_anchor_scales+ ratios <- view conf_anchor_ratios+ base <- baseAnchors stride+ return $ V.fromList + [ Repa.computeS $ anch +^ offs+ | offY <- grid height+ , offX <- grid width+ , anch <- base + , let offs = fromListUnboxed (Z :. 4) [offX, offY, offX, offY]]+ where+ grid size = map fromIntegral [0, stride .. size * stride-1]++baseAnchors :: MonadReader Configuration m => + Int -> m ([Anchor U])+baseAnchors size = do+ scales <- view conf_anchor_scales+ ratios <- view conf_anchor_ratios+ return [makeBase s r | r <- ratios, s <- scales]+ where+ makeBase :: Int -> Float -> Anchor U+ makeBase scale ratio = + let sizeF = fromIntegral size - 1+ (w, h, x, y) = whctr (0, 0, sizeF, sizeF)+ ws = round $ sqrt (w * h / ratio) :: Int+ hs = round $ (fromIntegral ws) * ratio :: Int+ in mkanchor x y (fromIntegral $ ws * scale) (fromIntegral $ hs * scale)++whctr :: (Float, Float, Float, Float) -> (Float, Float, Float, Float)+whctr (x0, y0, x1, y1) = (w, h, x, y)+ where+ w = x1 - x0 + 1+ h = y1 - y0 + 1+ x = x0 + 0.5 * (w - 1)+ y = y0 + 0.5 * (h - 1)++mkanchor :: Float -> Float -> Float -> Float -> Anchor U+mkanchor x y w h = fromListUnboxed (Z :. 4) [x - hW, y - hH, x + hW, y + hH]+ where+ hW = 0.5 * (w - 1)+ hH = 0.5 * (h - 1)++(#!) :: Array U DIM1 Float -> Int -> Float+(#!) = Repa.unsafeLinearIndex++(%!) :: V.Vector a -> Int -> a+(%!) = (V.!)++overlapMatrix :: Set.IntSet -> V.Vector (GTBox U) -> V.Vector (Anchor U) -> Array D DIM2 Float+overlapMatrix goodIndices gtBoxes anBoxes = Repa.fromFunction (Z :. width :. height) calcOvp+ where+ width = V.length gtBoxes+ height = V.length anBoxes++ calcArea box = (box #! 2 - box #! 0 + 1) * (box #! 3 - box #! 1 + 1)+ areaA = V.map calcArea anBoxes+ areaG = V.map calcArea gtBoxes++ calcOvp (Z :. ig :. ia) = + let gt = gtBoxes %! ig+ anchor = anBoxes %! ia+ iw = min (gt #! 2) (anchor #! 2) - max (gt #! 0) (anchor #! 0)+ ih = min (gt #! 3) (anchor #! 3) - max (gt #! 1) (anchor #! 1)+ areaI = iw * ih+ areaU = areaA %! ia + areaG %! ig - areaI+ in if Set.member ia goodIndices && iw > 0 && ih > 0 then areaI / areaU else 0++type Labels = Repa.Array U DIM1 Float -- UV.Vector Int+type Targets = Repa.Array U DIM2 Float -- UV.Vector (Float, Float, Float, Float)+type Weights = Repa.Array U DIM2 Float -- UV.Vector (Float, Float, Float, Float)++assign :: (MonadReader Configuration m, MonadIO m) => + V.Vector (GTBox U) -> Int -> Int -> V.Vector (Anchor U) -> m (Labels, Targets, Weights)+assign gtBoxes imWidth imHeight anBoxes + | numGT == 0 = do+ goodIndices <- filterGoodIndices+ liftIO $ do+ indices <- runRVar (shuffleN (Set.size goodIndices) (Set.toList goodIndices)) StdRandom+ labels <- UVM.replicate numLabels (-1)+ forM_ indices $ flip (UVM.write labels) 0+ let targets = UV.replicate (numLabels * 4) 0+ weights = UV.replicate (numLabels * 4) 0+ labels <- UV.unsafeFreeze labels+ let labelsRepa = Repa.fromUnboxed (Z:.numLabels) labels+ targetsRepa = Repa.fromUnboxed (Z:.numLabels:.4) targets+ weightsRepa = Repa.fromUnboxed (Z:.numLabels:.4) weights+ return (labelsRepa, targetsRepa, weightsRepa)++ | otherwise = do+ _fg_overlap <- view conf_fg_overlap+ _bg_overlap <- view conf_bg_overlap+ _batch_num <- view conf_batch_num+ _fg_num <- view conf_fg_num+ + goodIndices <- filterGoodIndices++ -- traceShowM ("#Good Anchors:", V.length goodIndices)++ liftIO $ do+ -- TODO filter valid anchor boxes+ -- TODO case when gtBoxes is empty.+ labels <- UVM.replicate numLabels (-1)++ overlaps <- return $ Repa.computeUnboxedS $ overlapMatrix goodIndices gtBoxes anBoxes+ -- for each GT, the hightest overlapping anchor is FG.+ forM_ [0..numGT-1] $ \i -> do+ -- let j = UV.maxIndex $ Repa.toUnboxed $ Repa.computeS $ Repa.slice overlaps (Z :. i :. All)+ let j = argMax overlaps 0 i+ -- traceShowM $ ("GT -> ", j)+ UVM.write labels j 1+ + -- FG anchors that have overlapping with any GT >= thresh+ -- BG anchors that have overlapping with all GT < thresh+ UV.forM_ (UV.indexed $ Repa.toUnboxed $ Repa.foldS max 0 $ Repa.transpose overlaps) $ \(i, m) -> do+ when (Set.member i goodIndices) $ do+ when (m >= _fg_overlap) $ do+ -- traceShowM ("FG enable ", m, i)+ (UVM.write labels i 1)+ when (m < _bg_overlap) $ do+ -- s <- UVM.read labels i+ -- when (s == 1) $ traceShowM ("FG disable ", m, i)+ (UVM.write labels i 0)++ -- subsample FG anchors if there are too many+ fgs <- UV.findIndices (==1) <$> UV.unsafeFreeze labels+ let numFG = UV.length fgs+ when (numFG > _fg_num) $ do+ indices <- runRVar (shuffleN numFG $ UV.toList fgs) StdRandom+ -- traceShowM ("Disable A", take (numFG - _fg_num) indices)+ forM_ (take (numFG - _fg_num) indices) $+ flip (UVM.write labels) (-1)++ -- subsample BG anchors if there are too many+ bgs <- UV.findIndices (==0) <$> UV.unsafeFreeze labels+ let numBG = UV.length bgs+ maxBG = _batch_num - min numFG _fg_num+ when (numBG > maxBG) $ do+ indices <- runRVar (shuffleN numBG $ UV.toList bgs) StdRandom+ -- traceShowM ("Disable B", take (numBG - maxBG) indices)+ forM_ (take (numBG - maxBG) indices) $ + flip (UVM.write labels) (-1)++ -- compute the regression from each FG anchor to its gt+ -- let gts = UV.map (\i -> UV.maxIndex $ Repa.toUnboxed $ Repa.computeS $ Repa.slice overlaps (Z :. i :. All)) fgs+ let gts = UV.map (argMax overlaps 1) fgs+ gtDiffs = UV.zipWith makeTarget fgs gts+ targets <- UVM.replicate numLabels (0, 0, 0, 0)+ UV.zipWithM_ (UVM.write targets) fgs gtDiffs+ + -- indicates which anchors have a regression + weights <- UVM.replicate numLabels (0, 0, 0, 0)+ UV.forM_ fgs $ flip (UVM.write weights) (1, 1, 1, 1)++ labels <- UV.unsafeFreeze labels+ targets <- UV.unsafeFreeze targets+ weights <- UV.unsafeFreeze weights + let labelsRepa = Repa.fromUnboxed (Z:.numLabels) labels+ targetsRepa = Repa.fromUnboxed (Z:.numLabels:.4) (flattenT targets)+ weightsRepa = Repa.fromUnboxed (Z:.numLabels:.4) (flattenT weights)+ return (labelsRepa, targetsRepa, weightsRepa)+ where+ numGT = V.length gtBoxes+ numLabels = V.length anBoxes++ argMax :: Array U DIM2 Float -> Int -> Int -> Int+ argMax mat axis ind = + let series = case axis of + 0 -> Repa.slice mat $ Z :. ind :. All+ 1 -> Repa.slice mat $ Z :. All :. ind+ _ -> throw BadDimension+ in UV.maxIndex $ Repa.toUnboxed $ Repa.computeS series++ asTuple :: Array U DIM1 Float -> (Float, Float, Float, Float)+ asTuple box = (box #! 0, box #! 1, box #! 2, box #! 3)++ filterGoodIndices :: MonadReader Configuration m => m Set.IntSet+ filterGoodIndices = do+ _allowed_border <- fromIntegral <$> view conf_allowed_border+ let goodAnchor (x0, y0, x1, y1) =+ x0 >= -_allowed_border &&+ y0 >= -_allowed_border &&+ x1 < fromIntegral imWidth + _allowed_border &&+ y1 < fromIntegral imHeight + _allowed_border + return $ Set.fromList $ V.toList $ V.findIndices (goodAnchor . asTuple) anBoxes++ makeTarget :: Int -> Int -> (Float, Float, Float, Float)+ makeTarget fgi gti = + let fgBox = anBoxes %! fgi+ gtBox = gtBoxes %! gti+ (w1, h1, cx1, cy1) = whctr $ asTuple fgBox+ (w2, h2, cx2, cy2) = whctr $ asTuple gtBox+ dx = (cx2 - cx1) / (w1 + 1e-14)+ dy = (cy2 - cy1) / (h1 + 1e-14)+ dw = log (w2 / w1)+ dh = log (h2 / h1)+ in (dx, dy, dw, dh)++ -- TODO: make it without any copy+ flattenT :: UV.Vector (Float, Float, Float, Float) -> UV.Vector Float+ flattenT = UV.concatMap (\(a,b,c,d) -> UV.fromList [a,b,c,d])++data AnchorError = BadDimension+ deriving Show+instance Exception AnchorError
+ src/MXNet/NN/DataIter/Coco.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+module MXNet.NN.DataIter.Coco (+ cocoImages,+ cocoImagesWithAnchors,+ cocoImagesWithAnchors',+ Coco(..),+ coco,+) where++import Data.Maybe (catMaybes, fromMaybe)+import Data.List (unzip6)+import System.FilePath+import System.Directory+import GHC.Generics (Generic)+import qualified Data.ByteString as SBS+import qualified Data.Store as Store+import Control.Exception+import Data.Array.Repa (Array, DIM1, DIM3, D, U, (:.)(..), Z (..), Any(..),+ fromListUnboxed, extent, backpermute, extend, (-^), (+^), (*^), (/^))+import qualified Data.Array.Repa as Repa+import Data.Array.Repa.Repr.Unboxed (Unbox)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as UV+import qualified Codec.Picture.Repa as RPJ+import Codec.Picture+import Codec.Picture.Extra+import qualified Data.Aeson as Aeson+import Control.Lens ((^.), (%~) , view, makeLenses, _1, _2)+import Data.Conduit+import qualified Data.Conduit.Combinators as C (yieldMany)+import qualified Data.Conduit.List as C+import Control.Monad.Reader+import qualified Data.IntMap.Strict as M+import Data.Maybe (fromJust)+import qualified Data.Random as RND (shuffleN, runRVar, StdRandom(..))++import MXNet.Base (NDArray(..), Fullfilled, ArgsHMap, ParameterList, Attr(..), (!), (!?), (.&), HMap(..), ArgOf(..), fromVector,zeros)+import MXNet.Base.Operators.NDArray (_Reshape)+import MXNet.NN.DataIter.Conduit+import qualified MXNet.NN.DataIter.Anchor as Anchor+import MXNet.Coco.Types++data Coco = Coco FilePath String Instance+ deriving Generic+instance Store.Store Coco++raiseLeft :: Exception e => (a -> e) -> Either a b -> b+raiseLeft exc = either (throw . exc) id++data FileNotFound = FileNotFound String String+ deriving Show+instance Exception FileNotFound++cached :: Store.Store a => String -> IO a -> IO a+cached name action = do+ createDirectoryIfMissing True "cache"+ hitCache <- doesFileExist path+ if hitCache then+ SBS.readFile path >>= Store.decodeIO+ else do+ obj <- action+ SBS.writeFile path (Store.encode obj)+ return obj+ where+ path = "cache/" ++ name++coco :: String -> String -> IO Coco+coco base datasplit = cached (datasplit ++ ".store") $ do+ let annotationFile = base </> "annotations" </> ("instances_" ++ datasplit ++ ".json")+ inst <- raiseLeft (FileNotFound annotationFile) <$> Aeson.eitherDecodeFileStrict' annotationFile+ return $ Coco base datasplit inst++type ImageTensor = Array U DIM3 Float+type ImageInfo = Array U DIM1 Float+type GTBoxes = V.Vector (Array U DIM1 Float)++data Configuration = Configuration {+ _conf_short :: Int,+ _conf_max_size :: Int,+ _conf_mean :: (Float, Float, Float),+ _conf_std :: (Float, Float, Float)+}+makeLenses ''Configuration++cocoImages :: (MonadReader Configuration m, MonadIO m) => Coco -> Bool -> ConduitData m (ImageTensor, ImageInfo, GTBoxes)+cocoImages (Coco base datasplit inst) shuffle = ConduitData (Just 1) $ do+ let all = inst ^. images+ all_images <- if shuffle then+ liftIO $ RND.runRVar (RND.shuffleN (length all) (V.toList all)) RND.StdRandom + else+ return $ V.toList all+ C.yieldMany all_images {-- .| C.iterM (liftIO . print) --} .| C.mapM loadImg .| C.catMaybes+ where+ -- dropAlpha tensor =+ -- let Z :. _ :. w :. h = extent tensor+ -- in fromFunction (Z :. (3 :: Int) :. w :. h) (tensor Repa.!)+ loadImg img = do+ short <- view conf_short+ maxSize <- view conf_max_size++ let imgFilePath = base </> datasplit </> img ^. img_file_name+ imgDyn <- raiseLeft (FileNotFound imgFilePath) <$> liftIO (readImage imgFilePath)++ let imgRGB = convertRGB8 imgDyn+ imgH = fromIntegral $ imageHeight imgRGB+ imgW = fromIntegral $ imageWidth imgRGB++ scale = calcScale imgW imgH short maxSize+ imgH' = floor $ scale * imgH+ imgW' = floor $ scale * imgW+ imgInfo = fromListUnboxed (Z :. 3) [fromIntegral imgH', fromIntegral imgW', scale]++ imgResized = scaleBilinear imgW' imgH' imgRGB+ imgRGBRepa = Repa.computeUnboxedS $ RPJ.imgData (RPJ.convertImage imgResized :: RPJ.Img RPJ.RGB)++ gt_boxes = get_gt_boxes scale img++ if V.null gt_boxes + then return Nothing + else do+ let imgRGBRepa' = Repa.computeUnboxedS $ Repa.map fromIntegral imgRGBRepa+ imgEval <- transform imgRGBRepa'+ return $ Just (imgEval, imgInfo, gt_boxes)++ -- find a proper scale factor+ calcScale imgW imgH short maxSize =+ let imSizeMin = min imgH imgW+ imSizeMax = max imgH imgW+ imScale0 = fromIntegral short / imSizeMin :: Float+ imScale1 = fromIntegral maxSize / imSizeMax :: Float+ in if round (imScale0 * imSizeMax) > maxSize then imScale1 else imScale0++ -- map each category from id to its index in the cocoClassNames.+ catTabl = M.fromList $ V.toList $ V.map (\cat -> (cat ^. odc_id, fromJust $ V.elemIndex (cat ^. odc_name) cocoClassNames)) (inst ^. categories)++ -- get all the bbox and gt for the image+ get_gt_boxes scale img = V.fromList $ catMaybes $ map makeGTBox $ V.toList imgAnns+ where+ imageId = img ^. img_id+ width = img ^. img_width+ height = img ^. img_height+ imgAnns = V.filter (\ann -> ann ^. ann_image_id == imageId) (inst ^. annotations)++ cleanBBox (x, y, w, h) =+ let x0 = max 0 x+ y0 = max 0 y+ x1 = min (fromIntegral width - 1) (x0 + max 0 (w-1))+ y1 = min (fromIntegral height - 1) (y0 + max 0 (h-1))+ in (x0, y0, x1, y1)++ makeGTBox ann =+ let (x0, y0, x1, y1) = cleanBBox (ann ^. ann_bbox)+ classId = catTabl M.! (ann ^. ann_category_id)+ + in+ if ann ^. ann_area > 0 && x1 > x0 && y1 > y0+ then Just $ fromListUnboxed (Z :. 5) [x0*scale, y0*scale, x1*scale, y1*scale, fromIntegral classId]+ else Nothing+++-- transform HWC -> CHW+transform :: MonadReader Configuration m =>+ Array U DIM3 Float -> m (Array U DIM3 Float)+transform img = do+ mean <- view conf_mean+ std <- view conf_std+ let broadcast = Repa.computeUnboxedS . extend (Any :. height :. width)+ mean' = broadcast $ fromTuple mean+ std' = broadcast $ fromTuple std+ chnFirst = backpermute newShape (\ (Z :. c :. h :. w) -> Z :. h :. w :. c) img+ return $ Repa.computeUnboxedS $ (chnFirst -^ mean') /^ std'+ where+ (Z :. height :. width :. chn) = extent img+ newShape = Z:. chn :. height :. width++-- transform CHW -> HWC+transformInv :: (Repa.Source r Float, MonadReader Configuration m) =>+ Array r DIM3 Float -> m (Array D DIM3 Float)+transformInv img = do+ mean <- view conf_mean+ std <- view conf_std+ let broadcast = extend (Any :. height :. width)+ mean' = broadcast $ fromTuple mean+ std' = broadcast $ fromTuple std+ addMean = img *^ std' +^ mean'+ return $ backpermute newShape (\ (Z :. h :. w :. c) -> Z :. c :. h :. w) addMean+ where+ (Z :. chn :. height :. width) = extent img+ newShape = Z :. height :. width :. chn++fromTuple :: Unbox a => (a, a, a) -> Array U (Z :. Int) a+fromTuple (a, b, c) = fromListUnboxed (Z :. (3 :: Int)) [a,b,c]++cocoClassNames = V.fromList [+ "__background__", -- always index 0+ "person", "bicycle", "car", "motorcycle", "airplane", "bus", "train",+ "truck", "boat", "traffic light", "fire hydrant", "stop sign",+ "parking meter", "bench", "bird", "cat", "dog", "horse", "sheep",+ "cow", "elephant", "bear", "zebra", "giraffe", "backpack", "umbrella",+ "handbag", "tie", "suitcase", "frisbee", "skis", "snowboard",+ "sports ball", "kite", "baseball bat", "baseball glove", "skateboard",+ "surfboard", "tennis racket", "bottle", "wine glass", "cup", "fork",+ "knife", "spoon", "bowl", "banana", "apple", "sandwich", "orange",+ "broccoli", "carrot", "hot dog", "pizza", "donut", "cake", "chair",+ "couch", "potted plant", "bed", "dining table", "toilet", "tv",+ "laptop", "mouse", "remote", "keyboard", "cell phone", "microwave",+ "oven", "toaster", "sink", "refrigerator", "book", "clock", "vase",+ "scissors", "teddy bear", "hair drier", "toothbrush"]++type instance ParameterList "CocoImagesWithAnchors" =+ '[ '("batch_size", 'AttrReq Int),+ '("short_size", 'AttrReq Int),+ '("long_size", 'AttrReq Int),+ '("mean", 'AttrReq (Float, Float, Float)),+ '("std", 'AttrReq (Float, Float, Float)),+ '("feature_stride", 'AttrOpt Int),+ '("anchor_scales", 'AttrOpt [Int]),+ '("anchor_ratios", 'AttrOpt [Float]),+ '("allowed_border", 'AttrOpt Int),+ '("batch_rois", 'AttrOpt Int),+ '("fg_fraction", 'AttrOpt Float),+ '("fg_overlap", 'AttrOpt Float),+ '("bg_overlap", 'AttrOpt Float),+ '("shuffle", 'AttrOpt Bool)]+++cocoImagesWithAnchors' :: (Fullfilled "CocoImagesWithAnchors" args, MonadIO m) =>+ ConduitData (ReaderT Configuration m) (ImageTensor, ImageInfo, GTBoxes) -> + ((Int, Int) -> IO (Int, Int)) -> + ArgsHMap "CocoImagesWithAnchors" args -> + ConduitData m ((NDArray Float, NDArray Float, NDArray Float), (NDArray Float, NDArray Float, NDArray Float))+cocoImagesWithAnchors' (ConduitData _ images) extractFeatureShape args = ConduitData (Just batchSize) $ + morf images .| C.mapM (assignAnchors anchConf featureStride extractFeatureShape) .| C.chunksOf batchSize .| C.mapM toNDArray+ where+ batchSize = args ! #batch_size+ batchRois = fromMaybe 256 $ args !? #batch_rois+ featureStride = fromMaybe 16 $ args !? #feature_stride+ anchConf = Anchor.Configuration {+ Anchor._conf_anchor_scales = fromMaybe [8, 16, 32] $ args !? #anchor_scales,+ Anchor._conf_anchor_ratios = fromMaybe [0.5, 1, 2] $ args !? #anchor_ratios,+ Anchor._conf_allowed_border = fromMaybe 0 $ args !? #allowed_border,+ Anchor._conf_fg_num = floor $ (fromMaybe 0.5 $ args !? #fg_fraction) * fromIntegral batchRois,+ Anchor._conf_batch_num = batchRois,+ Anchor._conf_fg_overlap = fromMaybe 0.7 $ args !? #fg_overlap,+ Anchor._conf_bg_overlap = fromMaybe 0.3 $ args !? #bg_overlap+ }+ cocoConf = Configuration {+ _conf_short = args ! #short_size,+ _conf_max_size = args ! #long_size,+ _conf_mean = args ! #mean,+ _conf_std = args ! #std+ }+ morf = transPipe (flip runReaderT cocoConf)++cocoImagesWithAnchors :: (Fullfilled "CocoImagesWithAnchors" args, MonadIO m) =>+ Coco -> ((Int, Int) -> IO (Int, Int)) -> ArgsHMap "CocoImagesWithAnchors" args -> + ConduitData m ((NDArray Float, NDArray Float, NDArray Float), (NDArray Float, NDArray Float, NDArray Float))+cocoImagesWithAnchors cocoDef extractFeatureShape args = ConduitData (Just batchSize) $ + morf imgs .| C.mapM (assignAnchors anchConf featureStride extractFeatureShape) .| C.chunksOf batchSize .| C.mapM toNDArray++ where+ ConduitData _ imgs = cocoImages cocoDef shuffle+ cocoConf = Configuration {+ _conf_short = args ! #short_size,+ _conf_max_size = args ! #long_size,+ _conf_mean = args ! #mean,+ _conf_std = args ! #std+ }+ shuffle = fromMaybe True $ args !? #shuffle+ batchSize = args ! #batch_size+ batchRois = fromMaybe 256 $ args !? #batch_rois+ featureStride = fromMaybe 16 $ args !? #feature_stride+ anchConf = Anchor.Configuration {+ Anchor._conf_anchor_scales = fromMaybe [8, 16, 32] $ args !? #anchor_scales,+ Anchor._conf_anchor_ratios = fromMaybe [0.5, 1, 2] $ args !? #anchor_ratios,+ Anchor._conf_allowed_border = fromMaybe 0 $ args !? #allowed_border,+ Anchor._conf_fg_num = floor $ (fromMaybe 0.5 $ args !? #fg_fraction) * fromIntegral batchRois,+ Anchor._conf_batch_num = batchRois,+ Anchor._conf_fg_overlap = fromMaybe 0.7 $ args !? #fg_overlap,+ Anchor._conf_bg_overlap = fromMaybe 0.3 $ args !? #bg_overlap+ }++ morf = transPipe (flip runReaderT cocoConf)++assignAnchors :: MonadIO m => Anchor.Configuration -> Int -> ((Int, Int) -> IO (Int, Int)) -> (ImageTensor, ImageInfo, GTBoxes) ->+ m (ImageTensor, ImageInfo, GTBoxes, Repa.Array U DIM1 Float, Repa.Array U DIM3 Float, Repa.Array U DIM3 Float) +assignAnchors conf featureStride extractFeatureShape (img, info, gt) = do+ let imHeight = floor $ info Anchor.#! 0+ imWidth = floor $ info Anchor.#! 1+ (featureWidth, featureHeight) <- liftIO $ extractFeatureShape (imWidth, imHeight)+ anchors <- runReaderT (Anchor.anchors featureStride featureWidth featureHeight) conf++ (lbls, targets, weights) <- runReaderT (Anchor.assign gt imWidth imHeight anchors) conf++ -- reshape and transpose labls from (feat_h * feat_w * #anch, ) to (#anch, feat_h, feat_w)+ -- reshape and transpose targets from (feat_h * feat_w * #anch, 4) to (#anch * 4, feat_h, feat_w)+ -- reshape and transpose weights from (feat_h * feat_w * #anch, 4) to (#anch * 4, feat_h, feat_w)+ let numAnch = length (conf ^. Anchor.conf_anchor_scales) * length (conf ^. Anchor.conf_anchor_ratios)+ lbls <- return $ Repa.computeS $ + Repa.reshape (Z :. numAnch * featureHeight * featureWidth) $ + Repa.transpose $ + Repa.reshape (Z :. featureHeight * featureWidth :. numAnch) lbls+ targets <- return $ Repa.computeS $ + Repa.reshape (Z :. numAnch * 4 :. featureHeight :. featureWidth) $+ Repa.transpose $+ Repa.reshape (Z :. featureHeight * featureWidth :. numAnch * 4) targets+ weights <- return $ Repa.computeS $ + Repa.reshape (Z :. numAnch * 4 :. featureHeight :. featureWidth) $+ Repa.transpose $+ Repa.reshape (Z :. featureHeight * featureWidth :. numAnch * 4) weights++ -- let numAnch = length (anchConf ^. Anchor.conf_anchor_scales) * length (anchConf ^. Anchor.conf_anchor_ratios)+ -- cvt1 (Z :. i :. h :. w) = Z :. ((h * featureWidth + w) * numAnch + i)+ -- cvt2 (Z :. i :. h :. w) = let (m, n) = divMod i 4+ -- in Z :. ((h * featureWidth + w) * numAnch + m) :. n+ -- lbls <- Repa.computeP $ Repa.reshape (Z :. numAnch * featureHeight :. featureWidth) $ + -- Repa.backpermute (Z :. numAnch :. featureHeight :. featureWidth) cvt1 lbls+ -- targets <- Repa.computeP $ Repa.backpermute (Z :. numAnch * 4 :. featureHeight :. featureWidth) cvt2 targets+ -- weights <- Repa.computeP $ Repa.backpermute (Z :. numAnch *4 :. featureHeight :. featureWidth) cvt2 weights ++ return (img, info, gt, lbls, targets, weights)++-- toNDArray :: [((ImageTensor, ImageInfo, GTBoxes, Anchor.Labels, Anchor.Targets, Anchor.Weights))] ->+-- IO ((NDArray Float, NDArray Float, NDArray Float), (NDArray Float, NDArray Float, NDArray Float))+toNDArray dat = liftIO $ do+ imagesC <- convertToMX images+ infosC <- convertToMX infos+ gtboxesC <- convertToMX [if V.null gt then emtpyGT else convertToRepa (V.toList gt) | gt <- gtboxes]+ labelsC <- convertToMX labels+ targetsC <- convertToMX targets+ weightsC <- convertToMX weights+ return ((imagesC, infosC, gtboxesC), (labelsC, targetsC, weightsC))+ where+ (images, infos, gtboxes, labels, targets, weights) = unzip6 dat+ emtpyGT = Repa.fromUnboxed (Z:.0:.5) UV.empty++ convert :: Repa.Shape sh => [Array U sh Float] -> ([Int], UV.Vector Float)+ convert xs = assert (not (null xs)) $ (ext, vec)+ where+ vec = UV.concat $ map Repa.toUnboxed xs+ sh0 = Repa.extent (head xs)+ ext = length xs : reverse (Repa.listOfShape sh0)+ + convertToMX :: Repa.Shape sh => [Array U sh Float] -> IO (NDArray Float)+ convertToMX = uncurry fromVector . (_2 %~ UV.convert) . convert++ -- shape, at the type level, are sequence of Int, although we wnat to append+ -- a dimension at the head, we add Int at the tail, they are the same.+ convertToRepa :: Repa.Shape sh => [Array U sh Float] -> Array U (sh :. Int) Float+ convertToRepa = uncurry Repa.fromUnboxed . (_1 %~ Repa.shapeOfList . reverse) . convert