/*
	mds

*!  VERSION 1.1.3  18apr2011

*/

VERSION 12.0

INCLUDE _std_wide
INCLUDE header
HELP hlp1, view("help mds")
RESET res1

DIALOG main, label("mds - Multidimensional scaling for two-way data") tabtitle("Model")
BEGIN
  TEXT tx_var		_lft	_top	_comb3_1	.,		///
	label("Variables:")
  VARLIST vl_var	@	_ss	@		.,		///
	label("Variables") allowcat
  TEXT tx_id		_lft3_3	_top	_cwd3_1		.,		///
	label("ID variable:")
  VARNAME vn_id		@	_ss	@		.,		///
	label("ID variable") option(id)

  GROUPBOX gb_method	_lft	_ls	_cwd1		_ht6,		///
	label("MDS method")
DEFINE holdy @y
  RADIO rb_classical	_indent	_ss	_inwd		.,		///
	first								///
	option(method(classical))					///
	onclickon(program main_classical_on)				///
	label("Classical")
  RADIO rb_modern	@	_ss	@		.,		///
	option(method(modern))						///
	onclickon(program main_modern_on)				///
	label("Modern")
  RADIO rb_nonmetric	@	_ss	@		.,		///
	last								///
	option(method(nonmetric))					///
	onclickon(program main_nonmetric_on)				///
	label("Nonmetric (modern)")

  TEXT tx_loss		_lft2	holdy _cwd1		.,		///
	label("Loss functions of metric and nonmetric scaling")
DEFINE holdy @y
  COMBOBOX cb_loss	@	_ss	_cwd1		.,		///
	dropdownlist							///
	option(loss)							///
	default(stress)							///
	label("Loss functions of metric and nonmetric scaling")		///
	contents(loss_list)						///
	values(loss_values)

  TEXT tx_transform	_lft2	_ls	_cwd1		.,		///
	label("Transformations of dissimilarities")
DEFINE holdy @y
  COMBOBOX cb_transform	@	_ss	_cwd1		.,		///
	dropdownlist							///
	option(transform)						///
	default(identity)						///
	label("Transformations of dissimilarities")			///
	contents(transform_list)					///
	values(transform_values)

  GROUPBOX gb_normal	_lft	_ls	_cwd1 		_ht10h,		///
	label("Normalization method")
DEFINE holdy @y
  RADIO rb_principal	_indent	_ss	265		.,		///
	first								///
	onclickon(script main_target_off)				///
	label("Principal orientation")
  RADIO rb_normclass	@	_ss	@		.,		///
	onclickon(script main_target_off)				///
	label("Procrustes rotation toward classical solution")

  RADIO rb_target	@	_ss	@		.,		///
	last								///
	onclickon(script main_target_on)				///
	label("Procrustes rotation toward matrix")
  COMBOBOX cb_matname	_rbsep	_ss	165		60,		///
	dropdown							///
	label("Target matrix")						///
	contents(matrix)
  CHECKBOX ck_copy	@	_ms	@		.,		///
	option(copy)							///
	label("Ignore naming conflicts")

  TEXT tx_dim		_lft2	holdy	_cwd1		.,		///
	label("Dimension of the approximating configuration")
  SPINNER sp_dim	@	_ss	_spwd		.,		///
	label("Configuration dimensions")				///
	min(1)								///
	max(10000)							///
	default(2)							///
	option(dimension)
  CHECKBOX ck_addconstant _lft2	_ls	_cwd1		.,		///
	label("Make distance matrix positive definite")			///
	option(addconstant)
END

DIALOG model2, tabtitle("Model 2")
BEGIN
  CHECKBOX ck_unit	_lft	_top	_iwd		.,		///
	onclickon(model2.vl_unit.enable)				///
	onclickoff(model2.vl_unit.disable)				///
    label("Scale variables to min=0 and max=1: (leave empty for all variables)")
  VARLIST vl_unit	_indent2 _ss	_inwd		.,		///
	label("Scale variables") option(unit) allowcat

  CHECKBOX ck_std	_lft	_ls	_iwd		.,		///
	option(std)							///
	onclickon(model2.vl_std.enable)					///
	onclickoff(model2.vl_std.disable)				///
    label("Scale variables to mean=0 and sd=1: (leave empty for all variables)")
  VARLIST vl_std	_indent2 _ss	_inwd		.,		///
	label("Scale variables") option(std) allowcat

  GROUPBOX gb_dist	_lft	_ls	_iwd		_ht10,		///
	label("(Dis)similarity measure")
  RADIO rb_distc	_indent	_ss	110		.,	first	///
	label("Continuous")						///
	onclickon(script d_continuous_on)
DEFINE holdx @x
  RADIO rb_distb	+120	@	@		.,		///
	label("Binary")							///
	onclickon(script d_binary_on)
  RADIO rb_distm	+120	@	@		.,	 last	///
		label("Mixed")						///
		onclickon(script d_mixed_on)

  LISTBOX lb_distc	holdx	_ms	_comb3_2	_ht4,		///
	contents(continuous_dist)					///
	onselchangelist(cont_power)					///
	values(contin_value)
DEFINE holdy @y
  LISTBOX lb_distb	@	@	@		_ht4,		///
	contents(binary_dist)						///
	value(binary_value)
DEFINE holdy @y
  LISTBOX lb_distm	@	@	@		_ht4,		///
		contents(mixed_dist)					///
		values(mixed_value)
  TEXT tx_power		_lft3_3	holdy	_cwd3_2		.,		///
	label("# for L(#) or Lpower(#):")
  EDIT en_power		_lft3_3	_ss	_en7wd		.,		///
	numonly default(literal "2")					///
	label("# for L(#) or Lpower(#)")

  TEXT tx_convertsim	_lft	250	_cwd1		.,		///
	label("Convert similarity to dissimilarity")
  COMBOBOX cb_s2d	@	_ss	_cwd1		.,		///
	dropdownlist							///
	option(s2d)							///
	label("Convert similarity to dissimilarity")			///
	contents(s2d_list)						///
	values(s2d_values)
END

INCLUDE byifin

DIALOG report, tabtitle("Reporting")
BEGIN
  SPINNER sp_neigen	_lft	_top	_spwd		.,		///
	label("Dimensions")						///
	min(1)								///
	max(10000)							///
	default(10)							///
	option(neigen)
  TEXT tx_neigen	_spsep	@	_spr		.,		///
	label("Maximum number of eigenvalues to display")
  CHECKBOX ck_config	_lft	_ls	_iwd		.,		///
	label("Display table with configuration coordinates")		///
	option(config)
  CHECKBOX ck_noplot	@	_ms	@		.,		///
	label("Suppress configuration plot")				///
	option(noplot)
END

INCLUDE _min_mds

INCLUDE _cl_dist_list

SCRIPT d_continuous_on
BEGIN
	model2.lb_distc.show
	model2.lb_distb.hide
	model2.lb_distm.hide
	model2.lb_distc.withvalue model2.lb_distc.setvalue "@"
	program convert_sim_check
END

SCRIPT d_binary_on
BEGIN
	model2.lb_distb.show
	model2.lb_distc.hide
	model2.lb_distm.hide
	script power_off
	program convert_sim_check
END

SCRIPT d_mixed_on
BEGIN
	model2.lb_distb.hide
	model2.lb_distc.hide
	model2.lb_distm.show
	script power_off
	program convert_sim_check
END

SCRIPT power_on
BEGIN
	model2.tx_power.show
	model2.en_power.show
	program convert_sim_check
END

SCRIPT power_off
BEGIN
	model2.tx_power.hide
	model2.en_power.hide
	program convert_sim_check
END

PROGRAM main_classical_on
BEGIN
	call main.tx_loss.disable
	call main.cb_loss.disable
	call main.tx_transform.disable
	call main.cb_transform.disable

	if main.rb_normclass {
		call main.rb_principal.seton
	}
	call main.rb_normclass.disable

	call main.ck_addconstant.enable

//	disable all minimization opts
	call min.gb_init.disable
	call min.rb_classical.disable
	call min.rb_random.disable
	call min.ed_seed.disable
	call min.tx_seed.disable
	call min.rb_from.disable
	call min.cb_matname.disable
	call min.ck_copy.disable
	call min.sp_iter.disable
	call min.tx_iter.disable
	call min.gb_convtol.disable
	call min.ed_tol.disable
	call min.tx_tol.disable
	call min.ed_ltol.disable
	call min.tx_ltol.disable
	call min.ck_protect.disable
	call min.sp_protect.disable
	call min.ck_nolog.disable
	call min.ck_trace.disable
	call min.ck_gradient.disable

	call report.sp_neigen.enable
	call report.tx_neigen.enable
END

PROGRAM main_modern_on
BEGIN
	call main.tx_loss.enable
	call main.cb_loss.enable
	call main.tx_transform.enable
	call main.cb_transform.enable

	call main.rb_normclass.enable
	call main.ck_addconstant.disable

//	enable all minimization opts
	call min.gb_init.enable
	call min.rb_classical.enable
	call min.rb_random.enable
	if min.rb_random {
		call min.ed_seed.enable
		call min.tx_seed.enable
	}
	call min.rb_from.enable
	if min.rb_from {
		call min.cb_matname.enable
		call min.ck_copy.enable
	}
	call min.sp_iter.enable
	call min.tx_iter.enable
	call min.gb_convtol.enable
	call min.ed_tol.enable
	call min.tx_tol.enable
	call min.ed_ltol.enable
	call min.tx_ltol.enable
	call min.ck_protect.enable
	if min.ck_protect {
		call min.sp_protect.enable
	}

	call min.ck_nolog.enable
	if !min.ck_nolog {
		call min.ck_trace.enable
		call min.ck_gradient.enable
	}

	call report.sp_neigen.disable
	call report.tx_neigen.disable
END

PROGRAM main_nonmetric_on
BEGIN
	call main.tx_loss.disable
	call main.cb_loss.disable
	call main.tx_transform.disable
	call main.cb_transform.disable
	call main.rb_normclass.enable
	call main.ck_addconstant.disable

//	enable all minimization opts
	call min.gb_init.enable
	call min.rb_classical.enable
	call min.rb_random.enable
	if min.rb_random {
		call min.ed_seed.enable
		call min.tx_seed.enable
	}
	call min.rb_from.enable
	if min.rb_from {
		call min.cb_matname.enable
		call min.ck_copy.enable
	}
	call min.sp_iter.enable
	call min.tx_iter.enable
	call min.gb_convtol.enable
	call min.ed_tol.enable
	call min.tx_tol.enable
	call min.ed_ltol.enable
	call min.tx_ltol.enable
	call min.ck_protect.enable
	if min.ck_protect {
		call min.sp_protect.enable
	}

	call min.ck_nolog.enable
	if !min.ck_nolog {
		call min.ck_trace.enable
		call min.ck_gradient.enable
	}

	call report.sp_neigen.disable
	call report.tx_neigen.disable
END

SCRIPT main_target_on
BEGIN
	main.cb_matname.enable
	main.ck_copy.enable
END

SCRIPT main_target_off
BEGIN
	main.cb_matname.disable
	main.ck_copy.disable
END

LIST s2d_list
BEGIN
	"Using: d(ij)=sqrt(s(ii)+s(jj)-2s(ij))"
	"Using: d(ij)=1-s(ij)"
END

LIST s2d_values
BEGIN
	standard
	oneminus
END

LIST loss_list
BEGIN
	"Stress criterion, normalized by distances"
	"Stress criterion, normalized by disparities"
	"Squared stress criterion, normalized by distances"
	"Squared stress criterion, normalized by disparities"
	"Strain criterion"
	"Sammon mapping"
END

LIST loss_values
BEGIN
	stress
	nstress
	sstress
	nsstress
	strain
	sammon
END

LIST transform_list
BEGIN
	"No transformation; disparity = dissimilarity"
	"Power: disparity = dissimilarity^alpha"
	"Weakly monotonic increasing functions (nonmetric scaling)"
END

LIST transform_values
BEGIN
	identity
	power
	monotonic
END

PROGRAM convert_sim_check
BEGIN
	if model2.rb_distc {
		if model2.lb_distc.equals("correlation") | model2.lb_distc.equals("angular") {
			call model2.tx_convertsim.enable
			call model2.cb_s2d.enable
		}
		if ! (model2.lb_distc.equals("correlation") | model2.lb_distc.equals("angular")) {
			call model2.tx_convertsim.disable
			call model2.cb_s2d.disable
		}
	}

	if model2.rb_distb {
		call model2.tx_convertsim.enable
		call model2.cb_s2d.enable
	}

	if model2.rb_distm {
		call model2.tx_convertsim.disable
		call model2.cb_s2d.disable
	}
END

PROGRAM unit_output
BEGIN
	put model2.vl_unit
END

PROGRAM std_output
BEGIN
	put model2.vl_std
END

PROGRAM normalization_output
BEGIN
	if !main.rb_principal {
		put "normalize("
		if main.rb_normclass {
			put "classical)"
		}
		if main.rb_target {
			put "target("
			put main.cb_matname
			put ")"
			if main.ck_copy {
				put ", "
				put "copy"
			}
			put ")"
		}
	}
END

PROGRAM command
BEGIN
	allowxi
	INCLUDE _by_pr
	put "mds "
	varlist main.vl_var
	INCLUDE _ifin_pr
	beginoptions
		require main.vn_id
		optionarg main.vn_id
		option radio(main rb_classical rb_modern rb_nonmetric)
		if model2.ck_unit {
			put "unit"
			if model2.vl_unit {
				put "("
				put /program unit_output
				put ")"
			}
			put " "
		}
		if model2.ck_std {
			put "std"
			if model2.vl_std {
				put "("
				put /program std_output
				put ")"
			}
			put " "
		}
		INCLUDE _cl_dist_model2_pr
		if main.rb_target {
			require main.cb_matname
		}
		put " " /program normalization_output
		if main.rb_nonmetric {
			put "loss(stress) transform(monotonic) "
		}
		else {
			optionarg /hidedefault main.cb_loss
			optionarg /hidedefault main.cb_transform
		}
		optionarg model2.cb_s2d
		optionarg /hidedefault main.sp_dim
		option main.ck_addconstant
		optionarg /hidedefault report.sp_neigen
		option report.ck_config
		option report.ck_noplot

		put /program min_output
	endoptions
END
