%
%  write a Dakota .in file.
%
%  []=dakota_in_write(method,dvar,dresp,filei,params)
%
function []=dakota_in_write(method,dvar,dresp,filei,params)

if ~nargin
    help dakota_in_write
    return
end

%  process the input parameters

if ~exist('method' ,'var') || isempty(method)
    method=input('Method: sampling (s) or local reliability (l)?  ','s');
    if     strncmpi(method,'s',1)
        method='nond_sampling';
    elseif strncmpi(method,'l',1)
        method='nond_local_reliability';
    end
end

switch method
%     case {'dot_bfgs','dot_frcg','dot_mmfd','dot_slp','dot_sqp'}
%     case {'npsol_sqp'}
    case {'conmin_frcg','conmin_mfd'}
%     case {'optpp_cg','optpp_q_newton','optpp_fd_newton',...
%             'optpp_newton','optpp_pds'}
%     case {'asynch_pattern_search'}
%     case {'coliny_cobyla','coliny_direct','coliny_ea',...
%             'coliny_pattern_search','coliny_solis_wets'}
%     case {'ncsu_direct'}
%     case {'moga','soga'}
%     case {'nl2sol','nlssol_sqp','optpp_g_newton'}
    case {'nond_sampling'}
    case {'nond_local_reliability'}
%     case {'dace','fsu_quasi_mc','fsu_cvt'}
%     case {'vector_parameter_study','list_parameter_study',...
%             'centered parameter_study','multidim_parameter_study'}
    otherwise
        error('Unrecognized method: ''%s''.',method);
end

if ~exist('filei' ,'var') || isempty(filei)
    filei=input('Dakota input file to write?  ','s');
end
[pathstr,name,ext,versn] = fileparts(filei);
if isempty(ext)
    ext='.in';
end
filei2=fullfile(pathstr,[name ext versn]);

display(sprintf('Opening Dakota input file ''%s''.',filei2));
fidi=fopen(sprintf('%s',filei2),'w');
if (fidi < 0)
    error('''%s'' could not be opened.',filei2);
end

if ~exist('params','var')
    params=struct();
end
params=dakota_in_params(params);

%  write the strategy section

strategy_write(fidi,params);

%  write the method section

method_write(fidi,method,dresp,params);

%  write the model section

model_write(fidi);

%  write the variables section

variables_write(fidi,method,dvar);

%  write the interface section

interface_write(fidi,params);

%  write the responses section

responses_write(fidi,method,dresp,params);

fclose(fidi);
display('End of file successfully written.');

end

%%  function to write the strategy section of the file

function []=strategy_write(fidi,params)

display('Writing strategy section of Dakota input file.');

fprintf(fidi,'strategy,\n');
fprintf(fidi,'\tsingle_method\n');
param_write(fidi,'\t  ','graphics','','\n',params);
param_write(fidi,'\t  ','tabular_graphics_data','','\n',params);
param_write(fidi,'\t  ','tabular_graphics_file',' ''','''\n',params);
fprintf(fidi,'\n');

end

%%  function to write the method section of the file

function []=method_write(fidi,method,dresp,params)

display('Writing method section of Dakota input file.');

fprintf(fidi,'method,\n');
fprintf(fidi,'\t%s\n',method);
param_write(fidi,'\t  ','output',' ','\n',params);
param_write(fidi,'\t  ','max_iterations','           = ','\n',params);
param_write(fidi,'\t  ','max_function_evaluations',' = ','\n',params);
param_write(fidi,'\t  ','convergence_tolerance','    = ','\n',params);

switch method
%     case {'dot_bfgs','dot_frcg','dot_mmfd','dot_slp','dot_sqp'}
%     case {'npsol_sqp'}
    case {'conmin_frcg','conmin_mfd'}
%     case {'optpp_cg','optpp_q_newton','optpp_fd_newton',...
%             'optpp_newton','optpp_pds'}
%     case {'asynch_pattern_search'}
%     case {'coliny_cobyla','coliny_direct','coliny_ea',...
%             'coliny_pattern_search','coliny_solis_wets'}
%     case {'ncsu_direct'}
%     case {'moga','soga'}
%     case {'nl2sol','nlssol_sqp','optpp_g_newton'}
    case {'nond_sampling'}
        param_write(fidi,'\t  ','seed','      = ','\n',params);
        param_write(fidi,'\t  ','samples','   = ','\n',params);
        param_write(fidi,'\t  ','sample_type',' ','\n',params);
    case {'nond_local_reliability'}
%     case {'dace','fsu_quasi_mc','fsu_cvt'}
%     case {'vector_parameter_study','list_parameter_study',...
%             'centered parameter_study','multidim_parameter_study'}
end

%  write response levels

if isfield(dresp,'rf')
    param_write(fidi,'\t  ','distribution',' ','\n',params);
    [respl,probl,rell,grell]=dresp_levels(dresp.rf);
    if ~isempty(respl)
        rlev_write(fidi,'response_levels',respl);
        param_write(fidi,'\t  ','compute',' ','\n',params);
    end 
    if ~isempty(probl)
        rlev_write(fidi,'probability_levels',probl);
    end
    if ~isempty(rell)
        rlev_write(fidi,'reliability_levels',rell);
    end
    if ~isempty(grell)
        rlev_write(fidi,'gen_reliability_levels',grell);
    end
end
fprintf(fidi,'\n');

end

%%  function to write response levels

function []=rlev_write(fidi,ltype,levels)

fprintf(fidi,'\t  num_%s =',ltype);
for i=1:length(levels)
    fprintf(fidi,' %d',length(levels{i}));
end
fprintf(fidi,'\n');

fprintf(fidi,'\t  %s =\n',ltype);

for i=1:length(levels)
    if ~isempty(levels{i})
        vector_write(fidi,sprintf('\t    '),levels{i},8,76);
    end
end

end

%%  function to write the model section of the file

function []=model_write(fidi)

display('Writing model section of Dakota input file.');

fprintf(fidi,'model,\n');
fprintf(fidi,'\t%s\n\n','single');

end

%%  function to write the variables section of the file

function []=variables_write(fidi,method,dvar)

display('Writing variables section of Dakota input file.');

fprintf(fidi,'variables,\n');

%  variables vary by method

switch method
%     case {'dot_bfgs','dot_frcg','dot_mmfd','dot_slp','dot_sqp'}
%     case {'npsol_sqp'}
    case {'conmin_frcg','conmin_mfd'}
        vsets_write(fidi,dvar,'cdv','csv');
%     case {'optpp_cg','optpp_q_newton','optpp_fd_newton',...
%             'optpp_newton','optpp_pds'}
%     case {'asynch_pattern_search'}
%     case {'coliny_cobyla','coliny_direct','coliny_ea',...
%             'coliny_pattern_search','coliny_solis_wets'}
%     case {'ncsu_direct'}
%     case {'moga','soga'}
%     case {'nl2sol','nlssol_sqp','optpp_g_newton'}
    case {'nond_sampling'}
        vsets_write(fidi,dvar,'nuv','csv');
    case {'nond_local_reliability'}
        vsets_write(fidi,dvar,'nuv','csv');
%     case {'dace','fsu_quasi_mc','fsu_cvt'}
%     case {'vector_parameter_study','list_parameter_study',...
%             'centered parameter_study','multidim_parameter_study'}
end

fprintf(fidi,'\n');

end

%%  function to write variable sets

function []=vsets_write(fidi,dvar,varargin)

for i=1:length(varargin)
    switch(varargin{i})
        case 'cdv'
            vstring='continuous_design';
        case 'nuv'
            vstring='normal_uncertain';
        case 'csv'
            vstring='continuous_state';
        otherwise
            warning('vsets_write:unrec_var',...
                'Unrecognized variable ''%s''.',varargin{i});
    end

    if isfield(dvar,varargin{i})
        vlist_write(fidi,vstring,varargin{i},dvar.(varargin{i}));
    end
end

end

%%  function to write variable list

function []=vlist_write(fidi,vstring,vstring2,dvar)

%  put variables into lists for writing

vinitpt=dvar_initpt(dvar);
vlower =dvar_lower (dvar);
vupper =dvar_upper (dvar);
vmean  =dvar_mean  (dvar);
vstddev=dvar_stddev(dvar);
vinitst=dvar_initst(dvar);
vdesc  =dvar_desc  (dvar);

%  write variables
%  (using Dakota 4.1 syntax for backward compatability)

disp(sprintf('  Writing %d %s variables.',length(dvar),class(dvar)));

fprintf(fidi,'\t%s = %d\n',vstring,length(dvar));
if ~isempty(vinitpt)
    fprintf(fidi,'\t  %s_initial_point =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vinitpt,6,76);
end
if ~isempty(vlower)
    fprintf(fidi,'\t  %s_lower_bounds =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vlower ,6,76);
end
if ~isempty(vupper)
    fprintf(fidi,'\t  %s_upper_bounds =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vupper ,6,76);
end
if ~isempty(vmean)
    fprintf(fidi,'\t  %s_means =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vmean  ,6,76);
end
if ~isempty(vstddev)
    fprintf(fidi,'\t  %s_std_deviations =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vstddev,6,76);
end
if ~isempty(vinitst)
    fprintf(fidi,'\t  %s_initial_state =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vinitst,6,76);
end
if ~isempty(vdesc)
    fprintf(fidi,'\t  %s_descriptors =\n',vstring2);
    vector_write(fidi,sprintf('\t    '),vdesc  ,6,76);
end

end

%%  function to write the interface section of the file

function []=interface_write(fidi,params)

display('Writing interface section of Dakota input file.');

fprintf(fidi,'interface,\n');

if strcmpi(params.analysis_driver,'matlab')
%  Error: asynchronous capability not yet supported in direct interfaces.
    fprintf(fidi,'\tdirect\n');
    param_write(fidi,'\t  ','analysis_driver','     = ''','''\n',params);
    [pathstr,name,ext,versn] = fileparts(params.analysis_components);
    if isempty(ext)
        ext='.m';
    end
    params.analysis_components=fullfile(pathstr,[name ext versn]);
    param_write(fidi,'\t  ','analysis_components',' = ''','''\n',params);
else
    param_write(fidi,'\t','asynchronous','','\n',params);
    param_write(fidi,'\t  ','evaluation_concurrency',' = ','\n',params);
    fprintf(fidi,'\tfork\n');
    param_write(fidi,'\t  ','analysis_driver',' = ''','''\n',params);
    param_write(fidi,'\t  ','parameters_file',' = ''','''\n',params);
    param_write(fidi,'\t  ','results_file','    = ''','''\n',params);
    param_write(fidi,'\t  ','file_tag', '','\n',params);
    param_write(fidi,'\t  ','file_save','','\n',params);
end
fprintf(fidi,'\n');

end

%%  function to write the responses section of the file

function []=responses_write(fidi,method,dresp,params)

display('Writing responses section of Dakota input file.');

fprintf(fidi,'responses,\n');

%  functions, gradients, and hessians vary by method

switch method
%     case {'dot_bfgs','dot_frcg','dot_mmfd','dot_slp','dot_sqp'}
%     case {'npsol_sqp'}
    case {'conmin_frcg','conmin_mfd'}
        rsets_write(fidi,dresp,'of','nic','nec');
        ghspec_write(fidi,params,'grad');
%     case {'optpp_cg','optpp_q_newton','optpp_fd_newton',...
%             'optpp_newton','optpp_pds'}
%     case {'asynch_pattern_search'}
%     case {'coliny_cobyla','coliny_direct','coliny_ea',...
%             'coliny_pattern_search','coliny_solis_wets'}
%     case {'ncsu_direct'}
%     case {'moga','soga'}
%     case {'nl2sol','nlssol_sqp','optpp_g_newton'}
    case {'nond_sampling'}
        rsets_write(fidi,dresp,'rf');
        ghspec_write(fidi,params);
    case {'nond_local_reliability'}
        rsets_write(fidi,dresp,'rf');
        ghspec_write(fidi,params,'grad');
%     case {'dace','fsu_quasi_mc','fsu_cvt'}
%     case {'vector_parameter_study','list_parameter_study',...
%             'centered parameter_study','multidim_parameter_study'}
end

fprintf(fidi,'\n');

end

%%  function to write response sets

function []=rsets_write(fidi,dresp,varargin)

rdesc={};

for i=1:length(varargin)
    switch(varargin{i})
        case 'of'
            rstring ='objective_functions';
            rstring2='objective_function';
        case 'lst'
            rstring ='least_squares_terms';
            rstring2='least_squares_term';
        case 'nic'
            rstring ='nonlinear_inequality_constraints';
            rstring2='nonlinear_inequality';
        case 'nec'
            rstring ='nonlinear_equality_constraints';
            rstring2='nonlinear_equality';
        case 'rf'
            rstring ='response_functions';
            rstring2='response_function';
        otherwise
            warning('rsets_write:unrec_resp',...
                'Unrecognized response ''%s''.',varargin{i});
    end
    
    if isfield(dresp,varargin{i})
        [rdesc]=rlist_write(fidi,rstring,rstring2,dresp.(varargin{i}),rdesc);
    end
end

%  write response descriptors

if ~isempty(rdesc)
    fprintf(fidi,'\tresponse_descriptors =\n');
    vector_write(fidi,sprintf('\t  '),rdesc,6,76);
end

end

%%  function to write response list

function [rdesc]=rlist_write(fidi,rstring,rstring2,dresp,rdesc)

%  put responses into lists for writing

rstype =dresp_stype (dresp);
rscale =dresp_scale (dresp);
rweight=dresp_weight(dresp);
rlower =dresp_lower (dresp);
rupper =dresp_upper (dresp);
rtarget=dresp_target(dresp);

%  accumulate descriptors into list for subsequent writing

rdesc(end+1:end+numel(dresp))=dresp_desc  (dresp);

%  write responses

disp(sprintf('  Writing %d %s responses.',length(dresp),class(dresp)));

fprintf(fidi,'\tnum_%s = %d\n',rstring,length(dresp));
if ~isempty(rstype)
    fprintf(fidi,'\t  %s_scale_types =\n',rstring2);
    vector_write(fidi,sprintf('\t    '),rstype ,6,76);
end
if ~isempty(rscale)
    fprintf(fidi,'\t  %s_scales =\n',rstring2);
    vector_write(fidi,sprintf('\t    '),rscale ,6,76);
end
if ~isempty(rweight)
    switch rstring2
        case 'objective_function'
            wtype='multi_objective';
        case 'least_squares_term'
            wtype='least_squares';
    end
    fprintf(fidi,'\t  %s_weights =\n',wtype);
    vector_write(fidi,sprintf('\t    '),rweight,6,76);
end
if ~isempty(rlower)
    fprintf(fidi,'\t  %s_lower_bounds =\n',rstring2);
    vector_write(fidi,sprintf('\t    '),rlower ,6,76);
end
if ~isempty(rupper)
    fprintf(fidi,'\t  %s_upper_bounds =\n',rstring2);
    vector_write(fidi,sprintf('\t    '),rupper ,6,76);
end
if ~isempty(rtarget)
    fprintf(fidi,'\t  %s_targets =\n',rstring2);
    vector_write(fidi,sprintf('\t    '),rtarget,6,76);
end

end

%%  function to write gradient and hessian specifications

function []=ghspec_write(fidi,params,varargin)

%  gradients

if findstring(varargin,'grad')
    if     params.numerical_gradients
        param_write(fidi,'\t','numerical_gradients','','\n',params);
        param_write(fidi,'\t  ','method_source',' ','\n',params);
        param_write(fidi,'\t  ','interval_type',' ','\n',params);
        param_write(fidi,'\t  ','fd_gradient_step_size',' = ','\n',params);
    elseif params.analytic_gradients
        param_write(fidi,'\t','analytic_gradients','','\n',params);
%     elseif params.mixed_gradients
    end
else
    fprintf(fidi,'\tno_gradients\n');
end

%  hessians (no implemented methods use them yet)

if findstring(varargin,'hess')
    error('Hessians needed by method but not provided.');
else
    fprintf(fidi,'\tno_hessians\n');
end

end

%%  function to find a string in a cell array

function [ifound]=findstring(cells,str)

ifound=false;

for i=1:length(cells)
    if ischar(cells{i}) && strcmp(cells{i},str)
        ifound=i;
        return
    end
end

end

%%  function to write a parameter

function []=param_write(fidi,sbeg,pname,smid,send,params)

if ~isfield(params,pname)
    warning('param_write:param_not_found',...
        'Parameter ''%s'' not found in structure.',pname);
    return
end

if islogical(params.(pname)) && ~params.(pname)
    return
end

if     islogical(params.(pname))
    fprintf(fidi,[sbeg '%s' send],pname);
elseif ischar   (params.(pname))
    fprintf(fidi,[sbeg '%s' smid '%s' send],pname,params.(pname));
elseif isnumeric(params.(pname))
    fprintf(fidi,[sbeg '%s' smid '%g' send],pname,params.(pname));
end

end
%%  function to write a vector on multiple lines

function []=vector_write(fidi,sbeg,vec,nmax,cmax)

if ~exist('nmax','var') || isempty(nmax)
    nmax=Inf;
end
if ~exist('cmax','var') || isempty(cmax)
    cmax=Inf;
end

%  set up first iteration

svec =[];
nitem=nmax;
lsvec=cmax;

%  assemble each line, flushing when necessary

for i=1:length(vec)
    if isnumeric(vec(i))
        sitem=sprintf('%g'    ,vec(i));
    else
        sitem=sprintf('''%s''',char(vec(i)));
    end
    nitem=nitem+1;
    lsvec=lsvec+1+length(sitem);
    
    if (nitem <= nmax) && (lsvec <= cmax)
        svec=[svec ' ' sitem];
    else
        if ~isempty(svec)
            fprintf(fidi,'%s\n',svec);
        end
        svec=[sbeg sitem];
        nitem=1;
        lsvec=length(svec);
    end
end

%  flush buffer at end, if necessary

if ~isempty(svec)
    fprintf(fidi,'%s\n',svec);
end

end
