cluster_dendrogram_98s.dlg

来自「是一个经济学管理应用软件 很难找的 但是经济学学生又必须用到」· DLG 代码 · 共 193 行

/*
  cluster dendrogram_98s

*!  VERSION 1.0.0  23mar2005

*/

VERSION 9.0

INCLUDE graph_header
INCLUDE header
HELP hlp1, view("help cluster_dendrogram")
RESET res1

DIALOG main, tabtitle("Main") ///
	label("cluster dendrogram - Dendrograms for hier. cluster analysis")
BEGIN
  TEXT     tx_clname    _lft      _top      _cwd3_1   .,		///
	label("Cluster analysis:")
  LISTBOX  lb_clname    @         _ss       @         70,		///
	contents(char _dta[_cl])					///
	label("Cluster analysis")
  DEFINE y @y

  CHECKBOX ck_quick     _lft      +85       _cwd3_1   .,		///
	option(quick)							///
	label("Do not center parent branches")

  TEXT     tx_labels    @         _ms       @         .,		///
	label("Variable containing leaf labels:")
  VARNAME  vn_labels    @         _ss       _vnwd     .,		///
	option(labels)							///
	label("Variable containing leaf labels")

  GROUPBOX gb_orient    @         _ls       _cwd3_1   _ht4,		///
  	label("Orientation")
  RADIO    rb_vert	_ilft     _ss       _cwd3_3   .,		///
  	first label("Vertical")
  RADIO    rb_horizontal @        _ss       @         ., 		///
  	last label("Horizontal") option(horizontal)

  GROUPBOX gb_branches	_lft3_2   _top      _comb3_1  _ht9,		///
  	label("Branches")
  RADIO    rb_all       _indent   _ss       _inwd     ., first		///
	onclickon(script nocut)						///
	label("Plot the full dendrogram")
  RADIO    rb_cutnumber @         _ss       @         ., 		///
  	label("Plot top branches only")					///
	onclickon(script cutnum)
  RADIO    rb_cutvalue  @         _ss       @         ., 		///
  	last label("Plot branches above a (dis)similarity measure")	///
	onclickon(script cutval)

  SPINNER  sp_cutnumber @         _ls       _en7wd    .,		///
	min(2) max(100) default(20)					///
	option(cutnumber)						///
	label("Number of top branches")
  EDIT     en_cutvalue  @         @         _en7wd    ., numonly	///
	option(cutvalue)						///
	label("Branch threshold")
  TEXT     tx_cutnumber _en7sep   @         200       .,		///
	label("Number of top branches")
  TEXT     tx_cutvalue  @         @         @         .,		///
	label("Branch threshold")

  CHECKBOX ck_showcnt   _lft3_2    _xxls    _comb3_1  _ht8,		///
  	groupbox							///
  	onclickon(program check_showcount)				///
  	onclickoff(program check_showcount)				///
	option(showcount)						///
	label("Display number of observations for each branch")
  EDIT     ed_cntprefix _indent   _ms       _en14wd   .,		///
  	default("n=")							///
  	option(countprefix)						///
  	label("prefix for the branch count")
DEFINE holdx @x
  TEXT     tx_cntprefix _en14sep  @         _en14r3cb .,		///
  	label("prefix for the branch count")
  EDIT     ed_cntsuffix holdx     _ms       _en14wd   .,		///
  	default("")							///
  	option(countsuffix)						///
  	label("suffix for the branch count")
  TEXT     tx_cntsuffix _en14sep  @         _en14r3cb .,		///
  	label("suffix for the branch count")
  CHECKBOX ck_cntinline holdx     _ls       465       .,		///
  	option(countinline)						///
  	label("Put branch count in-line with branch label")

END

SCRIPT nocut
BEGIN
	main.sp_cutnumber.hide
	main.tx_cutnumber.hide
	main.en_cutvalue.hide
	main.tx_cutvalue.hide
	main.gb_branches.setposition . . . 90
	main.ck_showcnt.hide
	main.ed_cntprefix.hide
	main.tx_cntprefix.hide
	main.ed_cntsuffix.hide
	main.tx_cntsuffix.hide
	main.ck_cntinline.hide
END

SCRIPT cutnum
BEGIN
	main.sp_cutnumber.show
	main.tx_cutnumber.show
	main.en_cutvalue.hide
	main.tx_cutvalue.hide
	main.gb_branches.setposition . . . 125
	main.ck_showcnt.show
	main.ed_cntprefix.show
	main.tx_cntprefix.show
	main.ed_cntsuffix.show
	main.tx_cntsuffix.show
	main.ck_cntinline.show
END

SCRIPT cutval
BEGIN
	main.sp_cutnumber.hide
	main.tx_cutnumber.hide
	main.en_cutvalue.show
	main.tx_cutvalue.show
	main.gb_branches.setposition . . . 125
	main.ck_showcnt.show
	main.ed_cntprefix.show
	main.tx_cntprefix.show
	main.ed_cntsuffix.show
	main.tx_cntsuffix.show
	main.ck_cntinline.show
END

PROGRAM check_showcount
BEGIN
	if main.ck_showcnt {
		call main.ed_cntprefix.enable
		call main.tx_cntprefix.enable
		call main.ed_cntsuffix.enable
		call main.tx_cntsuffix.enable
		call main.ck_cntinline.enable
	}
	if ! main.ck_showcnt {
		call main.ed_cntprefix.disable
		call main.tx_cntprefix.disable
		call main.ed_cntsuffix.disable
		call main.tx_cntsuffix.disable
		call main.ck_cntinline.disable
	}
END

INCLUDE ifin
INCLUDE line_opts
INCLUDE gr_twoway_98s

SCRIPT POSTINIT
BEGIN
	line_opts.settabtitle "Plot"
END

PROGRAM command
BEGIN
	put "cluster dendrogram " main.lb_clname
	INCLUDE _ifin_pr
	beginoptions
		option main.ck_quick
		optionarg main.vn_labels
		option main.rb_horizontal
		if main.rb_cutnumber {
			optionarg main.sp_cutnumber
		}
		if main.rb_cutvalue {
			require main.en_cutvalue
			optionarg main.en_cutvalue
		}
		if main.ck_showcnt {
			option main.ck_showcnt
			if !default(main.ed_cntprefix) & main.ed_cntprefix {
				optionarg /quoted main.ed_cntprefix
			}
			if !default(main.ed_cntsuffix) & main.ed_cntsuffix {
				optionarg /quoted main.ed_cntsuffix
			}
			option main.ck_cntinline
		}

		put " " /program line_opts_output
		put " " /program gr_twoway_output
	endoptions
END