//WILDTRACK LOWLAND TAPIR AUTOSCRIPT 22-10-14
// Authors: Sky Alibhai and Zoe Jewell
// ROBUST CROSS VALIDATION DISCRIMINANT ANALYSIS
// Utility functions
//
// create distance matrix for clustering
_fitdir=getdefaultdirectory();
distance matrix = Function( {dist, nmlst},
	{dt, lvl = N Items( nmlst ), tmp = J( lvl, lvl, . ), x = 1 :: lvl ^ 2, i = 1, mid = Index( 1, lvl ^ 2, lvl + 1 )},
	tmp[Loc( (1 :: lvl ^ 2) > Shape( Repeat( mid, lvl )`, 1, lvl ^ 2 ) )] = dist;
	tmp[mid] = 0;
	dt = As Table( tmp, <<columnnames( nmlst ) );
	dt << New Column( "ClusterVar", Character, setvalues( nmlst ) );
	dt;
);

// Note: To allow for custom wait(n) --- added 9/20/2012
jmwait = Function( {i}, If( _wait, Wait( i ) ) );
_wait = 0;

// compute silhouette metric to choose # clusters
silhouette = Function( {d, cl},
	{i, j, nr = N Items( cl ), nc = Max( cl ), idx, ai, bi, tmp, silt = 0},
	For( i = 1, i <= nr, i++,
		idx = Loc( cl, cl[i] );
		ai = Sum( d[i, idx] ) / (_x = N Rows( idx ) - 1 ; If( _x, _x, 1 ));
		tmp = J( nc - 1, 1, 0 );
		k = 1;
		For( j = 1, j <= nc, j++,
			If( j != cl[i],
				tmp[k] = Mean( d[i, Loc( cl, j )] );
				k++;
			)
		);
		bi = Min( tmp );
		silt = silt + (bi - ai) / Max( ai, bi );
	);
	silt / nr;
);
find ClusterCount = Function( {dt},
	{sil = [], i, idx, tmp, dm = (dt << getasmatrix)[0, 1 :: N Row( dt )], strt = N Row( dt ) + 3, x = {}},
	idx = Loc( Is Missing( dm ) );
	tmp = dm`;
	dm[idx] = tmp[idx];
	For( i = strt, i <= N Col( dt ), i++,
		sil |/= silhouette( dm, As List( Column( dt, i ) << getvalues ) )
	);
	Show( sil );
//	i=0; x[1::nrow(sil)]=expr(i++;if(i==1,0,sil[i-1]>sil[i] | abs(sil[i-1]-sil[i])<0.00005));  // << 0.001 seems to be a good threshold
	x[1 :: N Row( sil ) - 1] = Expr(
		i++;
		If( i == 1,
			0,
			(sil[i - 1] > sil[i] & sil[i - 1] > sil[i + 1]) | (sil[i - 1] > sil[i] & Abs( sil[i - 1] - sil[i + 1] ) < 0.01) |
			Abs( sil[i - 1] - sil[i] ) < 0.00005
		);
	);
	i = 0;
	x = Loc( Matrix( Eval List( x ) ) );
	Show( x );
	If( N Row( x ),
		x[1]/*if(x[1]>1,x[1]-1,x[1])*/,
		N Row( dt ) - 1
	);
);

// progress bar
add ProgressBar = Function( {sz},
	{bx};
	bx = If Box(
		1,
		Graph Box(
			framesize( sz, 15 ),
			Y Scale( 0, 0.1 ),
			X Scale( 1, 11 ),
			Pen Color( "red" ),
			Pen Size( 20 );
			jmwait( 0 );
			If( !Mod(_k, _modval ),
				window:_progbar_count += 8.5 / 20
			);
			H Line( 1, window:_progbar_count, 0.05 );
			jmwait( 0 );
		)
	);
	bx[axisbox( 1 )] << delete;
	bx[axisbox( 1 )] << delete;
	bx[List Box( 1 )] << append( Button Box( "", <<set icon( "StopIcon.png" ), <<set script( ::_progbar_stop = 1 ) ) );
	bx[Border Box( 1 )] << top( 0 ) << Right( 2 ) << bottom( 0 );
	bx[List Box( 2 )] << prepend( Spacer Box( size( 1, If( Host is( Mac ), 9, 6 ) ) ) );
	bx << set( 0 );
	bx;
);

// enumerate nC2 choice
enumnc2 = Function( {n},
	{n2 = 2 * n - 1, k = n * (n - 1) / 2, i = Index( 0, k - 1 )`, xi = 1 + Floor( (n2 - Sqrt( n2 * n2 - 8 * i )) / 2 ), yi = i - (xi * n2 - xi ^ 2)
	 / 2 + n + 1, xy = xi || yi},
	xy
);
 
// determine overlapping normal contours
find overlapNormContour = Function( {p, mu, std},
	{r1, r2, i, n, v = {}, k = 1}, 
      // identify all possible pairs of circles
	n = enumnc2( N Row( mu ) );
      // compute distance btw centroids, and radius of each contour
	For( i = 1, i <= N Rows( n ), i++,
		r1 = Sqrt( ChiSquare Quantile( p, 2, 0 ) ) * std[n[i, 1], 1];
		r2 = Sqrt( ChiSquare Quantile( p, 2, 0 ) ) * std[n[i, 2], 1];
		v[k++] = Eval List(
			List(
				Sqrt( Distance( mu[n[i, 1], 0], mu[n[i, 2], 0] ) ) <= (r1 + r2),
				mu[n[i, 1], 0],
				mu[n[i, 2], 0],
				Sqrt( Distance( mu[n[i, 1], 0], mu[n[i, 2], 0] ) )
			)
		);
	);
	v;
);
 
// given list of column names return list of names of numeric type
getnumerictype = Function( {dt, s},
	{i, n = {}, k = 1},
	For( i = 1, i <= N Items( s ), i++,
		If( (As Column( dt, s[i] ) << get data type) == "Numeric",
			n[k++] = s[i]
		)
	);
	n;
);

// pretty print
lstprint = Function( {l}, {i}, For( i = 1, i <= N Items( l ), i++, Write( "\!N\!t", l[i] ) ) );
 
// validate start/stop/increment arguments
valid = Function( {m, lmt = [0, 1]}, If( Any( Is Missing( m ) ) | m[1] > m[2] | m[1] < lmt[1] | m[2] > lmt[2] | m[3] <= 0 | m[3] > m[2], 0, 1 ) );

// track analysis
track anal2 = Function( {p, categ_x, ex, tmp},

	{/*categ_x=arg(arg(ex))*/i,nc2,x1,x2,y, categ_y = Arg( ex, 2 )},  										//********Joseph ammend 10 jan 14
	
	Y = Eval( Substitute( Expr( As Column( dt, _x ) << get values ), Expr( _x ), Name Expr( categ_x ) ) );
     
      //nc2=enumnc2(nitems(tmp));
	nc2 = [1 2];
	holdprs = {};
	ki = 1;
	ncPer = ChiSquare Distribution( ChiSquare Quantile( p, 2 ), 2 );
     
	dt << select excluded << exclude;
	jmwait( 0 );
	dtex = Substitute(
			Expr(
				dt << select where( !(As Column( dt, _x ) == tmp[nc2[i, 1]] | As Column( dt, _x ) == tmp[nc2[i, 2]] | As Column( dt, _x ) == "RCV") )
			),
		Expr( _x ), Name Expr( categ_x )
	);
	objex = Substitute( Expr( dt << Discriminant( X( _x ), _y, invisible ) ), Expr( _x ), Name Expr( categ_x ), Expr( _y ), Name Expr( categ_y ) );
     
	For( i = 1, i <= N Rows( nc2 ), i++, 
            // select rows
		dt << Clear Select;
		Eval( dtex );
		dt << exclude;
     
            // launch discriminant platform, save canon scores,create overlay plot for normal contours 
		If( _display,
			nw = New Window( "Custom Analysis - Wildtrack",
				Lineup Box( N Col( 2 ),
					obj = Eval( objex ),
					Outline Box( "Normal Contours",
						Text Box( "" ),
						obj << Save Canonical Scores;
						obj2 = Overlay Plot( X( name( "Canon[1]" ) ), Y( name( "Canon[2]" ) ) );,
						Outline Box( "Empty", <<close )
					)
				)
			);
			rpt = obj << report;
			rpt["Discriminant Scores"] << close;
			rpt2 = obj2 << report;
			Eval(
				Substitute( Expr( rpt2[Framebox( 1 )] << framesize( _x, _y ) ),
					Expr( _x ),
						_fsz = rpt[framebox( 1 )] << get size;
						_fsz[1];,
					Expr( _y ), _fsz[2]
				)
			);
		,
			obj = Eval( objex );
			obj << Show Canonical details( 1 );//obj<<Save Canonical Scores;
			rpt = obj << report;
			tmpcoef = rpt[Matrix Box( 3 )] << get;
			jmwait( 0 );
			rpt << close window//absolute subscripting risky!!!!!!!!!!!!
			;
		);
            
            //X1 = name("Canon[1]")<<Get As Matrix; X2 = name("Canon[2]")<<Get As Matrix;
		lionmat = [];
		For( ii = 1, ii <= N Arg( categ_y ), ii++,
			lionmat ||= Arg( categ_y, ii ) << get as matrix
		); 
			//lionmat=lionAllMat[0,lst loc(lionAllNmsAA,substitute(nameexpr(categ_y),expr(Y()),expr(list())))];
		newcanscr = lionmat * tmpcoef`;
		X1 = newcanscr[0, 1];
		X2 = newcanscr[0, 2];
			
		ng = 2;
		meanMat = J( nG, 2, 1 );
		stdMat = J( nG, 2, 1 );
		corrMat = J( nG, 1, 1 );
		stdMatMCI = J( nG, 2, 1 );
		colorMat = Transpose( 3 :: nG + 2 );
		nMat = J( nG, 1, 1 );
		For( ii = 1, ii <= N Items( tmp[nc2[i, 0]] ), ii++,
			idx_y = Loc( Y, tmp[nc2[i, 0]][ii] );
			nMat[ii] = N Rows( idx_y );
			meanMat[ii, 1] = Mean( X1[idx_y] );
			meanMat[ii, 2] = Mean( X2[idx_y] );
		);
		stdMat = J( nG, 2, 1 );
		stdMatMCI = stdMat :/ Sqrt( nMat * J( 1, 2, 1 ) );
		corrMat = J( nG, 1, 0 );
     
		If( _display,
			rpt2[FrameBox( 1 )] << Add Graphics Script( Normal Contour( ncPer, meanMat, stdMat, corrMat, colorMat, 0 ) )
		);
     
            // analysis
		_slf = 0;
		If( Remove( tmp[nc2[i, 0]][1] ) == Remove( tmp[nc2[i, 0]][2] ),
			_slf = 1
		);
		If( _debug,
			Write( "\!N\!tAnalyzing ", i, " of ", N Rows( nc2 ), ": ", tmp[nc2[i, 0]], " <", If( _slf, "Self", "Non-self" ), ">" )
		);
		_lst1 = find overlapNormContour( ncPer, meanMat, stdMat );
		If( _debug,
			Write( ", prob=", p, "\!t# olap=", _lst1[1][1] )
		);
            //holdprs[ki++]=evallist(list(tmp[nc2[i,0]],ncper,_lst1,nitems(_lst1),_slf));
		holdprs[ki++] = Eval List( List( tmp[nc2[i, 0]], ncper, _lst1, _lst1[1][1], _slf ) );
           
            // cleanup
		If( _display,
			jmwait( 30 );
			nw << close window;
			jmwait( 0 );
		);
		dt << exclude;
     
            //dt<<delete columns(name("Canon[1]"));
		//dt<<delete columns(name("Canon[2]"));
		jmwait( 0 );
	);
	holdprs;
);

// special sub list locator - optionally used in main
lst loc = Function( {x, y},
	{i = 1, tmp = {}, k},
	tmp[1 :: N Items( y )] = Expr( Loc( x, Char( y[i++] ) )[1] );
	Eval List( tmp );
);
lst loc = Function( {x, y},
	x << intersect( Associative Array( y ) );
	x << get values;
);
lst locv2 = Function( {x, y},
	{aa = Associative Array( x, As List( (1 :: N Items( x ))` ) )},
	aa << intersect( Associative Array( y ) );
	Sort List( aa << get values );
);
/*
// to speed up lst loc --- simply create lionAllNms with integer sequnce indicating column index!!!!
mlst=associative array({"t","z","n"},{1,2,3});
mlst<<intersect(associative array({"n","z"}));
show(mlst<<get values) ;
lstloc(lionAllNmsAA,{V1,V22});
lionAllNmsAA<<intersect(associative array({V1,V22})); lionAllNmsAA<<getvalues
*/
// main driver function for model building
modelMain = Function( {x1, x2, y, _x, v_strt, v_stop, v_i, p_strt, p_stop, p_i, restrt_nc2idx = 0, anal = {}},
	{k, idx, _scpt, p, v, m = 1 / p_i, nc2 = enumnc2( N Items( _x ) ), nc_i},
	p_strt *= m;
	p_stop *= m; 
    // prog bar
	_progbar_stop = 0;
	_modval = Floor( (p_stop - p_strt + 1) * (v_stop - v_strt + 1) * N Row( nc2 ) / 20 );
	_k = 1;
	If( _modval,
		nw = New Window( "FIT - PROGRESS", /*Show Menus(0), showtoolbars(0),*/ window:_progbar_count = 1.25;			//ammended 19 oct 12 -SKY
		image1 = new image( _fitdir || "tapir running.jpg" );
		Lineup Box( N Col( 1 ),	spacing( 20 ),
		image1),
		Text Box	( "                           Running...............................",<<setfontsize(14), <<SETFONTSTYLE("italic"),<<Justify Text("center")),
			Border Box( top( 8 ), Left( 5 ), Right( 5 ), addProgressBar( 400 ) );	
		);
		nw[If Box( 1 )] << set( 1 );														
	);
	Write( "\!NStart iterations:\!N\!tTotal iter count = ", (p_stop - p_strt + 1) * (v_stop - v_strt + 1) * N Row( nc2 ), ", pbar incr=", _modval );
    // prog bar end
	//write("\!N\!tInputs: nc2=",nrow(nc2),", idx=",restrt_nc2idx,", # anal=",nitems(anal));
	For( nc_i = 1, nc_i <= N Rows( nc2 ) & !_progbar_stop, nc_i++,
		If( nc_i <= restrt_nc2idx,
			_k += (p_stop - p_strt + 1) * (v_stop - v_strt + 1);
			Write( "\!N\!tSkip ", nc_i, ": ", _x[nc2[nc_i, 0]] );
			If( _modval,
				nw[If Box( 1 )][framebox( 1 )] << inval;
				jmwait( 0.001 );
			);
		,
			For( v = v_strt, v <= v_stop/*& !_progbar_stop*/, v += v_i,
				dt << select excluded << exclude;
				dt << clear select;
				dt << select where( Contains( Insert( {"RCV"}, _x[nc2[nc_i, 0]] ), As Column( dt, x2[1] ) ) );
				dt << exclude;
				obj = Eval(
					Substitute( Expr( dt << discriminant( x( _x_ ), y( _y_ ), Stepwise Variable Selection( 1 ), invisible ) ),
						Expr( _x_ ), Name Expr( x1 ),
						Expr( _y_ ), y
					)
				);
				jmwait( 0 );
				For( k = 1, k <= v, k++,
					obj << Step Forward
				);
				obj << Apply This Model;
				_scpt = obj << get script;
				If( _debug,
					Write( "\!N\!N# Vars = ", v, ":\!N\!t", Arg( _scpt, 2 ) )
				);
				rpt = obj << report;
				jmwait( 0 );
				rpt << close window;
				modAA[v] = If( modAA << contains item( v ),
					Insert( Insert( modAA[v], _x[nc2[nc_i, 0]] ), Arg( _scpt, 2 ) ),
					Insert( Insert( Expr( model() ), _x[nc2[nc_i, 0]] ), Arg( _scpt, 2 ) )
				);
				For( p = p_strt, p <= p_stop & N Items( _x ) /*& !_progbar_stop*/, p++,
					_k++; 
					//show(totgrid,nitems(anal),nitems(x2),nc_i,nrows(nc2));
					anal[totgrid] = track anal2( p / m, As Name( x2[1] ), Name Expr( _scpt ), _x[nc2[nc_i, 0]] );
					Insert Into( anal[totgrid], Eval List( List( p, v ) ) );
					last_p = p;
					last_v = v;
					last_nci = nc_i;
					last_totgrid = totgrid;
                    // prog bar update
					If( !Mod( _k, 20 ),
						Write( "\!N\!titer # = ", _k )
					);
					If( _modval,
						nw[If Box( 1 )][framebox( 1 )] << inval;
						jmwait( 0.001 );
					);
					// end prog bar update
					jmwait( 0 );
					totgrid++;
				);
			)
		)
	);
	serialize_state(
		_progbar_stop,
		x1,
		x2,
		y,
		_x,
		lbx << get selected,
		v_strt,
		v_stop,
		v_i,
		p_strt / m,
		p_stop / m,
		p_i,
		anal,
		modAA,
		last_nci,
		last_v,
		last_p / m,
		last_totgrid
	);
	If( _modval,
		nw << close window
	);		// << close progress bar
	anal;
);

// save state for restart
serialize_state = Function(
	{savestate, x1 = ., x2 = ., y = ., _x = ., lbx = ., v_strt = ., v_stop = ., v_i = ., p_strt = ., p_stop = ., p_i = ., anal = ., AA = [=> ], n = .,
	lv = ., lp = ., t = .},
	{tmp},
	Write( "\!NIn ser, p: ", p_strt, " - ", p_stop );
	If( savestate,
		Save Text File(
			wild_home || "restart.jsl",
			"currentdatatable(" || Char( Current Data Table() ) || ");dt=currentdatatable();" || "_restart_x1=" || Char( x1 ) || ";" ||
			"_restart_x2=" || Char( x2 ) || ";" || "_restart_y=" || Char( y ) || ";" || "_restart_lbx=" || Char( lbx ) || ";" || "_restart_vbx1=" ||
			Char( v_strt ) || ";" || "_restart_vbx2=" || Char( v_stop ) || ";" || "_restart_vbx3=" || Char( v_i ) || ";" || "_restart_pbx1=" ||
			Char( p_strt ) || ";" || "_restart_pbx2=" || Char( p_stop ) || ";" || "_restart_pbx3=" || Char( p_i ) || ";" || "_restart_anal=" ||
			Char( anal ) || ";" || "_restart_idx=" || Char( n ) || ";" || "_restart_t=" || Char( t ) || ";" || "_restart_modAA=" ||
			Char( Name Expr( AA ) ) || ";" || "_restart_lastv=" || Char( lv ) || ";" || "_restart_lastp=" || Char( lp )
		),
		Save Text File( wild_home || "restart.jsl", "" );
		_restart = 0;
		tmp = _nw << xpath( "//ButtonBox[@title='Restart']" );
		If( N Items( tmp ),
			tmp[1] << set button name( "Run" )																	//ammended 16 oct 12 - sky
		);																	
		((_nw << xpath( "//ButtonBox[@title='Reset']" ))[1]) << enable( 0 );
	);
);


// main - create analysis dialog 
wild_home = Get Default Directory();
dt = Current Data Table();
If( Is Empty( dt ),
	dt = Open()
); 
//
origdtsize = dt << getwindowsize;
dt << setwindowsize( 20, 20 ); 				// minimize redraw events by minimizing dt window size --- added 9/20/2012
//
lionAllMat = dt << get all columns as matrix;
lionAllNms = dt << get column names( string ); //i=140; i=1
tmp = {};
k = 1;
For( i = 1, i <= N Items( lionAllNms ), i++,
	tmp[k++] = If(
		_nm = Parse( lionAllNms[i] );
		Type( Name Expr( _nm ) ) == "Expression";
	,
		Parse( ":name(\!"" || lionAllNms[i] || "\!")" ),
		Parse( ":" || Char( Name Expr( _nm ) ) )
	)
);
lionAllNmsAA = Associative Array( tmp, As List( (1 :: N Items( lionAllNms ))` ) );
self = [=> ];
nonself = [=> ];
animal = [=> ];
_debug = 0;
p_strt = 0.5;
p_stop = 0.5;
p_incr = 0.1;
v_strt = 18;
v_stop = 18;
v_incr = 1;
totgrid = 1;
_display = 0;
_restart = 0;
Try(
	If( Length( Trim( Load Text File( wild_home || "restart.jsl" ) ) ),
		_restart = 1;
		Include( wild_home || "restart.jsl" );
	)
);
jmwait( 0 );
tmpltstr = "//OutlineBox[text()='Contour probability = ^lst2[1][i]^']//TextBox[text()='Variables = ^lst2[2][i]^']";				//ammended 16 oct 12 - sky
image1 = new image( _fitdir || "tapir a.jpg" );
image2 = new image( _fitdir || "tapir b.jpg" );
image3 = try(new image( _fitdir || "wildtrack 150.jpg" ),newimage([]));																				//ammended 23 oct 12 - sky
_nw = New Window( "FIT - Lowland Tapir Data Analysis:     Data File = " || (dt << get name),										//ammended 23 oct 12 - sky
	<<onclose( dt << setwindowsize( origdtsize[1], origdtsize[2] ) ), 								// onclose added 9/20/2012 and ammended 10/11/2012 - SKY
	Lineup Box( N Col( 3 ),	spacing( 12 ),																						//ammended 16 oct 12 - sky
	image1,																														//ammended 16 oct 12 - sky
	Lineup Box( N Col( 2 ),	spacing( 10 ),																						//ammended 16 oct 12 - sky
	Text Box	( "Robust Cross-Validated Pair-wise Analysis",<<setfontsize(18), <<SETFONTSTYLE("bold"),<<Justify Text("center"))),															//ammended 16 oct 12 - sky
	Lineup Box( N Col( 1 ),	spacing( 0 ),																						//ammended 16 oct 12 - sky
	image2)),
	// Following creates line just underneath the images																													//ammended 16 oct 12 - sky
	lineupbox(ncol(1), spacing (0),
	spacerbox(size(1,3)),
				spacerbox(size(1,2),color(gray)),
				spacerbox(size(1,1)),
				spacerbox()),
	// End line			
	lineupbox(ncol(1), spacing (0),
									lineupbox(ncol(7),spacing(0),
										buttonbox("Relaunch Analysis",<<setfunction(function({t},include(_fitdir||"Lowland Tapir JMautoscript.jsl");((t<<topparent)<<closewindow)))),
										buttonbox("Image Feature Extraction",<<setfunction(function({t},include(_fitdir||"Lowland Tapir JPscript.jsl");((t<<topparent)<<closewindow)))),
										buttonbox("Mapping",<<setfunction(function({t},include(_fitdir||"DanHomeRange Lowland tapir.jsl");((t<<topparent)<<closewindow)))),
										buttonbox("Validated Discriminant Analysis",<<setfunction(function({t},include(_fitdir||"DiscValid Lowland tapir.jsl");((t<<topparent)<<closewindow)))),
										//buttonbox("Main Menu",<<setfunction(function({t},mainmenu("FIT");((t)<<topparent)<<closewindow))),
										buttonbox("Main Menu",<<setfunction(function({t},include(_fitdir||"FIT Lowland tapir.jsl");((t)<<topparent)<<closewindow))),
										spacerbox(),
										buttonbox("Help",web( "file://" || _addinHelpPath || "Add-in Help.pdf")),
										spacerbox()
									),
									spacerbox(size(1,2)),
									spacerbox(size(1,2),color(gray))
									),
	
	<<set font style( "Bold" ), 																							
	Border Box( top( 10 ), Left( 7 ), Right( 5 ), bottom( 5 ),
		H List Box(
			Panel Box( "Select Columns", ColList = Col List Box( all, width( 200 ), nlines( 10 ) ) ),							//ammended 16 oct 12 - sky
			Panel Box( "Cast Selected Columns into Roles",
				Lineup Box( N Col( 2 ), spacing( 3 ),
					Button Box( "Y, Columns", cdlgorig_y << Append( ColList << GetSelected ) ), 								
					cdlgorig_y = Col List Box( width( 200 ), nlines( 5 ), MinItems( 1 ), Numeric ), 
                              //cdlgorig_y<<Append(getnumerictype(currentdatatable(),ColList<<Get Items)); 	//prepopulate Y, Columns collistbox
					If( _restart,
						cdlgorig_y << Append( _restart_y ),
						cdlgorig_y << Append( Current Data Table() << get column names( numeric, string ) )//prepopulate Y, Columns collistbox
					);
					Button Box( "X, Model Category", cdlgorig_x1 << Append( ColList << GetSelected ) );, 						//ammended 16 oct 12 - sky
					cdlgorig_x1 = Col List Box( width( 150 ), nlines( 1 ), MinItems( 1 ), MaxItems( 1 ), Character ),
					If( _restart,
						cdlgorig_x1 << Append( _restart_x1 )
					);
					Button Box( "Validation", cdlgorig_x2 << Append( ColList << GetSelected ) );,
					Lineup Box( N Col( 1 ),
						cdlgorig_x2 = Col List Box( width( 150 ), nlines( 1 ), MinItems( 1 ), MaxItems( 1 ), Character ),
						If( _restart,
							cdlgorig_x2 << Append( _restart_x2 )
						);
						V List Box(
							cbx = Check Box(
								{"Select levels"},																				// ammended 10/13/2012 - SKY
								<<Set( 1, 0 ), 															
								If( cbx << get,
									If( N Items( cdlgorig_x2 << GetItems ),
										lbx << append( Column( dt, (cdlgorig_x2 << GetItems)[1] ) << get values );
										ibx << set( 1 );
									,
										Dialog( title( "Alert" ), "You must first select a category variable" );
										cbx << set( 1, 0 );
									)
								,
									ibx << set( 0 );
									cbx << set( 1, 0 );
									lbx << remove all;
								)
							),
							ibx = If Box( 0, lbx = List Box( {}, nlines( 12 ) ) )
						);
					)
				)
			),
			If( _restart,
				cbx << set( 1, 1 );
				ibx << set( 1 ); //show(cdlgorig_x2<<GetItems);
				lbx << append( Column( dt, (cdlgorig_x2 << GetItems)[1] ) << get values );
				_restart_lst = lstlocv2( lbx << get items, _restart_lbx );
				For( _restart_i = 1, _restart_i <= N Items( _restart_lst ), _restart_i++,
					lbx << set selected( _restart_lst[_restart_i] )
				);
			);
                  //panelbox("Action",
			panelbox("Action",
				Lineup Box( N Col( 1 ), 
					Button Box( "Run", 																						//ammended 16 oct 12 - sky
						_display = nc_cbx << get;
						totgrid = If( _restart,
							N Items( anal ) + 1,
							1
						);
						modAA = If( _restart,
							_restart_modAA,
							[=> ]
						);
						If(
							cbx << get & N Items( lbx << get selected ) == 1,
								Dialog( title( "Alert" ), "You must select at least 2 category levels" ), 					// ammended 10/13/2012 - SKY
							!(N Items( cdlgorig_y << GetItems ) & N Items( cdlgorig_x1 << GetItems ) & N Items( cdlgorig_x2 << GetItems )),
								Dialog( title( "Alert" ), "You must select columns for all roles" ),
							!(valid( (pbx1 << get) || (pbx2 << get) || (pbx3 << get) ) & valid(
								(vbx1 << get) || (vbx2 << get) || (vbx3 << get),
								1 || N Items( cdlgorig_y << GetItems )
							)), Dialog( title( "Alert" ), "Either Contour probability (0-1) or # of variables invalid" ), 	//ammended 16 oct 12 - sky
							_tmsec = Tick Seconds(); 
                                            //anal=if(_restart,_restart_anal,{})||modelMain(cdlgorig_x1<<GetItems,cdlgorig_x2<<GetItems,
							anal = modelMain(
								cdlgorig_x1 << GetItems,
								cdlgorig_x2 << GetItems,
								cdlgorig_y << GetItems,
								lbx << get selected,
								vbx1 << get,
								vbx2 << get,
								vbx3 << get,
								pbx1 << get,
								pbx2 << get,
								pbx3 << get,
								If( _restart,
									_restart_idx,
									0
								),
								If( _restart, anal, {} )/*,
                                                                  if(_restart,_restart_lastv,0),if(_restart,_restart_lastp,0)*/
							);
							Write( "\!N\!NElapsed time = ", Tick Seconds() - _tmsec );
							dt2tmp = New Table( "Self-Nonself",
								New Column( "Trails", character ),
								New Column( "p" ),
								New Column( "Vars" ), 																		//ammended 16 oct 12 - SKY
								New Column( "Distance" ),
								New Column( "Assigned self" ),																//ammended 16 oct 12 - SKY
								New Column( "Predicted match" )        														//ammended 10/11/2012 - SKY
							);
							For( i = 1, i <= N Items( anal ), i++,
								For( k = 1, k <= N Items( anal[i] ) - 2, k++,
									dt2tmp << add rows( 1 );
									:trails[] = Char( anal[i][k][1] );
									:p[] = anal[i][k][2];
									:Predicted match[] = anal[i][k][4];
									:Assigned self[] = anal[i][k][5];														//ammended 10/11/2012 - SKY
									:vars[] = anal[i][N Items( anal[i] )];													//ammended 16 oct 12 - SKY
									//:distance[]=if(nitems(anal[i][k][3]),([]||anal[i][k][3][1][3])[1])
									:distance[] = ([] || anal[i][k][3][1][4])[1];
								)
							);
                                          // for clustering
							_clusterdist = :distance << getvalues;
							_clusternm = lbx << get selected;
                                          // end clustering
							dt2 = dt2tmp << sort( by( :distance ), order( Ascending ) );
							jmwait( 0 );
							Close( dt2tmp, nosave );
							image1 = new image( _fitdir || "tapir c.jpg" );
							image2 = new image( _fitdir || "tapir d.jpg" );
							image4 = new image( _fitdir || "amur tiger small image a.jpg" );
							_nwclass = New Window( "Classification matrices",<<onclose(try(close(newdt,nosave))),
							//lineupbox(ncol(1),
							//		lineupbox(ncol(6),spacing(8),
							//			buttonbox("Relaunch Analysis",<<setfunction(function({t},include(_fitdir||"Amur Tiger JMautoscript 04-11-12.jsl");((t<<topparent)<<closewindow)))),
							//			buttonbox("Image Feature Extraction",<<setfunction(function({t},include(_fitdir||"Tiger JPscript 29-11-12.jsl");((t<<topparent)<<closewindow)))),
							//			buttonbox("Mapping",fitopt_notImplemented),
							//			buttonbox("Validated Discriminant Analysis",<<setfunction(function({t},include(_fitdir||"DiscriminantValidationV0.2.jsl");((t<<topparent)<<closewindow)))),
							//			buttonbox("Main Menu",<<setfunction(function({t},mainmenu("FIT");((t)<<topparent)<<closewindow))),
							//			spacerbox()
							//		),
							//		spacerbox(size(1,2)),
							//		spacerbox(size(1,2),color(gray))
							//	),
							Lineup Box( N Col( 1 ),	spacing( 10 ),															// ammended 28 oct 2012 - SKY
							image2),																						// ammended 28 oct 2012 - SKY
								Text Box( " " ),
								Lineup Box( N Col( 2 ), spacing( 8 ),
									Text Box( "Distance threshold = " ),
									_distthreshold = 2.6;
									window:nbredit = Number Edit Box( _distthreshold, 5 );
								),
								Button Box( "Clusters", 																	// for clustering
									//_clusternum=floor(nitems(_clusternm)/2)-1;
									_distthreshold = window:nbredit << get;
									If( _distthreshold < 0,
										_distthreshold = 0
									);
									newdt = distance matrix( _clusterdist, _clusternm );
									obj = newdt << Hierarchical Cluster(
										Y( 1 :: N Items( _clusternm ) ), 
										Label( :ClusterVar ),
										Method( "Ward" ),
										Distance Matrix( 1 ), //number of clusters(_clusternum),
										distance graph( 0 ),
										color clusters( 1 )
									);
									jmwait( 0 );
									For( _cli = 1, _cli <= N Items( _clusternm ), _cli++,
										obj << numberofclusters( _cli );
										obj << save clusters;
									);
													//_clusternum=findclustercount(newdt);obj<<numberofclusters(_clusternum);
									_trlky = {};
									_trli = 1;
									_trlky[1 :: N Row( dt2 )] = Expr( Concat Items( Parse( dt2:trails[_trli++] ) ) );
									_trlAA = Associative Array( Eval List( _trlky ), As List( dt2:distance << getvalues ) );
									rpt = obj << report; 
													// expt -- 8/21
									_prelimdist = rpt[Number Col Box( "Distance" )] << getasmatrix;
									_clusternum = N Row( _prelimdist ) - Loc Sorted( _prelimdist, _distthreshold )[1] + 1;
									If( !_clusternum,
										_clusternum = 1
									);
									obj << numberofclusters( _clusternum );
													// end expt
									_dist = Matrix( Reverse( As List( _prelimdist ) ) );
									_dtumlst1 = Reverse( rpt["Clustering History"][String Col Box( 2 )] << get );
									_dtumlst2 = Reverse( rpt["Clustering History"][String Col Box( 3 )] << get );
									rpt[Outline Box( 2 )] << sib prepend(
										Lineup Box( N Col( 2 ), spacing( 5 ),
											//tb = Text Box( Char( Floor( _clusternum ) ) || " Predicted Elephant(s)",,<<setfontsize(10), <<SETFONTSTYLE("bold") ),
											//Slider Box(
											//	1,
											//	N Items( _clusternm ) - 1,
											//	_clusternum,
											//	obj << numberofclusters( _clusternum );
											//	tb << settext( Char( Floor( _clusternum ) ) || " Predicted Elephant(s)" );
											//	db << settext( Char( Round( _dist[_clusternum], 3 ) ) );
											//	dtum << settext(
											//		Char( Round( _trlAA[_dtumlst1[_clusternum] || " " || _dtumlst2[_clusternum]], 3 ) )
											//	);
											//),
											//tb = Text Box( Char( Floor( _clusternum ) ) || " Predicted Elephant(s)",,<<setfontsize(10), <<SETFONTSTYLE("bold") ),			// ammended 28 oct 2012 - SKY
											Text Box( " Datum distance: " ),
											dtum = Text Box( Char( Round( _trlAA[_dtumlst1[_clusternum] || " " || _dtumlst2[_clusternum]], 3 ) ) ),
											Text Box( " Ward distance: " ),
											
											 _mypred=_dist[_clusternum]; //joseph - 3 jan 13
											clusterprob=function({d,i},

      {x,idx=floor(i),val},

      val=d[idx]-_mypred;

      x=if(d[idx]>_mypred,

            1-tDistribution( val/(stddev(d)/sqrt(nrow(d))),nrow(d)-2 )+tDistribution( -1*val/(stddev(d)/sqrt(nrow(d))),nrow(d)-2 ),

            tDistribution( val/(stddev(d)/sqrt(nrow(d))),nrow(d)-2 )+1-tDistribution( -1*val/(stddev(d)/sqrt(nrow(d))),nrow(d)-2 )

      );

      char(round(x,3)*100)

);
											db = Text Box( Char( Round( _dist[_clusternum], 3 ) ) ),
											tb = Text Box( Char( Floor( _clusternum ) ) || " Tapirs Predicted",<<setfontsize(10), <<SETFONTSTYLE("bold") ),
											 hlistbox(
											 Lineup Box( N Col( 1 ),	spacing( 2 ),
											                                                                  Slider Box(
                                                                        1,
                                                                        N Items( _clusternm ) - 1,
                                                                        _clusternum,
                                                                        obj << numberofclusters( _clusternum );
                                                                        tb << settext( Char( Floor( _clusternum ) ) || " Tapirs Predicted" );
                                                                        db << settext( Char( Round( _dist[_clusternum], 3 ) ) );
                                                                        dtum << settext(
                                                                              Char( Round( _trlAA[_dtumlst1[_clusternum] || " " || _dtumlst2[_clusternum]], 3 ) )
                                                                        );
                                                                        
                                                                        // expt -- 11/10/13
                                                                        _prclustpct << settext( clusterprob(_dist,_clusternum)||"%");
																		_prclustnum << settext( char( floor( _clusternum ) ) )

                                                                        // end expt 
                                                                  ),
                                                                  
                                                                 

            

            graphbox(

        yscale(0,0.5),xscale(-5,5),framesize(200,100),suppressaxes,xname("q"),

        adjust=abs(_mypred - _dist[floor( _clusternum )])/(stddev( _dist ) / sqrt( nrow( _dist ) ));

        pen color( "red" );

        yfunction( tdensity(q,nrow(_dist)-2 ),q );

        fill color( "dark blue" );transparency(1);

        yfunction( tdensity(q,nrow(_dist)-2), q, fill(1), max( -1*adjust ) );

        yfunction( tdensity(q,nrow(_dist)-2), q, fill(1), min( adjust ) );

    )
)
),
                                                                  
                                                                  // expt -- 11/10/13
                                                                        hlistbox( textbox(" Chance of "),_prclustnum=textbox( char( floor( _clusternum ) ) ),textbox(" Tapir(s)  =") ),
																		_prclustpct=textbox( clusterprob(_dist,_clusternum)||"%" ),

																	

                                                                  // end expt
                                                                  //Lineup Box( N Col( 1 ),    spacing( 1 ),                                                                       // ammended 10/11/2012 - SKY

											//image1),
										//image4,
										)
									);
								)																			// end clustering
							);
							jmwait( 0 );
							Summarize( lst1 = by( :p, :vars ), c1 = Count(), sum1 = Sum( :Assigned self ) );		// ammended 10/11/2012 & 16 oct 12 - SKY
							Summarize( lst2 = by( :p, :vars, :Assigned self ), sum2 = Sum( :Predicted match ) );	// ammended 10/11/2012 & 16 oct 12 - SKY
							//
							:p << setname( "CP" );																				// ammended 10/11/2012 - SKY
							//
							_p = 0;
							_iincr = N Items( Associative Array( lst2[3] ) );
							For( i = 1, i <= N Items( lst2[1] ), i += _iincr,
								id1 = Ceiling( i / _iincr );
								_t1 = Round( 100 * ((c1[id1] - sum1[id1] - sum2[i]) / (c1[id1] - sum1[id1])) );
								_t2 = Round( 100 * (sum2[i + _iincr - 1] / sum1[id1]) );
								mat = (([0 100, 100 0] + Diag( _t2 || _t1 )) * [1 -1, -1 1]) + Identity( 2 ) * 100;
								If( _p != Num( lst2[1][i] ),
									_p = Num( lst2[1][i] );
									_nwclass[Text Box( 1 )] << sib append(
										Border Box( bottom( 10 ), Right( 10 ), Left( 5 ), 
                                                                  //_obx=outlinebox("Contour Probability = "||lst2[1][i],<<close)	// ammended 10/11/2012 - SKY
											_obx = Outline Box( "Contour Probability = " || lst2[1][i], <<close )					// ammended 10/11/2012 - SKY
										)
									);
								);
								_obx << append( _txbx = Text Box( "Number of vars = " || lst2[2][i] || ":", <<set font style( "Bold" ) ) );
								_bxstr = Eval Insert( tmpltstr );
								_tmpexpr = Substitute(
										Expr(
											_txbx << sib append(
												H List Box(
													_modcbx = Check Box(
														{"Show model"},<<setfunction(function({t},(t<<sib)<<set(t<<get)))             // ammended 11-04-15 - Joseph

              /*window:me = _nwclass;

              _tmpbx = window:me << xpath( _bxstr );

              _tmpst = (((_tmpbx[1] << parent) << parent) << child) << get;

              (_tmpbx[1] << parent) << set( _tmpst );*/
													)
												)
											)
										),
									Expr( _bxstr ), _bxstr,
									Expr( _nwclass ), Name Expr( _nwclass )
								);
								Eval( _tmpexpr );
								_modcbx << sib append(
									If Box(
										0,
										Border Box( bottom( 12 ), Script Box( Char( /*arg(*/modAA[Num( lst2[2][i] )]/*,2)*/ ) ) ),
										Text Box( "Variables = " || lst2[2][i] )
									)
								);
								_txbx << sib append(
									Border Box( top( 5 ), bottom( 12 ),
										_tbx = Table Box(
																//_scbx=stringcolbox("%",{"Self","Non-self"})
											_scbx = String Col Box( "", {"Self (N)", "(%)", "Non-self (N)", "(%)", "Total (N)", "(%)"} ) //ammended 10-11-12 - SKY
										)
									)
								);
								_txbx << sib prepend( Text Box( " " ) );
                                                //_scbx<<sib append(numbercolbox("Non-self",mat[0,2]));
								//_scbx<<sib append(numbercolbox("Self",mat[0,1]));
								_scbx << sib append(

              Number Col Box( "Misclass",

                     (sum1[id1] - sum2[i + _iincr - 1]) |/ . |/ sum2[i] |/ . |/ (sum2[i] + sum1[id1] - sum2[i + _iincr - 1])

              )

       );

       _scbx << sib append( Number Col Box( "Total", sum1[id1] |/ . |/ c1[id1] - sum1[id1] |/ . |/ c1[id1] ) );

       _scbx << sib append(

              Number Col Box( "Non-self", (sum1[id1] - sum2[i + _iincr - 1]) |/ mat[1, 2] |/ c1[id1] - sum1[id1] - sum2[i] |/ mat[2, 2] )

       );

       _scbx << sib append(

              Number Col Box( "Self", sum2[i + _iincr - 1] |/ mat[1, 1] |/ sum2[i] |/ mat[2, 1] )

       );
								_tbx << Table Style( "Heading Separator" );
							);
							_nwclass[Text Box( 1 )] << sib prepend(
								Border Box( top( 15 ), Left( 5 ),
									Outline Box( "Category: " || (cdlgorig_x1 << GetItems)[1],
										<<close,
										Lineup Box( N Col( 2 ), spacing( 5 ),
											String Col Box( "Validation", cdlgorig_x2 << GetItems ),
											String Col Box( "Selected", lbx << get selected )									//ammended 16 oct 12 - sky
										)
									)
								)
							);
						);
						dt << setwindowsize( origdtsize[1], origdtsize[2] )										// restore dt size --- added 9/20/2012
						;
					),
					Button Box( "Cancel",
						dt << setwindowsize( origdtsize[1], origdtsize[2] );
						_nw << CloseWindow;
					), 		// restore dt size --- added 9/20/2012
					Spacer Box( size( 2, 8 ) ),
					Spacer Box( size( 2, 1 ), color( gray ) ),
					Spacer Box( size( 2, 8 ) ),
					Button Box( "Remove",
						cdlgorig_y << RemoveSelected;
						cdlgorig_x1 << RemoveSelected;
						cdlgorig_x2 << RemoveSelected;
						If( !N Items( cdlgorig_x2 << GetItems ),
							ibx << set( 0 );
							cbx << set( 1, 0 );
							lbx << remove all;
						);
					),
					Button Box( "Reset",
						((_nw << xpath( "//ButtonBox[@title='Reset']" ))[1]) << enable( 0 );
						((_nw << xpath( "//ButtonBox[@title='Restart']" ))[1]) << set button name( "Run" );						//ammended 16 oct 12 - sky
						cdlgorig_y << Remove all;
						cdlgorig_y << Append( Current Data Table() << get column names( numeric, string ) );
						cdlgorig_x1 << Remove all;
						cdlgorig_x2 << Remove all;
						If( !N Items( cdlgorig_x2 << GetItems ),
							ibx << set( 0 );
							cbx << set( 1, 0 );
							lbx << remove all;
						);
						vbx1 << set( 18 );																						// ammended 10/11/2012 - SKY
						vbx2 << set( 18 );																						// ammended 10/11/2012 - SKY
						vbx3 << set( 1 );													
						pbx1 << set( 0.5 );																						// ammended 10/11/2012 - SKY
						pbx2 << set( 0.5 );																						// ammended 10/11/2012 - SKY
						pbx3 << set( 0.1 );
						_restart = 0;									
						serialize_state( 0 );
					),
					//buttonbox("Help",web( "file://" || _addinHelpPath || "Add-in Help.pdf"))
				)
			);
		)
	),
	Lineup Box( N Col( 1 ), spacing( 10 ),
		Check Box( {"Interrupt"}, <<setfunction( Function( {t}, _wait = (t << get) ) ) ),
		nc_cbx = Check Box ( {"Display normal contours"} )																
	),
	Lineup Box( N Col( 2 ), spacing( 10 ),
	Lineup Box( N Col( 1 ), spacing( 10 ),
	
	Border Box( Left( 10 ), top( 5 ), bottom( 5 ),
		Lineup Box( N Col( 4 ),
			Text Box( " " ),
			H Center Box( Text Box( "Start" ) ),
			H Center Box( Text Box( "Stop" ) ),
			H Center Box( Text Box( "Incr" ) ), 
                  //textbox("Probability"), pbx1=numbereditbox(p_strt), 							
			Text Box( "Contour Probability" ),																					// ammended 10/11/2012 - SKY
			pbx1 = Number Edit Box( p_strt ), 							
			pbx2 = Number Edit Box( p_stop ),
			pbx3 = Number Edit Box( p_incr ),
			Text Box( "Number of Variables" ),																					// ammended 10/13/2012 - SKY
			vbx1 = Number Edit Box( v_strt ), 								
			vbx2 = Number Edit Box( v_stop ),
			vbx3 = Number Edit Box( v_incr )
		)
	)
	),
	Lineup Box( N Col( 2 ), spacing( 10 ),
	image3),
	)
);
If( _restart,
	vbx1 << set( _restart_vbx1 );
	vbx2 << set( _restart_vbx2 );
	vbx3 << set( _restart_vbx3 );
	pbx1 << set( _restart_pbx1 );
	pbx2 << set( _restart_pbx2 );
	pbx3 << set( _restart_pbx3 );
	((_nw << xpath( "//ButtonBox[@title='Run']" ))[1]) << set button name( "Restart" );											//ammended 16 oct 12 - SKY
	((_nw << xpath( "//ButtonBox[@title='Reset']" ))[1]) << enable( 1 );
,
	((_nw << xpath( "//ButtonBox[@title='Reset']" ))[1]) << enable( 0 )
);