<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="gfn2html.xsl"?>
<gretl-functions>
<gretl-function-package name="a_eff" minver="2022j" lives-in-subdir="true">
<author email="oleg_komashko@ukr.net">Oleh Komashko</author>
<version>0.93</version>
<date>2026-07-19</date>
<description>advanced treatment of marginal effects and elasticities</description>
<tags>C20 C21</tags>
<help>
pdfdoc:a_eff.pdf
</help>
<gretl-function name="norm_dvar" type="series">
 <params count="1">
  <param name="y" type="seriesref">
<description>a discrete series</description>
  </param>
 </params>
<code>uni = values(y)
n = nelem(uni)
series ret = y&gt;=uni[1]
loop i=2..n -q
  ret = ret+(y&gt;=uni[i])
endloop
return ret
</code>
</gretl-function>
<gretl-function name="check_datanames" type="void">
<code>#gn = g_varnumber()
gretl_version = $version

list z = seq(1,$nvars - 1)
gna = strsub(varname(z),&quot;,&quot;,&quot; &quot;)
gnas = strsplit(gna)
ret = &quot;&quot;
ret2 = 0
#string line
loop i=1..($nvars - 1) -q
  isdu = isduname(gnas[i])
  isdi = isdiname(gnas[i])
  isinti = chek_intname(gnas[i])
  #         print isinti
  #         funcerr &quot;14&quot;
  if (isdu||isdi)&amp;&amp;(!isinti)
    isdum = isdummy(z[i])
    if !isdum
      ret = ret~&quot; &quot;~gnas[i]
    endif
    if isdu&amp;&amp;isdum
      znam = getdiname (corr_duname (gnas[i]))
      fifi = findind(znam,gna)
      if fifi==0
        gnasi = gnas[i]
        printf &quot;\n%s is a dummy, the name looks like a level dummy name,\n&quot;, gnasi
        printf &quot;but variable %s is absent in the dataset\n&quot;, znam
        ret2 = ret2+1
      endif
    endif
    if !(isdu)&amp;&amp;isdi&amp;&amp;isdum
      znam = getdiname (gnas[i])
      fifi = findind(znam,gna)
      if fifi==0
        gnasi = gnas[i]
        printf &quot;\n%s is a dummy, the name looks like a level dummy name,\n&quot;, gnasi
        printf &quot;but variable %s is absent in the dataset\n&quot;, znam
        ret2 = ret2+1
      endif
    endif
  endif
  if isinti
    #             outfile &quot;@dotdir\inner666.txt&quot; --write
    #                 labels z[i]
    #             outfile --close
    #             string s = readfile(&quot;@dotdir\inner666.txt&quot;)
    #             remove(&quot;@dotdir\inner666.txt&quot;)
    #             scalar j = 1
    #             loop while getline(s, line)&amp;&amp;(j&lt;3) -q
    #                 uu=sprintf( &quot;%s\n&quot;,  line)
    #                 j++
    #             endloop
    #             bign = strlen(uu)
    #             uuu = strstr(uu,&quot;:&quot;)
    #             n = strlen(uuu)
    #             vvv = strstrip(substr(uu,1,bign-n))
    #             uuu = substr(uuu,3,n)
    #             uuu = strstrip(uuu)
    bundle bui = getinfo(i)
    fififi = !inbundle(bui,&quot;description&quot;)
    vvv = bui.name
    uuu = fififi? &quot;&quot; : bui.description
    ul = uniqvarlist(uuu)
    inti = substr(uuu,1,14)==&quot;interaction of&quot;
    inti2 = isstrstr(uuu,&quot;==&quot;)
    intis = strsplit3(uuu,&quot;==&quot;)
    nintis = nelem(intis)
    inti3 = (nintis==2)
    inti4 = 0
    if inti3
      intis2 = intis[2]
      nintis2 = strlen(intis2)
      cknin1 = substr(intis2,nintis2,nintis2)==&quot;)&quot;
      cknin2 = isnat(strstrip(substr(intis2,1,nintis2-1)))
      inti4 = cknin1*cknin2
    endif
    inti = inti*inti2*inti3*inti4&gt;0
    if inti == 0
      gnasi = gnas[i]
      printf &quot;\nThe name '%s' looks like an interaction term name,\n&quot;, gnasi
      printf &quot;but %s is not an interaction term.\n&quot;, gnasi
      ret2 = ret2+1
    endif
  endif
endloop
ret = strstrip(ret)
if (ret==&quot;&quot;)&amp;&amp;(ret2==0)
  printf &quot;\nAll variables names are OK!\n&quot;
else
  if ret !=&quot;&quot;
    printf &quot;\nThe names of the following variables looks as names\n&quot;
    printf &quot;of dummies, but they are not dummies:&quot;
    print_long_string(ret)
  endif
  nn = nelem(strsplit(ret))+ret2
  if nn==1
    printf &quot;\nThere was 1 warning.\n&quot;
  else
    printf &quot;\nThere were %d warnings.\n&quot;, nn
  endif
endif
</code>
</gretl-function>
<gretl-function name="mfx" type="bundle">
 <params count="6">
  <param name="b" type="bundleref">
<description>b is $model in most cases</description>
  </param>
  <param name="formula" type="string" optional="true">
<description>the model formula</description>
  </param>
  <param name="at_wrt_type" type="string" optional="true">
<description>at and wrt vars names, eff type</description>
  </param>
  <param name="at_vals" type="matrix" optional="true">
<description>values of 'at vars'</description>
  </param>
  <param name="formulaZ" type="string" optional="true">
<description>for zlist containing models</description>
  </param>
  <param name="da" type="list" optional="true">
<description>dataset, for gretl before 2018d</description>
  </param>
 </params>
<code>gretl_version = $version
isnuatwrt = !exists(at_wrt_type)
if isnuatwrt
  string at_wrt_type = &quot;&quot;
endif
strings all_string_input = fndtype(at_wrt_type)
string link = all_string_input[3]
string wrt = all_string_input[1]
string wrtBACKUP = wrt
string at_nams =  all_string_input[2]
cmd = b.command
cmd2 = cmd
name_of_y = b.depvar
matrix coe = b.coeff
matrix vcov = b.vcv
list xx = b.xlist
exifla = exists(formula)
if !exifla
  formula = smart_formula2(xx)
else
  isdotcomma = instring(formula,&quot;;&quot;)
  #print isdotcomma
  if !isdotcomma
    formula_backup = formula
    formula_2s = strsplit(formula)
    nf2s = nelem(formula_2s)
    list indep0 = null
    loop i=1..nf2s -q
      jjj = inlist(xx,formula_2s[i])
      if jjj &gt; 0
        indep0 += xx[jjj]
      endif
    endloop
    #eval indep0
    formula = smart_formula2(xx,indep0)
  endif
endif
series sample = b.sample
formulas = strsplit3(formula,&quot;;&quot;)
newformula = formulas[1]
if !exifla
  newformula = strstrip(smartstrsub(newformula,&quot;const&quot;,&quot;&quot;))
endif
clistnames = formulas[2]
dilistnames = formulas[3]
list clist = null
list dilist = null
nvar = $nvars
stri = mk_txt_range(nvar - 1)
list da = @stri
if nelem(da) == 0
  list da = seq(1,$nvars)
endif
if clistnames != &quot;_empty&quot;
  clistnamess = strsplit(clistnames)
  nclist = nelem(clistnamess)
  loop i=1..nclist -q
    clnamsi = clistnamess[i]
    clist+=da[inlist(da,clnamsi)]
  endloop
endif
if dilistnames != &quot;_empty&quot;
  dilistnamess = strsplit(dilistnames)
  ndilist = nelem(dilistnamess)
  loop i=1..ndilist -q
    dilnamsi = dilistnamess[i]
    dilist+=da[inlist(da,dilnamsi)]
  endloop
endif
isnumat = !exists(at_vals)
smpl sample --dummy
string orig_names = clistnames == &quot;_empty&quot;? &quot;&quot; : clistnames
orig_names = dilistnames == &quot;_empty&quot;? orig_names : orig_names~&quot; &quot;~dilistnames
if cmd == &quot;heckit&quot;
  scalar grvers = $version
  string at_namsZ = &quot;&quot;
  string wrtZ = &quot;&quot;
  list zlist = b.zlist - b.zlist[1]
endif
if (!isnuatwrt)&amp;&amp;(cmd == &quot;heckit&quot;)
  string at_namsALL = at_nams
  at_nams = str_setinrersect(at_nams,orig_names)
  at_namsZ = str_setdiff(at_namsALL,at_nams)
  string wrtALL = wrt
  wrt = str_setinrersect(wrt,orig_names)
  string wrtZ = str_setdiff(wrtALL,wrt)
endif
#smpl sample --dummy
isnw = wrt == &quot;&quot;
#string orig_names = clistnames == &quot;_empty&quot;? &quot;&quot; : clistnames
#orig_names = dilistnames == &quot;_empty&quot;? orig_names : orig_names~&quot; &quot;~dilistnames
if !isnw
  wtwt = str_setdiff(wrt,orig_names)
  wrtchk = strlen(wtwt)
  errtext = sprintf(&quot;wrong name(s) in 'wrt' list: %s&quot;,wtwt)
  if wrtchk &gt; 0
    funcerr errtext
  endif
endif
if strlen(at_nams) == 0
  bundle bu = defvals (newformula,clist,dilist)
else
  if nelem(strsplit(at_nams))!=nelem(at_vals)
    funcerr &quot;inconsistent names and values for 'at' variables&quot;
  endif
  bundle bu = findvals(at_nams,at_vals,newformula,clist,dilist)
endif
allnames = bu[&quot;allnames&quot;]
matrix allvalues = bu[&quot;allvalues&quot;]
contvars = bu[&quot;contvars&quot;]
if contvars == &quot;_empty&quot;
  contvars = &quot;&quot;
else
  if !isnw
    contvars = str_setinrersect(contvars,wrt)
  endif
endif
dumvars = bu[&quot;dumvars&quot;]
if dumvars == &quot;_empty&quot;
  dumvars = &quot;&quot;
else
  if !isnw
    dumvars = str_setinrersect(dumvars,wrt)
  endif
endif
divars = bu[&quot;divars&quot;]
if divars == &quot;_empty&quot;
  divars = &quot;&quot;
else
  if !isnw
    divars = str_setinrersect(divars,wrt)
  endif
endif
if divars == &quot;&quot;
  dilevs = &quot;&quot;
  dialll ={}
else
  divarss = strsplit(divars)
  ndis = nelem(divarss)
  dilevs = &quot;&quot;
  matrix dialll=zeros(1,ndis)
  alldinam = strjoin(varnames(dilist))
  matrix vadii={}
  loop i=1..ndis -q
    dili = mk_factlevs2 (formula, divarss[i],allnames)
    indii = findind(divarss[i],alldinam)
    vadii = values(dilist[indii])
    nvadii = nelem(vadii)
    if i==1
      txt1=&quot;&quot;
    else
      txt1=&quot;,&quot;
    endif
    dilevs = dilevs~txt1~dili
    dialll[i] = nvadii
  endloop
endif
lang = $lang
lincheck = (cmd == &quot;ols&quot;)||(cmd == &quot;hsk&quot;)||(cmd == &quot;wls&quot;)||(cmd == &quot;tsls&quot;)||(cmd == &quot;arima&quot;)
if lincheck
  #if (cmd == &quot;ols&quot;) &amp;&amp; (link == &quot;exp&quot;)
  if link == &quot;exp&quot;
    cmd2 = &quot;poisson&quot;
  else
    cmd2 = &quot;lin&quot;
  endif
elif cmd == &quot;negbin&quot;
  cmd2 = &quot;poisson&quot;
elif  cmd == &quot;logistic&quot;
  cmd2 = &quot;logit&quot;
elif cmd == &quot;logit&quot;
  catch orde = b.ordered
  errord = $error
  if !errord
    cmd2 = &quot;orderedL&quot;
  else
    catch mult = b.multinom
    errmul = $error
    if !errmul
      cmd2 = &quot;multinomial&quot;
    endif
  endif
elif cmd == &quot;probit&quot;
  catch orde = b.ordered
  errord = $error
  if !errord
    cmd2 = &quot;orderedP&quot;
  endif
endif
#print cmd cmd2
lppcheck = (cmd2 == &quot;logit&quot;)||(cmd2 == &quot;probit&quot;)||(cmd2 == &quot;poisson&quot;)
############ IF BY COMMAND
if lincheck
  if link != &quot;exp&quot;
    printf &quot;\n%s marginal effects on %s:\n&quot;, cmd, name_of_y
  else
    if (strlen(name_of_y) &gt; 2)&amp;&amp;(substr(name_of_y,1,2)==&quot;l_&quot;)
      new_name_y = substr(name_of_y,3,strlen(name_of_y))
      printf &quot;\n%s marginal effects on %s:\n&quot;, cmd, new_name_y
    else
      printf &quot;\n%s marginal effects on exp(%s):\n&quot;, cmd, name_of_y
    endif
  endif
  if (cmd == &quot;arima&quot;)
    armnxx = nelem(xx)
    armnn = b.ncoeff
    if inlist(xx,const)
      armindi = 1~seq(armnn-armnxx+2,armnn)
    else
      armindi = seq(armnn-armnxx+1,armnn)
    endif
    coe = coe[armindi]
    vcov = vcov[armindi,armindi]
  endif
endif
if lppcheck &amp;&amp; (!lincheck)
  if cmd == &quot;negbin&quot;
    ncoe = rows(coe)
    matrix vcov = vcov[1:(ncoe-1),1:(ncoe-1)]
    matrix coe = coe[1:(ncoe-1)]
  endif
  if (cmd2 == &quot;poisson&quot;)
    printf &quot;\n%s marginal effects on E(%s):\n&quot;, cmd, name_of_y
  elif cmd == &quot;logistic&quot;
    printf &quot;\n%s marginal effects on %s:\n&quot;, cmd, name_of_y
  else
    printf &quot;\n%s marginal effects on P(%s = 1):\n&quot;, cmd, name_of_y
  endif
endif
oneq = lppcheck||lincheck
if oneq
  if  contvars == &quot;&quot;
    matr1 = {}
  else
    matr1 = cont_grads_many(newformula,allnames,allvalues,contvars,coe,cmd2)
  endif
  if  dumvars == &quot;&quot;
    matr2 = {}
  else
    matr2 = dum_grads_many(newformula,allnames,allvalues,dumvars,coe,cmd2)
  endif
  if  divars == &quot;&quot;
    matr3 = {}
  else
    matr3 = {}
    ndss = nelem(divarss)
    dilevelss = strsplit3(dilevs,&quot;,&quot;)
    loop i=1..ndss -q
      matr3i = discr_grads2_many(newformula, allnames, allvalues, divarss[i],dilevelss[i],mk_alllevs(dialll[i]),coe,cmd2)
      matr3 = matr3|matr3i
    endloop
  endif
endif
if cmd == &quot;heckit&quot;
  name_of_yz = varnames(b.zlist)[1]
  if link != &quot;Ey&quot;
    printf &quot;\n%s marginal effects on E(%s|%s &gt; 0):\n&quot;, cmd, name_of_y, name_of_yz
  else
    printf &quot;\n%s marginal effects on E(%s):\n&quot;, cmd, name_of_y
  endif
  list xxZ = zlist
  exiflaZ = exists(formulaZ)
  if !exiflaZ
    formulaZ = smart_formula2(xxZ)
    if exifla
      #else
      #print formula
      isdotcomma = instring(formula_backup,&quot;;&quot;)
      if !isdotcomma
        formula_2s = strsplit(formula_backup)
        nf2s = nelem(formula_2s)
        list indep0 = null
        loop i=1..nf2s -q
          jjj = inlist(xxZ,formula_2s[i])
          #indep0 += xxZ[jjj]
          if jjj &gt; 0
            indep0 += xxZ[jjj]
          endif
        endloop
        formulaZ = smart_formula2(xxZ,indep0)
      endif
    endif
  endif
  # if !exifla
  #         formula = smart_formula2(xx)
  #     else
  #         isdotcomma = instring(formula,&quot;;&quot;)
  #
  #         if !isdotcomma
  #             formula_2s = strsplit(formula)
  #             nf2s = nelem(formula_2s)
  #             list indep0 = null
  #             loop i=1..nf2s -q
  #                 jjj = inlist(xx,formula_2s[i])
  #                 indep0 += xx[jjj]
  #             endloop
  #             formula = smart_formula2(xx,indep0)
  #         endif
  #     endif
  formulasZ = strsplit3(formulaZ,&quot;;&quot;)
  newformulaZ = formulasZ[1]
  if !exiflaZ
    newformulaZ = strstrip(smartstrsub(newformulaZ,&quot;const&quot;,&quot;&quot;))
  endif
  clistnamesZ = formulasZ[2]
  dilistnamesZ = formulasZ[3]
  list clistZ = null
  list dilistZ = null
  if clistnamesZ != &quot;_empty&quot;
    clistnamessZ = strsplit(clistnamesZ)
    nclistZ = nelem(clistnamessZ)
    loop i=1..nclistZ -q
      clnamsiZ = clistnamessZ[i]
      clistZ+=da[inlist(da,clnamsiZ)]
    endloop
  endif
  if dilistnamesZ != &quot;_empty&quot;
    dilistnamessZ = strsplit(dilistnamesZ)
    ndilistZ = nelem(dilistnamessZ)
    loop i=1..ndilistZ -q
      dilnamsiZ = dilistnamessZ[i]
      dilistZ+=da[inlist(da,dilnamsiZ)]
    endloop
  endif
  string orig_namesZ = clistnamesZ == &quot;_empty&quot;? &quot;&quot; : clistnamesZ
  orig_namesZ = dilistnamesZ == &quot;_empty&quot;? orig_namesZ : orig_namesZ~&quot; &quot;~dilistnamesZ
  at_namsZ = str_setinrersect(orig_namesZ,at_namsZ)
  if strlen(at_namsZ) == 0
    bundle buZ = defvals (newformulaZ,clistZ,dilistZ)
  else
    #####?????????????   at_valsZ
    matrix findiZZ = findinds(at_namsZ, at_namsALL)
    #print findiZZ
    matrix at_valsZ = at_vals[findiZZ]
    bundle buZ = findvals(at_namsZ,at_valsZ,newformulaZ,clistZ,dilistZ)
  endif
  allnamesZ = buZ.allnames
  contvarsZ = buZ.contvars
  if contvarsZ == &quot;_empty&quot;
    contvarsZ = &quot;&quot;
  endif
  dumvarsZ = buZ.dumvars
  if dumvarsZ == &quot;_empty&quot;
    dumvarsZ = &quot;&quot;
  endif
  matrix allvaluesZ = buZ.allvalues
  divarsZ = buZ.divars
  if divarsZ == &quot;_empty&quot;
    divarsZ = &quot;&quot;
  endif
  #         if (strlen(wrt) &gt; 0)||(strlen(wrtZ) &gt; 0)
  #             contvars = str_setinrersect(contvars,wrt)
  #             contvarsZ = str_setinrersect(contvarsZ,wrtZ)
  #             dumvars = str_setinrersect(dumvars,wrt)
  #             dumvarsZ = str_setinrersect(dumvarsZ,wrtZ)
  #             divars = str_setinrersect(divars,wrt)
  #             divarsZ = str_setinrersect(divarsZ,wrtZ)
  #         endif
  if (strlen(wrtBACKUP) &gt; 0)
    contvars = str_setinrersect(contvars,wrtBACKUP)
    contvarsZ = str_setinrersect(contvarsZ,wrtBACKUP)
    dumvars = str_setinrersect(dumvars,wrtBACKUP)
    dumvarsZ = str_setinrersect(dumvarsZ,wrtBACKUP)
    divars = str_setinrersect(divars,wrtBACKUP)
    divarsZ = str_setinrersect(divarsZ,wrtBACKUP)
  endif
  #eval &quot;IS ANY CONTWARS?&quot;
  if  (strlen(contvars)+ strlen(contvarsZ)) == 0
    matr1 = {}
  else
    matr1 = all_hk_fun(newformula,allnames,contvars,newformulaZ, allnamesZ, contvarsZ,b.base_coeffs+1,b.ncoeff,allvalues,allvaluesZ,coe,1,link)
    #print matr1
    second = str_setdiff(contvarsZ,contvars)
    contvars = strstrip(contvars~&quot; &quot;~second)
  endif
  #####################
  #print dumvars dumvarsZ
  if  (strlen(dumvars)+ strlen(dumvarsZ)) == 0
    matr2 = {}
  else
    matr2 = all_hk_fun(newformula,allnames,dumvars,newformulaZ, allnamesZ, dumvarsZ,b.base_coeffs+1,b.ncoeff,allvalues,allvaluesZ,coe,2,link)
    # print matr2
    secondd = str_setdiff(dumvarsZ,dumvars)
    dumvars = strstrip(dumvars~&quot; &quot;~secondd)
  endif
  #  eval &quot;divars&quot;
  #                 print divars
  ################
  if divarsZ == &quot;&quot;
    dilevsZ = &quot;&quot;
    dialllZ ={}
  else
    divarssZ = strsplit(divarsZ)
    ndisZ = nelem(divarssZ)
    dilevsZ = &quot;&quot;
    matrix dialllZ=zeros(1,ndisZ)
    alldinamZ = strjoin(varnames(dilistZ))
    matrix vadiiZ={}
    loop i=1..ndisZ -q
      #############?????????????????
      diliZ = mk_factlevs2 (formulaZ, divarssZ[i],allnamesZ)
      indiiZ = findind(divarssZ[i],alldinamZ)
      vadiiZ = values(dilistZ[indiiZ])
      nvadiiZ = nelem(vadiiZ)
      if i==1
        txt1=&quot;&quot;
      else
        txt1=&quot;,&quot;
      endif
      dilevsZ = dilevsZ~txt1~diliZ
      dialllZ[i] = nvadiiZ
    endloop
  endif
  #print dialllZ
  ##################
  if (divars == &quot;&quot;)&amp;&amp;(divarsZ == &quot;&quot;)
    matr3 = {}
  else
    uniqZdivars = str_setdiff(divarsZ,divars)
    diZind = findinds(uniqZdivars,divarsZ)
    NOUNIQ = nelem(strsplit(divarsZ)) - nelem(strsplit(uniqZdivars))
    ALLDIVARS = strstrip(divars~&quot; &quot;~uniqZdivars)
    # eval &quot;ALLDIVARS&quot;
    # print ALLDIVARS
    if strlen(dilevs)==0
      ALLDILEVS = dilevsZ
      # eval &quot;ALLDILEVS&quot;
      # print ALLDILEVS
    elif NOUNIQ ==0
      if strlen(dilevsZ)==0
        ALLDILEVS = dilevs
      else
        ALLDILEVS = dilevs~&quot;,&quot;~dilevsZ
      endif
      # eval &quot;ALLDILEVS&quot;
      # print ALLDILEVS
    else
      #print diZind
      if nelem(diZind) == 0
        ALLDILEVS = dilevs
      else
        dilevsZs = strsplit3(dilevsZ,&quot;,&quot;)
        ndZ = nelem(dilevsZs)
        ALLDILEVS = dilevs
        loop i=1..ndZ -q
          #eval iminc(abs(diZind - i))
          if minc(abs(diZind - i))==0
            #strizi = dilevsZs[i]
            #strizis[1] = strizi
            #DIZ = DIZ+ strizis
            ALLDILEVS = ALLDILEVS~&quot;,&quot;~dilevsZs[i]
          endif
        endloop
        # eval &quot;ALLDILEVS&quot;
        # print ALLDILEVS
      endif
    endif
    if nelem(diZind)==0
      matrix DIALL = dialll
      # eval &quot;DIALL&quot;
      # print DIALL
    else
      matrix DIALL = dialll~dialllZ[diZind]
      # eval &quot;DIALL&quot;
      # print DIALL
    endif
    cst1 = inlist(b.xlist,const) &gt; 0
    cst2z = inlist(b.zlist,const) &gt; 0
    uniqznam = str_setdiff(allnamesZ,allnames)
    zZindi = findinds(uniqznam,allnamesZ)
    ALLNAMES = strstrip(allnames~&quot; &quot;~uniqznam)
    #eval &quot;ALLNAMES&quot;
    #print ALLNAMES
    matrix ALLVALUES = allvalues~allvaluesZ[zZindi]
    #print ALLVALUES
    matr3 = {}
    divarss = strsplit(ALLDIVARS)
    ndss = nelem(divarss)
    dilevelss = strsplit3(ALLDILEVS,&quot;,&quot;)
    loop i=1..ndss -q
      alllevelsi = mk_alllevs(DIALL[i])
      matr3i = hk_prefun(newformula,newformulaZ,ALLNAMES,divarss[i], dilevelss[i],alllevelsi,ALLVALUES,b.base_coeffs,b.ncoeff,cst1,cst2z,coe,link)
      ####
      matr3 = matr3|matr3i
      ####
    endloop
    divars = ALLDIVARS
    dilevels = ALLDILEVS
    dialll = DIALL
  endif
  #############3
  #         divars = ALLDIVARS
  #         dilevels = ALLDILEVS
  #         dialll = DIALL
  ############3
endif
if cmd == &quot;tobit&quot;
  vcov = b.full_vcv
  s__ = b.sigma
  catch lo__ = b.llimit
  errtob1 = $error
  if errtob1 &gt; 0
    lo__ = 0
  endif
  catch hi__ = b.rlimit
  errtob2 = $error
  if errtob2 &gt; 0
    hi__ = $huge
    hi22 = NA
  else
    hi22 = hi__
  endif
  if link != &quot;inside&quot;
    if lang == &quot;uk_UA&quot;
      printf &quot;\n%s: граничні ефекти на E(%s)\n&quot;, cmd, name_of_y
    else
      printf &quot;\n%s marginal effects on E(%s)\n&quot;, cmd, name_of_y
    endif
  else
    tytyt = mk_tob_outtext(lo__,hi22,name_of_y)
    if lang == &quot;uk_UA&quot;
      printf &quot;\n%s: граничні ефекти на E(%s|%s)\n&quot;, cmd,name_of_y, tytyt
    else
      printf &quot;\n%s marginal effects on E(%s|%s)\n&quot;, cmd,name_of_y, tytyt
    endif
  endif
  if  contvars == &quot;&quot;
    matr1 = {}
  else
    if link != &quot;inside&quot;
      matr1 = tb_cont_grads(newformula,allnames,allvalues,contvars,coe,s__,lo__,hi__)
    else
      matr1 = tb_cont_grads22(newformula,allnames,allvalues,contvars,coe,s__,lo__,hi__)
    endif
  endif
  if  dumvars == &quot;&quot;
    matr2 = {}
  else
    if link != &quot;inside&quot;
      matr2 = tb_dum_grads(newformula,allnames,allvalues,dumvars,coe,s__,lo__,hi__)
    else
      matr2 = tb_dum_grads22(newformula,allnames,allvalues,dumvars,coe,s__,lo__,hi__)
    endif
  endif
  if  divars == &quot;&quot;
    matr3 = {}
  else
    matr3 = {}
    divarss = strsplit(divars)
    ndss = nelem(divarss)
    dilevelss = strsplit3(dilevs,&quot;,&quot;)
    loop i=1..ndss -q
      if link != &quot;inside&quot;
        matr3i = t_discr_grads2(newformula, allnames, allvalues, divarss[i],dilevelss[i],mk_alllevs(dialll[i]),coe,s__,lo__,hi__)
      else
        matr3i = t_discr_grads222(newformula, allnames, allvalues, divarss[i],dilevelss[i],mk_alllevs(dialll[i]),coe,s__,lo__,hi__)
      endif
      matr3 = matr3|matr3i
    endloop
  endif
endif
if oneq||(cmd == &quot;heckit&quot;)
  matrix matr=matr1|matr2|matr3
  matrix mfxs = matr[,1]
  matr = matr[,2:]
  matrix mvc = qform(matr,vcov)
  matrix coeffmat  = mfxs~sqrt(diag(mvc))
elif cmd==&quot;tobit&quot;
  matrix matr=matr1|matr2|matr3
  matrix mfxs = matr[,1]
  matr = matr[,2:]
  nnn = cols(vcov)
  matrix Jm = I(nnn)
  Jm[nnn,nnn] = s__
  matrix Vbig = qform(Jm, vcov)
  matrix mvc = qform(matr,Vbig)
  matrix coeffmat  = mfxs~sqrt(diag(mvc))
endif
if oneq||cmd==&quot;tobit&quot;||cmd==&quot;heckit&quot;
  lang = $lang
  nc = 0
  nd = 0
  if contvars != &quot;&quot;
    nc = nelem(strsplit(contvars))
    matrix coeffmat1 = coeffmat[1:nc,]
    if lang == &quot;uk_UA&quot;
      if nc == 1
        flex = &quot;&quot;
        flex2 = &quot;ої&quot;
      else
        flex = &quot;и&quot;
        flex2 = &quot;их&quot;
      endif
      printf &quot;\nЕфект%s неперервн%s змінн%s: \n&quot;,flex,flex2,flex2
      modprint coeffmat1 contvars
    else
      if nc == 1
        flex = &quot;&quot;
      else
        flex = &quot;s&quot;
      endif
      printf &quot;\nEffect%s of continuous variable%s: \n&quot;,flex,flex
      modprint coeffmat1 contvars
    endif
  endif
  if dumvars != &quot;&quot;
    nd = nelem(strsplit(dumvars))
    matrix coeffmat2 = coeffmat[(nc+1):(nc+nd),]
    if lang == &quot;uk_UA&quot;
      if nc == 1
        flex = &quot;&quot;
        flex2 = &quot;ої&quot;
      else
        flex = &quot;и&quot;
        flex2 = &quot;их&quot;
      endif
      printf &quot;\nЕфект%s фіктивн%s змінн%s: \n&quot;,flex,flex2,flex2
      modprint coeffmat2 dumvars
    else
      if nd == 1
        flex = &quot;&quot;
      else
        flex = &quot;s&quot;
      endif
      printf &quot;\nEffect%s of dummy variable%s: \n&quot;,flex,flex
      modprint coeffmat2 dumvars
    endif
  endif
  bigdivars = &quot;&quot;
  if divars != &quot;&quot;
    ndi = nelem(divarss)
    if lang == &quot;uk_UA&quot;
      if ndi == 1
        flex2 = &quot;ої&quot;
      else
        flex2 = &quot;их&quot;
      endif
      printf &quot;\nЕфекти дискретн%s змінн%s: \n&quot;,flex2,flex2
    else
      if ndi == 1
        flex = &quot;&quot;
      else
        flex = &quot;s&quot;
      endif
      printf &quot;\nEffects of discrete variable%s.\n&quot;,flex
    endif
    counter = nc+nd+1
    matrix matri={}
    loop  i=1..ndi -q
      levi = dilevelss[i]
      levis = strsplit(levi)
      ndii = nelem(levis)
      nami = divarss[i]
      isallev = (ndii==dialll[i])
      if isallev
        basi = &quot;1&quot;
        ndii -=1
        levi = str_setdiff(levi,basi)
      else
        alli = mk_alllevs(dialll[i])
        basi = str_setdiff(alli,levi)
      endif
      basiold = basi
      if (dialll[i] - ndii) &gt; 1
        basis = strsplit(basi)
        basi = basis[1]
      endif
      if lang == &quot;uk_UA&quot;
        printf &quot;\n Ефекти %s (базовий рівень = %s):\n&quot;,nami,basi
      else
        printf &quot;\n Effects of %s (base level = %s):\n&quot;,nami,basi
      endif
      matri = coeffmat[counter:(counter+ndii-1),]
      namii = mk_nami(nami, levi)
      modprint matri namii
      if (dialll[i] - ndii) &gt; 1
        babasi = strsub(basiold,&quot; &quot;,&quot;, &quot;)
        if lang == &quot;uk_UA&quot;
          printf &quot;  Увага: поточна модель не розрізняє такі рівні %s: %s.\n&quot;,nami, babasi
        else
          printf &quot;  Note: levels %s of %s are indistinguishable in the current model.\n&quot;,babasi,nami
        endif
      endif
      counter = counter+ndii
      bigdivars = bigdivars~&quot; &quot;~mk_namlevi(nami,levi)
    endloop
  endif
  bigdivars = strstrip(bigdivars)
  newnames = strstrip(contvars~&quot; &quot;~dumvars~&quot; &quot;~bigdivars)
  bundle bout
  bout[&quot;names&quot;] = newnames
  matrix bout[&quot;mfx&quot;] = coeffmat[,1]
  matrix bout[&quot;se&quot;] = coeffmat[,2]
  matrix bout[&quot;vcov&quot;] = mvc
endif
isordered = (cmd2 == &quot;orderedL&quot;)||(cmd2 == &quot;orderedP&quot;)
if isordered
  list yy = b.ylist
  printf &quot;\nMarginal effects in the ordered %s model.\n&quot;, cmd
  nalts = nelem(uniq(yy[1]))
  if  contvars == &quot;&quot;
    matr1 = {}
  else
    matr1 = olp_cont_grads2(newformula,allnames,allvalues,contvars,coe,nalts,cmd)
  endif
  if  dumvars == &quot;&quot;
    matr2 = {}
  else
    matr2 = olp_dum_grads2(newformula,allnames,allvalues,dumvars,coe,nalts,cmd)
  endif
  if  divars == &quot;&quot;
    matr3 = {}
  else
    matr3 = {}
    divarss = strsplit(divars)
    ndss = nelem(divarss)
    dilevelss = strsplit3(dilevs,&quot;,&quot;)
    loop i=1..ndss -q
      matr3i = olp_discr_grad2(newformula, allnames,allvalues, divarss[i],dilevelss[i],mk_alllevs(dialll[i]),coe,nalts,cmd)
      matr3 = matr3|matr3i
    endloop
  endif
  matrix matr=matr1|matr2|matr3
  rm = rows(matr)
  ra = rm/nalts
  sequ =  seq(0,ra-1)
  bigseq = zeros(rm,1)
  loop i=1..nalts -q
    seqi = i.+ nalts.*sequ
    indsi = ra*(i-1).+sequ.+1
    bigseq[indsi]=seqi'
  endloop
  matr = matr[bigseq,]
  matrix mfxs = matr[,1]
  matr = matr[,2:]
  matrix mvc = qform(matr,vcov)
  matrix uuu = sqrt(diag(mvc))
  matrix bigcoeffmat  = mfxs~sqrt(diag(mvc))
  lang = $lang
  nc = 0
  nd = 0
  matrix coeffmat ={}
  string nam_y = varname(yy)
  loop iii=1..nalts -q
    indsi = ra*(iii-1).+sequ.+1
    coeffmat =  bigcoeffmat[indsi,]
    if lang == &quot;uk_UA&quot;
      printf &quot;\nГраничні ефекти для Pr(%s = %d)\n&quot;,nam_y,iii
    else
      printf &quot;\nMarginal effects on Pr(%s = %d)\n&quot;,nam_y,iii
    endif
    if contvars != &quot;&quot;
      nc = nelem(strsplit(contvars))
      matrix coeffmat1 = coeffmat[1:nc,]
      if lang == &quot;uk_UA&quot;
        if nc == 1
          flex = &quot;&quot;
          flex2 = &quot;ої&quot;
        else
          flex = &quot;и&quot;
          flex2 = &quot;их&quot;
        endif
        printf &quot;\nЕфект%s неперервн%s змінн%s: \n&quot;,flex,flex2,flex2
        modprint coeffmat1 contvars
      else
        if nc == 1
          flex = &quot;&quot;
        else
          flex = &quot;s&quot;
        endif
        printf &quot;\nEffect%s of continuous variable%s: \n&quot;,flex,flex
        modprint coeffmat1 contvars
      endif
    endif
    if dumvars != &quot;&quot;
      nd = nelem(strsplit(dumvars))
      matrix coeffmat2 = coeffmat[(nc+1):(nc+nd),]
      if lang == &quot;uk_UA&quot;
        if nc == 1
          flex = &quot;&quot;
          flex2 = &quot;ої&quot;
        else
          flex = &quot;и&quot;
          flex2 = &quot;их&quot;
        endif
        printf &quot;\nЕфект%s фіктивн%s змінн%s: \n&quot;,flex,flex2,flex2
        modprint coeffmat2 dumvars
      else
        if nd == 1
          flex = &quot;&quot;
        else
          flex = &quot;s&quot;
        endif
        printf &quot;\nEffect%s of dummy variable%s: \n&quot;,flex,flex
        modprint coeffmat2 dumvars
      endif
    endif
    bigdivars = &quot;&quot;
    if divars != &quot;&quot;
      ndi = nelem(divarss)
      if lang == &quot;uk_UA&quot;
        if ndi == 1
          flex2 = &quot;ої&quot;
        else
          flex2 = &quot;их&quot;
        endif
        printf &quot;\nЕфекти дискретн%s змінн%s: \n&quot;,flex2,flex2
      else
        if ndi == 1
          flex = &quot;&quot;
        else
          flex = &quot;s&quot;
        endif
        printf &quot;\nEffects of discrete variable%s.\n&quot;,flex
      endif
      counter = nc+nd+1
      matrix matri={}
      loop  i=1..ndi -q
        levi = dilevelss[i]
        levis = strsplit(levi)
        ndii = nelem(levis)
        nami = divarss[i]
        isallev = (ndii==dialll[i])
        if isallev
          basi = &quot;1&quot;
          ndii -=1
          levi = str_setdiff(levi,basi)
        else
          alli = mk_alllevs(dialll[i])
          basi = str_setdiff(alli,levi)
        endif
        basiold = basi
        if (dialll[i] - ndii) &gt; 1
          basis = strsplit(basi)
          basi = basis[1]
        endif
        if lang == &quot;uk_UA&quot;
          printf &quot;\n Ефекти %s (базовий рівень = %s):\n&quot;,nami,basi
        else
          printf &quot;\n Effects of %s (base level = %s):\n&quot;,nami,basi
        endif
        matri = coeffmat[counter:(counter+ndii-1),]
        namii = mk_nami(nami, levi)
        modprint matri namii
        if (dialll[i] - ndii) &gt; 1
          babasi = strsub(basiold,&quot; &quot;,&quot;, &quot;)
          if lang == &quot;uk_UA&quot;
            printf &quot;  Увага: поточна модель не розрізняє такі рівні %s: %s.\n&quot;,nami, babasi
          else
            printf &quot;  Note: levels %s of %s are indistinguishable in the current model.\n&quot;,babasi,nami
          endif
        endif
        counter = counter+ndii
        bigdivars = bigdivars~&quot; &quot;~mk_namlevi(nami,levi)
      endloop
    endif
  endloop
  bigdivars = strstrip(bigdivars)
  newnames = strstrip(contvars~&quot; &quot;~dumvars~&quot; &quot;~bigdivars)
  bundle bout
  bout[&quot;names&quot;] = newnames
  matrix bout[&quot;mfx&quot;] = bigcoeffmat[,1]
  matrix bout[&quot;se&quot;] = bigcoeffmat[,2]
  matrix bout[&quot;vcov&quot;] = mvc
  bout[&quot;n_alts&quot;] = nalts
  bout[&quot;nam_y&quot;] = nam_y
  #print bout
endif
if cmd2 == &quot;multinomial&quot;
  list yy = b.ylist
  nnyy = values(yy[1])
  nalts = nelem(nnyy)
  ismucst = inlist(b.xlist,const)
  #print ismucst
  printf &quot;\nMarginal effects after multinomial logit.\n&quot;
  if  contvars == &quot;&quot;
    matr10 = {}
    n_contvars = 0
  else
    matr10 = ml_cont_grads(coe,newformula,allnames,allvalues,contvars,nalts,ismucst)
    n_contvars = rows(matr10)
    #print matr10
  endif
  if  dumvars == &quot;&quot;
    matr20 = {}
    n_dumvars = 0
  else
    matr20 = ml_dum_grads(newformula,allnames,allvalues,dumvars,coe,nalts,ismucst)
    n_dumvars = rows(matr20)
  endif
  if  divars == &quot;&quot;
    matr300 = {}
    bign_divars = 0
    didims = {}
  else
    matr300 = {}
    divarss = strsplit(divars)
    ndss = nelem(divarss)
    matrix didims = zeros(1,ndss)
    dilevelss = strsplit3(dilevs,&quot;,&quot;)
    loop i=1..ndss -q
      matr300i = ml_discr_grads2(newformula, allnames,allvalues, divarss[i],dilevelss[i],mk_alllevs(dialll[i]),coe,nalts,ismucst)
      didims[i] = rows(matr300i)
      matr300 =  matr300|matr300i
    endloop
    bign_divars = rows(matr300)
    matr300 = matr300[didindi(didims,nalts),]
  endif
  nb = nelem(coe)
  mega_n = n_contvars+n_dumvars+bign_divars
  large_n = mega_n/nalts
  matrix mega_matr = zeros(mega_n,nb+1)
  if n_contvars &gt; 0
    count_seq = seq(1,n_contvars/nalts)
  endif
  if n_dumvars &gt; 0
    dum_seq2 = seq(1,n_dumvars/nalts)
    dum_seq = dum_seq2 + n_contvars/nalts
  endif
  if bign_divars &gt; 0
    di_seq2 = seq(1,bign_divars/nalts)
    di_seq = di_seq2 + (n_contvars + n_dumvars)/nalts
  endif
  loop i = 1..nalts -q
    i_counter = large_n * (i - 1)
    if n_contvars &gt; 0
      mega_matr[i_counter+count_seq,] = matr10 [n_contvars/nalts* (i - 1)+count_seq,]
    endif
    if n_dumvars &gt; 0
      mega_matr[i_counter+dum_seq,] = matr20 [n_dumvars/nalts* (i - 1)+dum_seq2,]
    endif
    if bign_divars &gt; 0
      mega_matr[i_counter+di_seq,] = matr300 [bign_divars/nalts* (i - 1)+di_seq2,]
    endif
  endloop
  matrix all_mfx = mega_matr[,1]
  mega_matr = qform(mega_matr[,2:],vcov)
  matrix all_coeffmat  = all_mfx ~ sqrt(diag(mega_matr))
  #print all_coeffmat
  lang = $lang
  if contvars != &quot;&quot;
    nc = n_contvars/nalts
    if lang == &quot;uk_UA&quot;
      if nc == 1
        flex = &quot;&quot;
        flex2 = &quot;ої&quot;
      else
        flex = &quot;и&quot;
        flex2 = &quot;их&quot;
      endif
      cont_text1 = sprintf( &quot;\nЕфект%s неперервн%s змінн%s: \n&quot;,flex,flex2,flex2)
    else
      if nc == 1
        flex = &quot;&quot;
      else
        flex = &quot;s&quot;
      endif
      cont_text1 = sprintf( &quot;\nEffect%s of continuous variable%s: \n&quot;,flex,flex)
    endif
  else
    cont_text1 = &quot;&quot;
    nc = 0
  endif
  if dumvars != &quot;&quot;
    nd = n_dumvars/nalts
    if lang == &quot;uk_UA&quot;
      if nc == 1
        flex = &quot;&quot;
        flex2 = &quot;ої&quot;
      else
        flex = &quot;и&quot;
        flex2 = &quot;их&quot;
      endif
      dum_text1 = sprintf(&quot;\nЕфект%s фіктивн%s змінн%s: \n&quot;,flex,flex2,flex2)
    else
      if nd == 1
        flex = &quot;&quot;
      else
        flex = &quot;s&quot;
      endif
      dum_text1 = sprintf( &quot;\nEffect%s of dummy variable%s: \n&quot;,flex,flex)
    endif
  else
    dum_text1 = &quot;&quot;
    nd = 0
  endif
  bigdivars = &quot;&quot;
  if divars != &quot;&quot;
    if lang == &quot;uk_UA&quot;
      if ndis == 1
        flex2 = &quot;ої&quot;
      else
        flex2 = &quot;их&quot;
      endif
      di_text1 = sprintf( &quot;\nЕфекти дискретн%s змінн%s: \n&quot;,flex2,flex2)
    else
      if ndis == 1
        flex = &quot;&quot;
      else
        flex = &quot;s&quot;
      endif
      di_text1 = sprintf( &quot;\nEffects of discrete variable%s.\n&quot;,flex)
    endif
    strings basiss = array(ndis)
    strings babasiss = array(ndis)
    strings namiiss = array(ndis)
    loop  i=1..ndis -q
      levi = dilevelss[i]
      ndi = didims[i]/nalts
      nami = divarss[i]
      isallev = (ndi==dialll[i])
      if isallev
        basi = &quot;1&quot;
      else
        alli = mk_alllevs(dialll[i])
        basi = str_setdiff(alli,levi)
      endif
      basiold = basi
      if (dialll[i] - ndi) &gt; 1
        basis = strsplit(basi)
        basi = basis[1]
      endif
      basiss[i] = basi
      namii = mk_nami(nami, levi)
      namiiss[i] = namii
      if (dialll[i] - ndi) &gt; 1
        babasiss[i] = strsub(basiold,&quot; &quot;,&quot;, &quot;)
      else
        babasiss[i] = &quot;_empty&quot;
      endif
      bigdivars = bigdivars~&quot; &quot;~mk_namlevi(nami,levi)
    endloop
  endif
  bigdivars = strstrip(bigdivars)
  newnames = strstrip(contvars~&quot; &quot;~dumvars~&quot; &quot;~bigdivars)
  loop big_i = 1..nalts -q
    printf &quot;\nEffects on P(%s = %d):\n&quot;, name_of_y, big_i
    matrix coeffmat = all_coeffmat[(large_n * (big_i -1) + 1): large_n * big_i,]
    if contvars != &quot;&quot;
      matrix coeffmat1 = coeffmat[1:nc,]
      printf &quot;%s&quot;, cont_text1
      modprint coeffmat1 contvars
    endif
    if dumvars != &quot;&quot;
      matrix coeffmat2 = coeffmat[(nc+1):(nc+nd),]
      printf &quot;%s&quot;, dum_text1
      modprint coeffmat2 dumvars
    endif
    if divars != &quot;&quot;
      printf &quot;%s&quot;, di_text1
      counter = nc+nd+1
      loop  i=1..ndis -q
        nami = divarss[i]
        basi = basiss[i]
        if lang == &quot;uk_UA&quot;
          printf &quot;\n Ефекти %s (базовий рівень = %s):\n&quot;,nami,basi
        else
          printf &quot;\n Effects of %s (base level = %s):\n&quot;,nami,basi
        endif
        matrix matri = coeffmat[counter:(counter+didims[i]/nalts-1),]
        namii = namiiss[i]
        modprint matri namii
        counter = counter+didims[i]/nalts
      endloop
    endif
  endloop
  bigdivars = strstrip(bigdivars)
  newnames = strstrip(contvars~&quot; &quot;~dumvars~&quot; &quot;~bigdivars)
  bundle bout
  bout[&quot;names&quot;] = newnames
  matrix bout[&quot;mfx&quot;] = all_coeffmat[,1]
  matrix bout[&quot;se&quot;] = all_coeffmat[,2]
  matrix bout[&quot;vcov&quot;] = mega_matr
  string bout[&quot;pkg&quot;] = &quot;a_eff&quot;
  string bout[&quot;command&quot;] = b.command
  string bout[&quot;cmd2&quot;] = cmd2
  scalar bout[&quot;nalt&quot;] = 1
  #         if isordered
  #             bout[&quot;nalt&quot;] = nalts
  #         endif
  #print bout
endif
string bout[&quot;pkg&quot;] = &quot;a_eff&quot;
string bout[&quot;command&quot;] = b.command
string bout[&quot;cmd2&quot;] = cmd2
scalar bout[&quot;nalt&quot;] = 1
if (cmd2 == &quot;orderedL&quot;)||(cmd2 == &quot;orderedP&quot;)||(cmd2 == &quot;multinomial&quot;)
  bout[&quot;nalt&quot;] = nalts
endif
bout[&quot;type&quot;] = &quot;mfx&quot;
return bout
</code>
</gretl-function>
<gretl-function name="eff_confint" type="matrix">
 <params count="3">
  <param name="b" type="bundleref">
<description>output of mfx()</description>
  </param>
  <param name="df" type="int" default="0">
<description>z- or t- based intervals</description>
  </param>
  <param name="cl" type="scalar" default="NA">
<description>conf. level, NA = 0.95</description>
  </param>
 </params>
<code>iscl = missing(cl)
if iscl
  cl = 0.95
endif
matrix mafx = b[&quot;mfx&quot;]
matrix ses = b[&quot;se&quot;]
names = b[&quot;names&quot;]
if df==0
  stat = qnorm((1+cl)/2)
else
  stat = critical(t, df, (1-cl)/2)
endif
matrix half = ses.*stat
matrix left = mafx - half
matrix right = mafx + half
matrix ret = mafx~ses~left~right
rnameset(ret,strsplit(names))
proc = round(100*cl)
textproc = sprintf(&quot;%d&quot;, proc)
leb = textproc~&quot;% l.b.&quot;
rib = textproc~&quot;% r.b.&quot;
if b.type == &quot;el&quot;
  cna = &quot;dy/dx*x/y,s.e.,&quot;~leb~&quot;,&quot;~rib
else
  cna = &quot;dy/dx,s.e.,&quot;~leb~&quot;,&quot;~rib
endif
cnas = strsplit3(cna,&quot;,&quot;)
cnameset(ret,cnas)
return ret
</code>
</gretl-function>
<gretl-function name="sq_times" type="list">
 <params count="3">
  <param name="li1" type="list">
<description>list of vars with 2-nd order terms</description>
  </param>
  <param name="li2" type="list">
<description>list of vars 'as is'</description>
  </param>
  <param name="cubes" type="bool" default="0">
<description>whether to include cubes</description>
  </param>
 </params>
<code>li1 = li1 - 0
li2 = li2 - 0
list ret = null
namli1 = varnames(li1)
namli110 = cut_names(namli1)
namli2 = varnames(li2)
namli220 = cut_names(namli2)
bign = nelem(namli110)
n2 = nelem(namli220)
list ret = null
string descr
strings S = array(2)
scalar count = 0
loop i=1..bign -q
  loop j = i..bign -q
    loop l = 1..n2 -q
      name = namli110[i]~&quot;_&quot;~namli110[j]~&quot;_&quot;~namli220[l]
      descr = namli1[i]~&quot;*&quot;~namli1[j]~&quot;*&quot;~namli2[l]
      S = corr_d_n_cb2(namli110[i],namli110[j],namli220[l],descr)
      name = S[1]
      descr = S[2]
      if cubes == 0
        uni = uniqvarlist(descr)
        unis = strsplit(uni)
        nnn = nelem(unis)
        if nnn &gt;1
          ret += genseries(name,li1[i]*li1[j]*li2[l])
          text2 = sprintf(&quot;setinfo %s --description=\&quot;%s\&quot;&quot; ,name, descr)
          @text2
        endif
      else
        ret += genseries(name,li1[i]*li1[j]*li2[l])
        text2 = sprintf(&quot;setinfo %s --description=\&quot;%s\&quot;&quot; ,name, descr)
        @text2
      endif
    endloop
  endloop
endloop
return dropcoll(ret)
</code>
</gretl-function>
<gretl-function name="double_formula" type="string">
 <params count="2">
  <param name="xlist" type="list">
<description>$xlist in most cases</description>
  </param>
  <param name="indlist" type="list" optional="true">
<description>forced ind. vars</description>
  </param>
 </params>
<code>nvar = $nvars
stri = mk_txt_range(nvar - 1)
list da = @stri
vns = varname(da)
allvns = strsub(varname(da),&quot;,&quot;,&quot; &quot;)
xlist = xlist - 0
nx = nelem(xlist)
namss = varnames(xlist)
ret_fla = &quot;&quot;
ret_var = &quot;&quot;
ret_dis = &quot;&quot;
loop i = 1..nx -q
  nam = namss[i]
  list Normals = xlist[i]
  reti = smart_formula200(Normals,indlist,stri,da,allvns)
  retis = strsplit3(reti,&quot;;&quot;)
  forli = retis[1]
  varsii = retis[2]
  discri = retis[3]
  if retis[2]!=&quot;_empty&quot;&amp;&amp;(!inlist(indlist,xlist[i]))
    varsi = strsplit(retis[2])
    nxi = nelem(varsi)
    string normalsi = &quot;&quot;
    loop j=1..nxi -q
      varsij = varsi[j]
      ckj = inlist(da,varsij)
      if ckj
        normalsij = sprintf(&quot; %d&quot;,ckj)
        normalsi = normalsi~normalsij
      endif
    endloop
    list dai = @normalsi
    oldvars = varnames(dai)
    retii = smart_formula200(dai,indlist,stri,da,allvns)
    retiis = strsplit3(retii,&quot;;&quot;)
    newvars = strsplit(retiis[1])
    varsii = retiis[2]
    counter = nelem(oldvars)
    loop j=1..counter -q
      if  oldvars[j]!=newvars[j]
        forli = smartstrsub(forli,oldvars[j],newvars[j])
      endif
    endloop
  endif
  ret_fla = ret_fla~&quot; &quot;~forli
  if varsii != &quot;_empty&quot;
    ret_var =  ret_var~&quot; &quot;~varsii
  endif
  if discri != &quot;_empty&quot;
    ret_dis =  ret_dis ~&quot; &quot;~discri
  endif
endloop
ret_fla = strstrip(ret_fla)
ret_var = strstrip(ret_var)
ret_var = uniqvarlist(ret_var)
ret_dis = uniqvarlist(ret_dis)
ret_dis = strstrip(ret_dis)
bigret = ret_fla~&quot;;&quot;~ret_var~&quot;;&quot;~ret_dis
return bigret
</code>
</gretl-function>
<gretl-function name="cb_inters" type="list">
 <params count="2">
  <param name="li1" type="list">
<description>list of series</description>
  </param>
  <param name="cubes" type="bool" default="0">
<description>whether to include cubes</description>
  </param>
 </params>
<code>li1 = li1 - 0
list ret = null
namli1 = varnames(li1)
namli110 = cut_names(namli1)
bign = nelem(namli110)
list ret = null
string descr
strings S = array(2)
scalar count = 0
loop i=1..bign -q
  loop j = i..bign -q
    loop l = i..bign -q
      name = namli110[i]~&quot;_&quot;~namli110[j]~&quot;_&quot;~namli110[l]
      descr = namli1[i]~&quot;*&quot;~namli1[j]~&quot;*&quot;~namli1[l]
      S = corr_d_n_cb2(namli110[i],namli110[j],namli110[l],descr)
      name = S[1]
      descr = S[2]
      if cubes == 0
        if (i!=j)||(i!=l)
          ret += genseries(name,li1[i]*li1[j]*li1[l])
          text2 = sprintf(&quot;setinfo %s --description=\&quot;%s\&quot;&quot; ,name, descr)
          @text2
        endif
      else
        ret += genseries(name,li1[i]*li1[j]*li1[l])
        text2 = sprintf(&quot;setinfo %s --description=\&quot;%s\&quot;&quot; ,name, descr)
        @text2
      endif
    endloop
  endloop
endloop
return dropcoll(ret)
</code>
</gretl-function>
<gretl-function name="smart_formula2" type="string">
 <params count="2">
  <param name="x" type="list">
<description>$xlist in most cases</description>
  </param>
  <param name="indlist" type="list" optional="true">
<description>forced ind. vars</description>
  </param>
 </params>
<code>nvar = $nvars
stri = mk_txt_range(nvar - 1)
list da = @stri
allvns = strsub(varname(da),&quot;,&quot;,&quot; &quot;)
# print allvns
list x = x-0
bignamss = varnames(x)
hugenams = strsub(varname(da),&quot;,&quot;,&quot; &quot;)
#print hugenams
cknull = nelem(indlist)==0
if !cknull
  indnams = strjoin(varnames(indlist))
else
  indnams = &quot;&quot;
endif
string line
dili = &quot;&quot;
coli = &quot;&quot;
dilis = &quot;&quot;
colis = &quot;&quot;
string first
rets = &quot;&quot;
rets_left = &quot;&quot;
rets_right = &quot;&quot;
loop foreach i x -q
  cknull = 0
  bundle bui = getinfo(x[i])
  if !cknull
    fififi = inlist(indlist,x[i])
    if fififi == 0
      fififi = !inbundle(bui,&quot;description&quot;)
      #print fififi
    endif
    if fififi
      bignamsi = bignamss[i]
      rets = strstrip(rets~&quot; &quot;~bignamsi)
      colis = strstrip(colis~&quot; &quot;~bignamsi)
    else
      cknull = 1
    endif
  endif
  if cknull
    #bundle bui = getinfo(x[i])
    vvv = bui.name
    uuu = bui.description
    ul = uniqvarlist(uuu)
    isspace = isstrstr(uuu,&quot; &quot;)
    if isspace == 0
      isfrla = isfla(uuu)
      isfrla2 = vf(uuu)
      #print isfrla2
      if isfrla&amp;&amp;(isfrla2 &gt; 0)
        ret3 = uuu
        flavars = uniqvarlist(uuu)
      else
        ret3 = vvv
        flavars = vvv
      endif
      nfla = nelem(strsplit(flavars))
      #eval &quot;ret3&quot;
      #print ret3
      #eval &quot;flavars&quot;
      #print flavars
      flavarss = strsplit(flavars)
      bubu_c = &quot;&quot;
      bubu_di = &quot;&quot;
      funij = ret3
      loop ij = 1..nfla -q
        disij =  disuspect(flavarss[ij])
        #eval disij
        #print disij
        if disij != &quot;_empty&quot;
          disijss = strsplit(disij)
          preff = disijss[1]
          nsuff = atof(disijss[2])
          findij = findind(preff,hugenams)
          #print nsuff
          #print findij
          ckij = findij
          if findij &gt; 0
            unqij = values(da[findij])'
            if unqij != seq(1,nelem(unqij))
              ckij = 0
            endif
          endif
          preff2 = substr(preff,2,strlen(preff))
          findij2 = findind(preff2,hugenams)
          #print findij2
          ckij2 = findij2
          if findij2 &gt; 0
            unqij2 = values(da[findij2])'
            #print unqij2
            if unqij2 != seq(1,nelem(unqij2))
              ckij2 = 0
            endif
          endif
          #print ckij ckij2
          if (ckij+ckij2) == 0
            bubu_c = bubu_c~&quot; &quot;~flavarss[ij]
          elif (ckij &gt; 0)&amp;&amp;(ckij2 == 0)
            bubu_di = bubu_di~&quot; &quot;~preff
          elif (ckij == 0)&amp;&amp;(ckij2 &gt; 0)
            bubu_di = bubu_di~&quot; &quot;~preff2
            substij = strstrip(preff2~&quot;_&quot;~disijss[2])
            funij = smartstrsub(funij,flavarss[ij],substij)
          else
            printf &quot;\nAmbigous var. names: both %s and %s are discrete&quot;,pref,pref2
            printf &quot;\nYou may need manual correction of formula&quot;
            printf &quot;\nor renaming variables\n&quot;
            bubu_di = bubu_di~&quot; &quot;~preff
          endif
        else
          bubu_c = bubu_c~&quot; &quot;~flavarss[ij]
        endif
      endloop
      bubu_c = strstrip(bubu_c)
      bubu_di = strstrip(bubu_di)
      ret3 = funij
      lili = bubu_c
      didi = bubu_di
      colis = colis~&quot; &quot;~lili
      dilis = dilis~&quot; &quot;~didi
      rets = rets~&quot; &quot;~ret3
    else
      iseq = substr(uuu,1,1)==&quot;=&quot;
      if iseq
        issq = substr(vvv,1,3)==&quot;sq_&quot;
        sdpart = substr(vvv,4,strlen(vvv))
        fifi = findind(sdpart,ul)
        issq = issq*fifi&gt;0
        islg = substr(vvv,1,2)==&quot;l_&quot;
        sdpart2 = substr(vvv,3,strlen(vvv))
        fifi2 = findind(sdpart2,ul)
        fifi20l = str_setinrersect(ul,allvns)
        new_condition = sdpart2==fifi20l
        islg = islg*fifi2*new_condition&gt;0
        underscpos = catch_times(vvv, uuu)
        if issq
          ret3 = strstrip(sdpart~&quot;^2&quot;)
          flavars = uniqvarlist(ret3)
          lili = flavars
          colis = colis~&quot; &quot;~lili
          rets = rets~&quot; &quot;~ret3
        elif islg
          ret3 = strstrip(&quot;log(&quot;~sdpart2~&quot;)&quot;)
          flavars = uniqvarlist(ret3)
          lili = flavars
          colis = colis~&quot; &quot;~lili
          rets = rets~&quot; &quot;~ret3
        elif  underscpos &gt; 0
          nvvv = strlen(vvv)
          part1 = substr(vvv,1,underscpos-1)
          part2 = substr(vvv,underscpos+1,nvvv)
          ret3 = part1~&quot;*&quot;~part2
          rets = rets~&quot; &quot;~ret3
        else
          ret3 = vvv
          rets = rets~&quot; &quot;~ret3
        endif
        flavars = uniqvarlist(ret3)
        lili = flavars
        colis = colis~&quot; &quot;~lili
      else
        inti = substr(uuu,1,14)==&quot;interaction of&quot;
        inti2 = isstrstr(uuu,&quot;==&quot;)
        intis = strsplit3(uuu,&quot;==&quot;)
        nintis = nelem(intis)
        inti3 = (nintis==2)
        inti4 = 0
        if inti3
          intis2 = intis[2]
          nintis2 = strlen(intis2)
          cknin1 = substr(intis2,nintis2,nintis2)==&quot;)&quot;
          cknin2 = isnat(strstrip(substr(intis2,1,nintis2-1)))
          inti4 = cknin1*cknin2
        endif
        inti = inti*inti2*inti3*inti4&gt;0
        if inti
          zx = strsplit3(uuu,&quot;and (&quot;)
          zx2 = zx[2]
          zx1 = zx[1]
          namis2 = strsplit3(zx2,&quot;==&quot;)
          nami2 = strstrip(namis2[1])
          ni1 = strlen(zx1)
          nami1 = strstrip(substr(zx1,15,ni1))
          didi = getdiname(nami1)
          if strlen(didi) == 0
            first = nami1
          else
            first = null
          endif
          lili = strstrip(didi~&quot; &quot;~nami2)
          ret3 = doret2(uuu,vvv,lili,first)
          if !exists(first)
            first= &quot;&quot;
          endif
          rets = rets~&quot; &quot;~ret3
          dilis = dilis~&quot; &quot;~lili
          colis = colis~&quot; &quot;~first
        else
          doommy = isduname(vvv)
          #eval &quot;doommy&quot;
          #print doommy
          disij =  disuspect(vvv)
          #print disij
          bubu_di = &quot;&quot;
          bubu_c = &quot;&quot;
          funij = vvv
          ij = 1
          flavars = vvv
          flavarss = strsplit(flavars)
          if disij != &quot;_empty&quot;
            disijss = strsplit(disij)
            preff = disijss[1]
            nsuff = atof(disijss[2])
            findij = findind(preff,hugenams)
            #print nsuff
            #print findij
            ckij = findij
            if findij &gt; 0
              unqij = values(da[findij])'
              if unqij != seq(1,nelem(unqij))
                ckij = 0
              endif
            endif
            preff2 = substr(preff,2,strlen(preff))
            findij2 = findind(preff2,hugenams)
            #print findij2
            ckij2 = findij2
            if findij2 &gt; 0
              unqij2 = values(da[findij2])'
              #print unqij2
              if unqij2 != seq(1,nelem(unqij2))
                ckij2 = 0
              endif
            endif
            # eval &quot;ckij ckij2&quot;
            #print ckij ckij2
            if (ckij+ckij2) == 0
              bubu_c = bubu_c~&quot; &quot;~flavarss[ij]
            elif (ckij &gt; 0)&amp;&amp;(ckij2 == 0)
              bubu_di = bubu_di~&quot; &quot;~preff
            elif (ckij == 0)&amp;&amp;(ckij2 &gt; 0)
              bubu_di = bubu_di~&quot; &quot;~preff2
              substij = strstrip(preff2~&quot;_&quot;~disijss[2])
              funij = smartstrsub(funij,flavarss[ij],substij)
            else
              printf &quot;\nAmbigous var. names: both %s and %s are discrete&quot;,pref,pref2
              printf &quot;\nYou may need manual correction of formula&quot;
              printf &quot;\nor renaming variables\n&quot;
              bubu_di = bubu_di~&quot; &quot;~preff
            endif
            #eval &quot;bubus&quot;
            #print bubu_c
            #eval &quot;bubudi&quot;
            #print bubu_di
            #eval &quot;funij&quot;
            # print funij
            ret3 = funij
            didi = bubu_di
            dilis = dilis~&quot; &quot;~didi
          else
            bubu_c = bubu_c~&quot; &quot;~flavarss[ij]
            ret3 = vvv
            lili = ret3
            colis = colis~&quot; &quot;~lili
          endif
          rets = rets~&quot; &quot;~ret3
        endif
      endif
    endif
    colis = strstrip(colis)
    dilis = strstrip(dilis)
    rets_left = strstrip(rets_left~&quot; &quot;~vvv)
    rets_right = rets_right~&quot; &quot;~ret3
  endif
endloop
rets = strstrip(rets)
discrsi = uniqvarlist(dilis)
conti = uniqvarlist(colis)
return strstrip(rets)~&quot;;&quot;~ strstrip(conti)~&quot;;&quot;~strstrip(discrsi)
</code>
</gretl-function>
<gretl-function name="sq_inters" type="list">
 <params count="2">
  <param name="li1" type="list">
<description>list of series</description>
  </param>
  <param name="squares" type="bool" default="0">
<description>whether to include squares</description>
  </param>
 </params>
<code>li1 = li1 - 0
list ret = null
namli1 = varnames(li1)
namli110 = cut_names(namli1)
bign = nelem(namli110)
list ret = null
string descr
strings S = array(2)
scalar count = 0
loop i=1..bign -q
  if squares==0
    count = i+1
  else
    count = i
  endif
  loop j = count..bign -q
    name = namli110[i]~&quot;_&quot;~namli110[j]
    descr = namli1[i]~&quot;*&quot;~namli1[j]
    uni = uniqvarlist(descr)
    unis = strsplit(uni)
    n = nelem(unis)
    if n == 1
      S = corr_d_n_sq(name,descr)
      name = S[1]
      descr = S[2]
    endif
    ret += genseries(name,li1[i]*li1[j])
    text2 = sprintf(&quot;setinfo %s --description=\&quot;%s\&quot;&quot; ,name, descr)
    @text2
  endloop
endloop
return dropcoll(ret)
</code>
</gretl-function>
<gretl-function name="mk_formula2" type="string">
 <params count="3">
  <param name="xlist" type="list">
<description>$xlist in most cases</description>
  </param>
  <param name="vlist" type="list" optional="true">
<description>indep. cont. and dummy vars</description>
  </param>
  <param name="discrlist" type="list" optional="true">
<description>indep discrete vars</description>
  </param>
 </params>
<code>gretl_version = $version
xlist = xlist-const
n = nelem(xlist)
string line
vns = varnames(xlist)
nv = nelem(vlist)
ndi = nelem(discrlist)
if (nv + ndi) == 0
  funcerr &quot;no independent variables given&quot;
endif
indlist = vlist || discrlist
alln = strjoin(varnames(indlist))
if nv == 0
  string othn = null
  isno = !exists(othn)
else
  string othn = strjoin(varnames(vlist))
endif
if ndi == 0
  string disn = null
else
  string disn = strjoin(varnames(discrlist))
endif
ret = &quot;&quot;
loop i=1..n -q
  inli = inlist(indlist,xlist[i])
  if inli
    ret3 = vns[i]
    ret = ret~&quot; &quot;~ret3
  else
    outfile mybuf --buffer --quiet
      labels xlist[i]
      outfile --close
        string s = mybuf
        scalar j = 1
        loop while getline(s, line)&amp;&amp;(j&lt;3) -q
          uu=sprintf( &quot;%s\n&quot;,  line)
          j++
        endloop
        bign = strlen(uu)
        uuu = strstr(uu,&quot;:&quot;)
        n = strlen(uuu)
        vvv = strstrip(substr(uu,1,bign-n))
        uuu = substr(uuu,3,n)
        uuu = strstrip(uuu)
        ret3 = doret2(uuu,vvv,disn,othn)
        ret = ret~&quot; &quot;~ret3
      endif
    endloop
    ret = strstrip(ret)
    if nv == 0
      retvl = &quot;_empty&quot;
    else
      retvl = strjoin(varnames(vlist))
    endif
    if ndi == 0
      retdis = &quot;_empty&quot;
    else
      retdis = strjoin(varnames(discrlist))
    endif
    ret = ret~&quot;;&quot;~retvl~&quot;;&quot;~retdis
    return ret
</code>
</gretl-function>
<gretl-function name="eyex" type="bundle">
 <params count="5">
  <param name="b" type="bundleref">
<description>b is $model in most cases</description>
  </param>
  <param name="formula" type="string" optional="true">
<description>the model formula</description>
  </param>
  <param name="at_wrt_type" type="string" optional="true">
<description>at and wrt vars names, eff type</description>
  </param>
  <param name="at_vals" type="matrix" optional="true">
<description>values of 'at vars'</description>
  </param>
  <param name="da" type="list" optional="true">
<description>dataset, for gretl before 2018d</description>
  </param>
 </params>
<code>gretl_version = $version
cmd = b.command
name_of_y = b.depvar
matrix coe = b.coeff
matrix vcov = b.vcv
#list xx = b.xlist
#funcerr &quot;just stopped&quot;
exifla = exists(formula)
if !exifla
  formula = smart_formula2(b.xlist)
  ##
else
  isdotcomma = instring(formula,&quot;;&quot;)
  #print isdotcomma
  if !isdotcomma
    formula_backup = formula
    formula_2s = strsplit(formula)
    nf2s = nelem(formula_2s)
    list indep0 = null
    loop i=1..nf2s -q
      jjj = inlist(b.xlist,formula_2s[i])
      if jjj &gt; 0
        indep0 += b.xlist[jjj]
      endif
    endloop
    formula = smart_formula2(b.xlist,indep0)
  endif
  ###
endif
#funcerr &quot;just stopped&quot;
isnuatwrt = !exists(at_wrt_type)
if isnuatwrt
  string at_wrt_type = &quot;&quot;
endif
strings all_string_input = fndtype(at_wrt_type)
string link = all_string_input[3]
string wrt = all_string_input[1]
wrtBACKUP = wrt
string at_nams =  all_string_input[2]
if strlen(wrt)+strlen(at_nams) == 0
  isnuatwrt = 1
endif
series sample = b.sample
formulas = strsplit3(formula,&quot;;&quot;)
newformula = formulas[1]
clistnames = formulas[2]
dilistnames = formulas[3]
list clist = null
list dilist = null
nvar = $nvars
#stri = mk_txt_range(nvar - 1)
#funcerr &quot;just stopped&quot;
if nelem(da) == 0
  list da = seq(1,nvar - 1)
endif
if clistnames != &quot;_empty&quot;
  clistnamess = strsplit(clistnames)
  nclist = nelem(clistnamess)
  loop i=1..nclist -q
    clnamsi = clistnamess[i]
    clist+=da[inlist(da,clnamsi)]
  endloop
else
  funcerr &quot;no continuous variables in the model&quot;
endif
matrix t_c_indi = {}
string true_cont = &quot;&quot;
loop foreach i clist -q
  isdi = isdummy(clist[i])
  if !isdi
    true_cont = true_cont~&quot; &quot;~varname(clist[i])
    t_c_indi = t_c_indi~i
  endif
endloop
#funcerr &quot;just stopped&quot;
if cmd != &quot;heckit&quot;
  if strlen(true_cont) == 0
    funcerr &quot;no continuous variables in the model&quot;
  endif
endif
isnumat = !exists(at_vals)
if isnuatwrt
  string at_nams = null
  string wrt = true_cont
else
  if strlen(wrt) == 0
    string wrt = true_cont
  else
    checkwrt = str_setdiff(wrt,true_cont)
    if (strlen(checkwrt) &gt; 0)&amp;&amp;(cmd != &quot;heckit&quot;)
      funcerr &quot;non-continuous variable(s) in 'wrt' list&quot;
    endif
  endif
endif
if dilistnames != &quot;_empty&quot;
  dilistnamess = strsplit(dilistnames)
  ndilist = nelem(dilistnamess)
  loop i=1..ndilist -q
    dilnamsi = dilistnamess[i]
    dilist+=da[inlist(da,dilnamsi)]
  endloop
endif
if cmd == &quot;heckit&quot;
  string orig_names = clistnames == &quot;_empty&quot;? &quot;&quot; : clistnames
  orig_names = dilistnames == &quot;_empty&quot;? orig_names : orig_names~&quot; &quot;~dilistnames
  scalar grvers = $version
  string at_namsZ = &quot;&quot;
  string wrtZ = &quot;&quot;
  list zlist = b.zlist - b.zlist[1]
  if !isnuatwrt
    string at_namsALL = at_nams
    at_nams = str_setinrersect(at_nams,orig_names)
    at_namsZ = str_setdiff(at_namsALL,at_nams)
    string wrtALL = wrt
    wrt = str_setinrersect(wrt,orig_names)
    string wrtZ = str_setdiff(wrtALL,wrt)
  endif
  isnw = wrt == &quot;&quot;
  if !isnw
    wtwt = str_setdiff(wrt,orig_names)
    wrtchk = strlen(wtwt)
    errtext = sprintf(&quot;wrong name(s) in 'wrt' list: %s&quot;,wtwt)
    if wrtchk &gt; 0
      funcerr errtext
    endif
  endif
endif
#     print clist
mclist = {clist}
mdilist = {dilist}
naclist = varnames(clist)
nadilist = varnames(dilist)
#funcerr &quot;just stopped&quot;
if strlen(at_nams) == 0
  bundle bu = defvals (formula,clist,dilist)
else
  bundle bu = findvals(at_nams,at_vals,formula,clist,dilist)
endif
#funcerr &quot;just stopped&quot;
allnames = bu[&quot;allnames&quot;]
matrix allvalues = bu[&quot;allvalues&quot;]
orerr = 1
orerrlo = 1
merrlo = 1
contvars = bu.contvars
contvars = str_setinrersect(contvars,wrt)
#############
#funcerr &quot;just stopped&quot;
if (cmd == &quot;ols&quot;)||(cmd == &quot;hsk&quot;)||(cmd == &quot;wls&quot;)||(cmd == &quot;tsls&quot;)
  #printf &quot;\n%s elasticities of %s:\n&quot;, cmd, name_of_y
  if link !=&quot;exp&quot;
    printf &quot;\n%s elasticities of %s:\n&quot;, cmd, name_of_y
    matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,&quot;ols&quot;,allnames,vcov)
  else
    yformula = smart_formula2(b.ylist)
    yformulas = strsplit(yformula,&quot;;&quot;)
    ckylog = substr(yformulas[1],1,4)==&quot;log(&quot;
    #             print ckylog
    #             eval uniqvarlist(yformulas[1])
    #if (strlen(name_of_y) &gt; 2)&amp;&amp;(substr(name_of_y,1,2)==&quot;l_&quot;)
    if ckylog
      #new_name_y = substr(name_of_y,3,strlen(name_of_y))
      new_name_y = substr(yformulas[1],5,strlen(yformulas[1])-1)
      printf &quot;\n%s elasticities of %s:\n&quot;, cmd, new_name_y
    else
      printf &quot;\n%s elasticities of exp(%s):\n&quot;, cmd, name_of_y
    endif
    matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,&quot;poisson&quot;,allnames,vcov)
  endif
  #matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,&quot;ols&quot;,allnames,vcov)
elif cmd == &quot;poisson&quot;
  printf &quot;\n%s elasticities of E(%s):\n&quot;, cmd, name_of_y
  matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,cmd,allnames,vcov)
elif cmd == &quot;logistic&quot;
  printf &quot;\n%s elasticities of Pr(%s = 1):\n&quot;, cmd, name_of_y
  matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,&quot;logit&quot;,allnames,vcov)
elif cmd == &quot;logit&quot;
  catch scalar ordere = b.ordered
  orerrlo = $error
  if orerrlo == 0
    onx = b.nx
    matrices M = op_elast1 (newformula,allnames,allvalues,wrt,b.coeff,vcov,onx,2)
  else
    catch scalar mulitino = b.multinom
    merrlo = $error
    if merrlo == 0
      matrices M = ml_elast22 (newformula,allnames,allvalues,wrt,b.coeff,mulitino +1,vcov)
    else
      printf &quot;\n%s elasticities of Pr(%s = 1):\n&quot;, cmd, name_of_y
      matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,cmd,allnames,vcov)
    endif
  endif
elif cmd == &quot;probit&quot;
  catch scalar ordere = b.ordered
  orerr = $error
  if orerr == 0
    onx = b.nx442w
    printf &quot;\n%s elasticities of Pr(%s = 1):\n&quot;, cmd, name_of_y
    matrices M = el_coeff002(newformula,wrt,allvalues,b.coeff,cmd,allnames,vcov)
  endif
elif cmd == &quot;heckit&quot;
  name_of_yz = varnames(b.zlist)[1]
  if link != &quot;Ey&quot;
    printf &quot;\n%s elasticities of E(%s|%s &gt; 0):\n&quot;, cmd, name_of_y, name_of_yz
  else
    printf &quot;\n%s elasticities of E(%s):\n&quot;, cmd, name_of_y
  endif
  list xxZ = zlist
  exiflaZ = exists(formulaZ)
  if !exiflaZ
    formulaZ = smart_formula2(xxZ)
    ###
    if exifla
      isdotcomma = instring(formula_backup,&quot;;&quot;)
      if !isdotcomma
        formula_2s = strsplit(formula_backup)
        nf2s = nelem(formula_2s)
        list indep0 = null
        loop i=1..nf2s -q
          jjj = inlist(xxZ,formula_2s[i])
          if jjj &gt; 0
            indep0 += xxZ[jjj]
          endif
        endloop
        formulaZ = smart_formula2(xxZ,indep0)
      endif
    endif
    #####
  endif
  formulasZ = strsplit3(formulaZ,&quot;;&quot;)
  newformulaZ = formulasZ[1]
  if !exiflaZ
    newformulaZ = strstrip(smartstrsub(newformulaZ,&quot;const&quot;,&quot;&quot;))
  endif
  clistnamesZ = formulasZ[2]
  dilistnamesZ = formulasZ[3]
  list clistZ = null
  list dilistZ = null
  if clistnamesZ != &quot;_empty&quot;
    clistnamessZ = strsplit(clistnamesZ)
    nclistZ = nelem(clistnamessZ)
    loop i=1..nclistZ -q
      clnamsiZ = clistnamessZ[i]
      clistZ+=da[inlist(da,clnamsiZ)]
    endloop
  endif
  if dilistnamesZ != &quot;_empty&quot;
    dilistnamessZ = strsplit(dilistnamesZ)
    ndilistZ = nelem(dilistnamessZ)
    loop i=1..ndilistZ -q
      dilnamsiZ = dilistnamessZ[i]
      dilistZ+=da[inlist(da,dilnamsiZ)]
    endloop
  endif
  string orig_namesZ = clistnamesZ == &quot;_empty&quot;? &quot;&quot; : clistnamesZ
  orig_namesZ = dilistnamesZ == &quot;_empty&quot;? orig_namesZ : orig_namesZ~&quot; &quot;~dilistnamesZ
  at_namsZ = str_setinrersect(orig_namesZ,at_namsZ)
  if strlen(at_namsZ) == 0
    bundle buZ = defvals (newformulaZ,clistZ,dilistZ)
  else
    matrix findiZZ = findinds(at_namsZ, at_namsALL)
    matrix at_valsZ = at_vals[findiZZ]
    bundle buZ = findvals(at_namsZ,at_valsZ,newformulaZ,clistZ,dilistZ)
  endif
  allnamesZ = buZ.allnames
  contvarsZ = buZ.contvars
  if contvarsZ == &quot;_empty&quot;
    contvarsZ = &quot;&quot;
  endif
  dumvars = bu.dumvars
  if dumvars == &quot;_empty&quot;
    dumvars = &quot;&quot;
  endif
  dumvarsZ = buZ.dumvars
  if dumvarsZ == &quot;_empty&quot;
    dumvarsZ = &quot;&quot;
  endif
  matrix allvaluesZ = buZ.allvalues
  divarsZ = buZ.divars
  if divarsZ == &quot;_empty&quot;
    divarsZ = &quot;&quot;
  endif
  divars = bu.divars
  if divars == &quot;_empty&quot;
    divars = &quot;&quot;
  endif
  if (strlen(wrtBACKUP) &gt; 0)
    contvars = str_setinrersect(contvars,wrtBACKUP)
    contvarsZ = str_setinrersect(contvarsZ,wrtBACKUP)
    dumvars = str_setinrersect(dumvars,wrtBACKUP)
    dumvarsZ = str_setinrersect(dumvarsZ,wrtBACKUP)
    divars = str_setinrersect(divars,wrtBACKUP)
    divarsZ = str_setinrersect(divarsZ,wrtBACKUP)
  endif
  if  (strlen(contvars)+ strlen(contvarsZ)) == 0
    funcerr &quot;no continuous variables&quot;
  else
    matrices M = ALL_hk_fun(newformula,allnames,contvars,newformulaZ, allnamesZ, contvarsZ,b.base_coeffs+1,b.ncoeff,allvalues,allvaluesZ,coe,vcov,1,link)
    second = str_setdiff(contvarsZ,contvars)
    contvars = strstrip(contvars~&quot; &quot;~second)
  endif
elif cmd == &quot;tobit&quot;
  tobcond = 0
  if exists(link)
    if link == &quot;inside&quot;
      tobcond = 1
    endif
  endif
  vcov = b.full_vcv
  s__ = b.sigma
  catch lo__ = b.llimit
  errtob1 = $error
  if errtob1 &gt; 0
    lo__ = 0
  endif
  catch hi__ = b.rlimit
  errtob2 = $error
  if errtob2 &gt; 0
    hi__ = $huge
    scalar hi22 = NA
  else
    scalar hi22 = hi__
  endif
  if tobcond == 0
    printf &quot;\n%s elasticities of E(%s):\n&quot;, cmd, name_of_y
    matrices M = tb_elast1(newformula,allnames,allvalues,wrt,coe,s__,lo__,hi__,vcov)
  else
    tytyt = mk_tob_outtext(lo__,hi22,name_of_y)
    printf &quot;\n%s elasticities of E(%s|%s):\n&quot;, cmd,name_of_y, tytyt
    matrices M = tb_elast2(newformula,allnames,allvalues,wrt,coe,s__,lo__,hi__,vcov)
  endif
else
  errmess = sprintf(&quot;not imlemented yet for %s&quot;,cmd)
  funcerr errmess
endif
if (orerr == 0)||(orerrlo == 0)||(merrlo == 0)
  scalar nal = M[5]
  matrix coco = M[2]
  matrix soso = M[4]
  if merrlo == 0
    printf &quot;\nmultinomial %s elasticities\n&quot;, cmd
  else
    printf &quot;\nordered %s elasticities\n&quot;, cmd
  endif
  loop i=1..nal -q
    printf &quot;\nelasticities of Pr(%s = %d):\n&quot;,name_of_y, i
    matrix coeffmat  = coco[i,]'~soso[i,]'
    modprint coeffmat contvars
  endloop
  matrix coeffmat  = vec(coco')~vec(soso')
else
  matrix coeffmat  = M[2]~M[4]
  modprint coeffmat contvars
endif
newnames = contvars
bundle bout
bout[&quot;names&quot;] = newnames
matrix bout[&quot;mfx&quot;] = coeffmat[,1]
matrix bout[&quot;se&quot;] = coeffmat[,2]
matrix bout[&quot;vcov&quot;] = M[3]
string bout[&quot;type&quot;] = &quot;el&quot;
string bout[&quot;pkg&quot;] = &quot;a_eff&quot;
string bout[&quot;command&quot;] = b.command
string bout[&quot;cmd2&quot;] = cmd
scalar bout[&quot;nalt&quot;] = 1
if cmd == &quot;probit&quot;
  if orerr == 0
    bout[&quot;cmd2&quot;] = &quot;orderedP&quot;
    bout[&quot;nalt&quot;] = b.ncoeff - b.nx + 1
  endif
endif
if cmd == &quot;logit&quot;
  if orerrlo == 0
    bout[&quot;cmd2&quot;] = &quot;orderedL&quot;
    bout[&quot;nalt&quot;] = b.ncoeff - b.nx + 1
  endif
  if merrlo == 0
    bout[&quot;cmd2&quot;] = &quot;multinomial&quot;
    bout[&quot;nalt&quot;] =  b.ncoeff/b.cblock + 1
  endif
endif
return bout
</code>
</gretl-function>
<gretl-function name="inters" type="list">
 <params count="3">
  <param name="li1" type="list">
<description>list of series</description>
  </param>
  <param name="li2" type="list">
<description>list of series</description>
  </param>
  <param name="squares" type="bool" default="0">
<description>whether to include squares</description>
  </param>
 </params>
<code>li1 = li1 - 0
li2 = li2 - 0
if squares == 0
  li2 -=li1
  eval varname(li2)
endif
list ret = null
namli1 = varnames(li1)
namli110 = cut_names(namli1)
bign = nelem(namli110)
namli2 = varnames(li2)
namli220 = cut_names(namli2)
bign2 = nelem(namli220)
string descr
strings S = array(2)
scalar count = 0
loop i=1..bign -q
  loop j = 1..bign2 -q
    name = namli110[i]~&quot;_&quot;~namli220[j]
    descr = namli1[i]~&quot;*&quot;~namli2[j]
    uni = uniqvarlist(descr)
    unis = strsplit(uni)
    n = nelem(unis)
    if n == 1
      S = corr_d_n_sq(name,descr)
      name = S[1]
      descr = S[2]
    endif
    ret += genseries(name,li1[i]*li2[j])
    text2 = sprintf(&quot;setinfo %s --description=\&quot;%s\&quot;&quot; ,name, descr)
    @text2
  endloop
endloop
return dropcoll(ret)
</code>
</gretl-function>
<gretl-function name="xtextfun" type="string" private="1">
 <params count="4">
  <param name="flas" type="strings"/>
  <param name="start" type="int" default="1"/>
  <param name="iscst" type="bool" default="1"/>
  <param name="x" type="string" optional="true"/>
 </params>
<code>nf = nelem(flas)
if !exists(x)
  x = &quot;x___&quot;
endif
if iscst
  rets = x~sprintf(&quot;[%d]&quot;, start)
  loop i=1..nf -q
    flsi = flas[i]
    reti = x~sprintf(&quot;[%d]*%s&quot;,i+start,flsi)
    rets = rets~&quot;+&quot;~reti
  endloop
else
  rets = &quot;&quot;
  loop i=1..nf -q
    flsi = flas[i]
    reti = x~sprintf(&quot;[%d]*%s&quot;,i+start-1,flsi)
    if i == 1
      rets = reti
    else
      rets = rets~&quot;+&quot;~reti
    endif
  endloop
endif
return rets
</code>
</gretl-function>
<gretl-function name="make_flas_el" type="strings" private="1">
 <params count="6">
  <param name="fla" type="string"/>
  <param name="wrtvars" type="string"/>
  <param name="allvars" type="string" optional="true"/>
  <param name="vect_name" type="string" optional="true"/>
  <param name="b_name" type="string" optional="true"/>
  <param name="iscst" type="bool" default="1"/>
 </params>
<code>strings flas = strsplit(fla)
strings wrtvarss = strsplit(wrtvars)
if !exists(allvars)
  allvars = uniqvarlist(fla)
endif
if !exists(vect_name)
  vect_name = &quot;x___&quot;
endif
if !exists(b_name)
  b_name = &quot;b___&quot;
endif
strings allvarss = strsplit(allvars)
nf = nelem(flas)
nv = nelem(wrtvarss)
matrix indis = findinds(wrtvars,allvars)
indis = sort(indis)
nindi = nelem(indis)
fla1 = fla
loop i = 1..nindi -q
  subi = sprintf(&quot;%s[%d]&quot;,vect_name,i)
  fla1 = smartstrsub(fla1,allvarss[indis[i]],subi)
endloop
ret1 = xtextfun(strsplit(fla1),nindi+1,iscst)
ret2 = xtextfun(strsplit(fla1),1,iscst,b_name)
strings S = array(2)
S[1] = ret2
S[2] = ret1
return S
</code>
</gretl-function>
<gretl-function name="super3" type="matrices" private="1">
 <params count="7">
  <param name="fun___" type="string"/>
  <param name="fun2___" type="string"/>
  <param name="vars___" type="string" optional="true"/>
  <param name="x___" type="matrix"/>
  <param name="b___" type="matrix"/>
  <param name="z___" type="matrix" optional="true"/>
  <param name="link___" type="string" optional="true"/>
 </params>
<code>if exists(z___)
  strings S___ = strsplit(vars___)
  loop i___=1..nelem(z___) -q
    ddd___ = S___[i___]
    scalar @ddd___ = z___[i___]
  endloop
endif
scalar val0___ = @fun___
sign___ = val0___ &gt; 0
if link___ == &quot;ols&quot;
  fun___ = &quot;log(abs&quot;~fun___~&quot;)&quot;
elif link___ == &quot;poisson&quot;
  fun___ = &quot;abs&quot;~fun___
elif link___ == &quot;logit&quot;
  fun___ = &quot;log(1+exp(-(&quot;~fun___~&quot;)))&quot;
  sign___ = 0
elif link___ == &quot;probit&quot;
  fun___ = &quot;log(cnorm(&quot;~fun___~&quot;))&quot;
  sign___ = 0
endif
nx___ = nelem(x___)
x___ = vec(x___)
jac___ = sign___ ? fdjac(x___,@fun___) : -fdjac(x___,@fun___)
jac___ = vec(jac___)
xbcp___ = x___
x___ = x___|vec(b___)
if link___ == &quot;ols&quot;
  fun2___ = &quot;log(abs&quot;~fun2___~&quot;)&quot;
elif link___ == &quot;logit&quot;
  fun2___ = &quot;log(1+exp(-(&quot;~fun2___~&quot;)))&quot;
elif link___ == &quot;probit&quot;
  fun2___ = &quot;log(cnorm(&quot;~fun2___~&quot;))&quot;
endif
#if (link___ == &quot;ols&quot;)||(link___ == &quot;poisson&quot;)
matrix hess___ = numhess(x___,@fun2___)[1:nx___,(nx___+1):]
matrices M___ = defarray({val0___},jac___.*xbcp___,hess___.*xbcp___)
# elif link___ == &quot;poisson&quot;
#     matrix hess___ = numhess(x___,@fun2___)[1:nx___,(nx___+1):]
#     matrices M___ = defarray({val0___},jac___,hess___)
#endif
return M___
</code>
</gretl-function>
<gretl-function name="el_coeff002" type="matrices" private="1">
 <params count="7">
  <param name="fla" type="string"/>
  <param name="wrtvars" type="string"/>
  <param name="allvals" type="matrix"/>
  <param name="b" type="matrix"/>
  <param name="cmd" type="string"/>
  <param name="allvars" type="string" optional="true"/>
  <param name="vcv" type="matrix" optional="true"/>
 </params>
<code>nf = nelem(strsplit(fla))
nb = nelem(b)
iscst = nb &gt; nf
if !exists(allvars)
  allvars = uniqvarlist(fla)
endif
indi0 = findinds(wrtvars,allvars)
wrtvars = str_setinrersect(allvars,wrtvars)
if wrtvars == allvars
  allvals = allvals[indi0]
endif
strings work_flass =make_flas_el (fla, wrtvars,allvars,&quot;x___&quot;,&quot;b___&quot;,iscst)
el_fla = &quot;(&quot;~work_flass[1]~&quot;)&quot;
hess_fla = &quot;(&quot;~work_flass[2]~&quot;)&quot;
zvars = str_setdiff(allvars,wrtvars)
findix = findinds(wrtvars,allvars)
if strlen(zvars) &gt; 0
  findiz = findinds(zvars,allvars)
  matrix x = allvals[sort(findix)]
  matrix z = allvals[findiz]
  matrices M = super3(el_fla,hess_fla ,zvars,x,b,z,cmd)
else
  matrix x = allvals
  matrices M = super3(el_fla,hess_fla ,null,x,b,null,cmd)
endif
if exists(vcv)
  matrices retms = array(4)
  retms[1] = M[1]
  retms[2] = M[2]
  matrix vcov = qform(M[3],vcv)
  retms[3] = vcov
  matrix ses = sqrt(diag(vcov))
  retms[4] = ses
else
  matrices retms = array(2)
  retms[1] = M[1]
  retms[2] = M[2]
endif
return retms
</code>
</gretl-function>
<gretl-function name="indclude" type="matrix" private="1">
 <params count="2">
  <param name="n" type="scalar"/>
  <param name="inds" type="matrix"/>
 </params>
<code>ni = nelem(inds)
nnn = n - ni
if nnn == 0
  matrix ret = {}
else
  scalar mu
  matrix ret = zeros(1,nnn)
  scalar j = 1
  loop i = 1..n -q
    mu = minc(abs(inds-i))
    if mu &gt; 0
      ret[j] = i
      j++
    endif
  endloop
endif
return ret
</code>
</gretl-function>
<gretl-function name="findvals" type="bundle" private="1">
 <params count="5">
  <param name="nams" type="string"/>
  <param name="vals" type="matrix"/>
  <param name="formula" type="string" optional="true"/>
  <param name="clist" type="list" optional="true"/>
  <param name="dilist" type="list" optional="true"/>
 </params>
<code>bundle bu = defvals (formula,clist,dilist)
matrix matri = bu[&quot;allvalues&quot;]
namss = strsplit(nams)
n = nelem(namss)
matrix thelev={}
matrix indi={}
loop i=1..n -q
  i1 = findind(namss[i],bu[&quot;contvars&quot;])
  i2 = findind(namss[i],bu[&quot;dumvars&quot;])
  if i2
    i24 = minr(abs({0,1} .- vals[i]))
    if i24&gt;0
      msg = &quot;'&quot;~namss[i]~&quot;': wrong level for 'at' value&quot;
      funcerr msg
    endif
  endif
  if (i1+i2)
    i11 = findind(namss[i],bu[&quot;allnames&quot;])
    matri[i11]=vals[i]
  else
    i3 = findind(namss[i],bu[&quot;divars&quot;])
    alli = values(dilist[i3])
    i4 = minc(abs(alli .- vals[i]))
    if i4&gt;0
      msg = &quot;'&quot;~namss[i]~&quot;': wrong level for 'at' value&quot;
      funcerr msg
    endif
    if i3==0
      msg = &quot;'&quot;~namss[i]~&quot;': wrong name of 'at' variable&quot;
      funcerr msg
    endif
    levi = mk_factlevs2 (formula, namss[i],bu[&quot;allnames&quot;])
    dini = discrnams2(namss[i],levi)
    thelev = getatdidvals(levi, vals[i])
    indi = findinds(dini,bu[&quot;allnames&quot;])
    matri[indi]=thelev
  endif
endloop
matrix bu[&quot;allvalues&quot;]=matri
return bu
</code>
</gretl-function>
<gretl-function name="check_log" type="string" private="1">
 <params count="3">
  <param name="str1" type="string"/>
  <param name="str2" type="string"/>
  <param name="othernames" type="string" optional="true"/>
 </params>
<code>ch1=(substr(str1,1,2)==&quot;l_&quot;)
ch2 = exists(othernames)
ret = 0
if (ch1 &gt; 0)&amp;&amp;(ch2 &gt; 0)
  tt2 = str_setinrersect(str2,othernames)
  tt2s = strsplit(tt2)
  ttn = nelem(tt2s)
  if ttn==1
    tt21 = tt2s[1]
    ntt21 = strlen(tt21)
    if ntt21 &gt; 0
      ret = 1
    endif
  endif
endif
if ret == 0
  sret = &quot;_empty&quot;
else
  sret = &quot;log(&quot;~tt21~&quot;)&quot;
endif
return sret
</code>
</gretl-function>
<gretl-function name="parse_fla3" type="strings" private="1">
 <params count="2">
  <param name="fla" type="string"/>
  <param name="indeps" type="string" optional="true"/>
 </params>
<code>ni = !exists(indeps)
if ni
  indeps = &quot;&quot;
endif
fla0 = fla
vari = uniqvarlist(fla)
varis = strsplit(vari)
nvari = nelem(varis)
contis = &quot;&quot;
diis = &quot;&quot;
loop i=1..nvari -q
  vari = varis[i]
  fifi = findind(vari,indeps)
  if fifi != 0
    contis = contis~&quot; &quot;~vari
  else
    isduvi = isduname(vari)
    if isduvi
      fla0 = smartstrsub(fla0,vari,corr_duname(vari))
      diis = diis~&quot; &quot;~getdiname(corr_duname(vari))
    elif isdiname(vari)
      diis = diis~&quot; &quot;~getdiname(vari)
    else
      contis = contis~&quot; &quot;~vari
    endif
  endif
endloop
contis = strstrip(contis)
diis = strstrip(diis)
ret = fla0~&quot;;#&quot;~contis~&quot;;#&quot;~diis
rets = strsplit3(ret,&quot;;&quot;)
return rets
</code>
</gretl-function>
<gretl-function name="smartstrsub" type="string" private="1">
 <params count="3">
  <param name="bigst" type="string"/>
  <param name="find" type="string"/>
  <param name="repl" type="string"/>
 </params>
<code>if strlen(strstr(bigst,find))
  varch = &quot;qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM0123456789_&quot;
  varchR = &quot;qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM0123456789_([&quot;
  bigst1 = &quot;#&quot;~strsub(bigst,&quot; &quot;, &quot;#&quot;)~&quot;#&quot;
  bigst2 = strsub(bigst1,find,&quot; &quot;~find~&quot; &quot;)
  bigst2s = strsplit(bigst2)
  bign = nelem(bigst2s)
  ret0 = &quot;&quot;
  loop i = 1..bign -q
    if bigst2s[i] == find
      lengi = strlen(bigst2s[i-1])
      left = strlen(strstr(varch,substr(bigst2s[i-1],lengi,lengi)))
      right = strlen(strstr(varchR,substr(bigst2s[i+1],1,1)))
      if !left&amp;&amp;!right
        bigst2s[i] = repl
      endif
    endif
    ret0 = ret0~bigst2s[i]
  endloop
  return strstrip(strsub(ret0,&quot;#&quot;,&quot; &quot;))
else
  return bigst
endif
</code>
</gretl-function>
<gretl-function name="strjoin" type="string" private="1">
 <params count="2">
  <param name="strs" type="strings"/>
  <param name="collapce" type="string" optional="true"/>
 </params>
<code>if !exists(collapce)
  collapce = &quot; &quot;
endif
n = nelem(strs)
ret = strs[1]
if n&gt;1
  loop i = 2..n -q
    ret = ret~collapce~strs[i]
  endloop
endif
ret = strstrip(ret)
return ret
</code>
</gretl-function>
<gretl-function name="getdidvals" type="matrix" private="1">
 <params count="2">
  <param name="levs" type="string"/>
  <param name="y" type="series"/>
 </params>
<code>levss = strsplit(levs)
n = nelem(levss)
matrix mat = zeros(1,n)
loop i=1..n -q
  nlevi = atof(levss[i])
  mat[i]=mean(y==nlevi)
endloop
return mat
</code>
</gretl-function>
<gretl-function name="mk_alllevs" type="string" private="1">
 <params count="1">
  <param name="n" type="int"/>
 </params>
<code>ret = &quot;&quot;
loop i=1..n -q
  reti = sprintf(&quot; %d&quot;,i)
  ret = ret~reti
endloop
ret = strstrip(ret)
return ret
</code>
</gretl-function>
<gretl-function name="mk_nami" type="string" private="1">
 <params count="2">
  <param name="nam" type="string"/>
  <param name="levs" type="string"/>
 </params>
<code>levss = strsplit(levs)
ns = nelem(levss)
txt = &quot;&quot;
loop i=1..ns -q
  if i==1
    sep = &quot;&quot;
  else
    sep = &quot;, &quot;
  endif
  txt = txt~sep~nam~&quot; = &quot;~levss[i]
endloop
txt = strstrip(txt)
if ns==1
  txt=txt~&quot;,&quot;
endif
return txt
</code>
</gretl-function>
<gretl-function name="get_cnames" type="string" private="1">
 <params count="1">
  <param name="x" type="matrix"/>
 </params>
<code>n = strlen(colname(x,1))
ret = &quot;&quot;
if n &gt; 0
  nx = nelem(x)
  loop i=1..nx -q
    ret = ret~&quot; &quot;~colname(x,i)
  endloop
  ret = strstrip(ret)
  rets = strsplit(ret)
  nr = nelem(rets)
  if nr != nx
    ret = &quot;&quot;
  endif
endif
lr = strlen(ret)&gt;0
ret1 = ret
if ret1 == &quot;&quot;
  ret1 = &quot;_empty&quot;
endif
return ret1
</code>
</gretl-function>
<gretl-function name="isop" type="scalar" private="1">
 <params count="1">
  <param name="str" type="string"/>
 </params>
<code>ops = &quot;+ - * / ^&quot;
opss = strsplit(ops)
posi = zeros(5,1)
loop i=1..5 -q
  posi[i]=isstrstr(str,opss[i])
endloop
return sum(posi)&gt;0
</code>
</gretl-function>
<gretl-function name="print_long_string" type="void" private="1">
 <params count="1">
  <param name="str" type="string"/>
 </params>
<code>str0 = str
bign = strlen(str)
if bign &lt; 76
  printf &quot;\n%s\n&quot;, str
else
  posi = posstrstr(str0,&quot; &quot;)
  if posi[1]==0
    lines = ceil(bign/76)
    printf &quot;\n&quot;
    loop i=1..lines -q
      stri = strstrip(substr(str,(i-1)*76+1,i*76))
      printf &quot;%s\n&quot;, stri
    endloop
  else
    j = 1
    str10 = str
    printf &quot;\n&quot;
    loop while 1==1 -q
      n10 = strlen(str10)
      if n10&lt;77
        strprn = str10
      else
        str0 = substr(str10,1,77)
        posii = posstrstr(str10,&quot; &quot;)
        break1 = iminr(abs(posii.-76))
        strprn = strstrip(substr(str10,1,posii[break1]))
        str10 = substr(str10,posii[break1]+1,n10)
      endif
      printf &quot;%s\n&quot;,strprn
      j++
      if n10&lt;77
        break
      endif
    endloop
  endif
endif
</code>
</gretl-function>
<gretl-function name="cutstrstr" type="string" private="1">
 <params count="2">
  <param name="s1" type="string">
<description>big</description>
  </param>
  <param name="s2" type="string">
<description>small</description>
  </param>
 </params>
<code>xx = strstr(s1,s2)
nxx = strlen(xx)
n = strlen(s2)
if nxx&lt;(n+1)
  string ret = &quot;&quot;
else
  string ret = substr(xx,n+1,nxx)
endif
return ret
</code>
</gretl-function>
<gretl-function name="str_setdiff" type="string" private="1">
 <params count="2">
  <param name="bigstr" type="string"/>
  <param name="str" type="string"/>
 </params>
<code>strings strs = strsplit(str)
strings bigstrs = strsplit(bigstr)
scalar bn = nelem(bigstrs)
string ret = &quot;&quot;
scalar fi
loop i = 1..bn -q
  fi = findind(bigstrs[i],str)
  if fi == 0
    ret = ret~&quot; &quot;~bigstrs[i]
  endif
endloop
ret = strstrip(ret)
return ret
</code>
</gretl-function>
<gretl-function name="substvals2" type="matrix" private="1">
 <params count="5">
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
 </params>
<code>dnam = discrnams2(nam,factlevs)
strings dnams = strsplit(dnam)
nf = nelem(dnams)
nv = nelem(allval)
matrix indi = zeros(1,nf)
loop i=1..nf -q
  indi[i]=findind(dnams[i],allnam)
endloop
bign = nelem(strsplit(alllevs))
matrix Z = I(nf)
matrix z ={}
if nf == bign
  matrix ret = zeros(nf,nv)
  loop i=1..nf -q
    z = allval
    z[indi] = Z[i,]
    ret[i,] = z
  endloop
else
  matrix ret = zeros(nf+1,nv)
  Z = zeros(1,nf)|Z
  loop i=1..(nf+1) -q
    z = allval
    z[indi] = Z[i,]
    ret[i,] = z
  endloop
endif
return ret
</code>
</gretl-function>
<gretl-function name="isnat" type="scalar" private="1">
 <params count="1">
  <param name="str" type="string"/>
 </params>
<code>ret = 0
n = strlen(str)
if n &gt; 0
  matrix ret0 = zeros(1,n)
  loop i=1..n -q
    stri = substr(str,i,i)
    isdi = isdigit (stri)
    if i==1
      isdi=isdi&amp;&amp;(stri!=&quot;0&quot;)
    endif
    ret0[i] = isdi
  endloop
  ret = (sum(ret0)==n)
endif
return ret
</code>
</gretl-function>
<gretl-function name="isduname" type="scalar" private="1">
 <params count="1">
  <param name="name" type="string"/>
 </params>
<code>ret = 0
ck1 = substr(name,1,1)==&quot;D&quot;
if ck1
  nn = strlen(name)
  name2 = substr(name,2,nn)
  ret = isdiname(name)
endif
return ret
</code>
</gretl-function>
<gretl-function name="mk_wrt" type="string" private="1">
 <params count="1">
  <param name="nam" type="string"/>
 </params>
<code>poseq = posstrstr(nam,&quot;=&quot;)
nposeq = nelem(poseq)
ret=&quot;&quot;
if nposeq &gt; 1
  nams = strsplit3(nam,&quot;;&quot;)
  loop i=1..nposeq -q
    namss = strsplit3(nams[i],&quot;=&quot;)
    namss1 = strstrip(namss[1])
    if namss1 == &quot;wrt&quot;
      ret = strstrip(namss[2])
    endif
  endloop
endif
if nposeq == 1
  nams = strsplit3(nam,&quot;=&quot;)
  ck = strstrip(nams[1]) == &quot;wrt&quot;
  if ck
    ret = strstrip(nams[2])
  endif
endif
return ret
</code>
</gretl-function>
<gretl-function name="cut_names" type="strings" private="1">
 <params count="1">
  <param name="strs" type="strings"/>
 </params>
<code>n = nelem(strs)
counter = 1
loop i=1..n -q
  strsi = strs[i]
  if strlen(strsi) &gt; 9
    one = substr(strsi,1,3)
    snumber = sprintf(&quot;%d&quot;, i)
    sle = strlen(snumber)
    zrs = repchar(&quot;0&quot;,6-sle)
    two = zrs~snumber
    strs[i] = one~two
  endif
endloop
return strs
</code>
</gretl-function>
<gretl-function name="tb_dum_grads" type="matrix" private="1">
 <params count="8">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
 </params>
<code>if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
smallb = b
b = b|s__
nams = strsplit(nam)
nn = nelem(nams)
nb = nelem(b)
nns = nn
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
loop i=1..nns -q
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
endif
matrix xbackup = x
funs2 = strsplit(fun2)
nf = nelem(funs2)
matrix ret222 = zeros(1,nf)
nnxx = nelem(x)
matrix ret = zeros(nn,nb+1)
loop j = 1..nnxx -q
  x[j] = 0
  matrix grads = zeros(2,nf)
  loop i=1..nf -q
    string fun3 = funs2[i]
    grads[1,i] = @fun3
  endloop
  x[j] = 1
  loop i=1..nf -q
    string fun3 = funs2[i]
    grads[2,i] = @fun3
  endloop
  if nb &gt; nf
    grads = ones(2,1)~grads
  endif
  matrix xbs = grads*smallb
  cnorm1 = cnorm((lo__-(xbs))/s__)
  cnorm2 = cnorm(-(hi__-(xbs))/s__)
  cnorm3 = cnorm((hi__-(xbs))/s__)
  dnorm1 = dnorm((lo__-(xbs))/s__)
  dnorm2 = dnorm((hi__-(xbs))/s__)
  ddd2 = lo__*cnorm1+hi__*cnorm2 +(cnorm3-cnorm1).*((xbs) + s__*(dnorm1-dnorm2)./ (cnorm3-cnorm1))
  ret000 = ddd2[2] - ddd2[1]
  fxbs = cnorm3-cnorm1
  gxbs = dnorm2-dnorm1
  dgxbs = gxbs[1] - gxbs[2]
  matrix retj = ret000 ~ (fxbs[2]*grads[2,] - fxbs[1]*grads[1,]) ~ dgxbs
  x = xbackup
  ret[j,] = retj
endloop
return ret
</code>
</gretl-function>
<gretl-function name="findinds" type="matrix" private="1">
 <params count="2">
  <param name="str" type="string"/>
  <param name="bigstr" type="string"/>
 </params>
<code>strs = strsplit(str)
n = nelem(strs)
matrix ret = zeros(1,n)
loop i=1..n -q
  ret[i]=findind(strs[i],bigstr)
endloop
return ret
</code>
</gretl-function>
<gretl-function name="getatdidvals" type="matrix" private="1">
 <params count="2">
  <param name="levs" type="string"/>
  <param name="lev" type="scalar"/>
 </params>
<code>strlev = sprintf(&quot;%d&quot;,lev)
n = nelem(strsplit(levs))
ind = findind(strlev,levs)
matrix ret = zeros(1,n)
if (ind&gt;0)&amp;&amp;(ind&lt;=n)
  ret[ind]=1
endif
return ret
</code>
</gretl-function>
<gretl-function name="check_sq" type="string" private="1">
 <params count="3">
  <param name="str1" type="string"/>
  <param name="str2" type="string"/>
  <param name="othernames" type="string" optional="true"/>
 </params>
<code>ch1=(substr(str1,1,3)==&quot;sq_&quot;)
ch2 = exists(othernames)
ret = 0
if (ch1 &gt; 0)&amp;&amp;(ch2 &gt; 0)
  tt2 = str_setinrersect(str2,othernames)
  tt2s = strsplit(tt2)
  ttn = nelem(tt2s)
  if ttn==1
    tt21 = tt2s[1]
    ntt21 = strlen(tt21)
    if ntt21 &gt; 0
      ret = 1
    endif
  endif
endif
if ret == 0
  sret = &quot;_empty&quot;
else
  sret = tt21~&quot;^2&quot;
endif
return sret
</code>
</gretl-function>
<gretl-function name="parse_fla" type="string" private="1">
 <params count="1">
  <param name="fla" type="string"/>
 </params>
<code>fla0 = fla
vari = uniqvarlist(fla)
varis = strsplit(vari)
nvari = nelem(varis)
conti = &quot;&quot;
dii = &quot;&quot;
loop i=1..nvari -q
  vari = varis[i]
  isduvi = isduname(vari)
  if isduvi
    fla0 = smartstrsub(fla0,vari,corr_duname(vari))
  endif
endloop
return fla0
</code>
</gretl-function>
<gretl-function name="islogical" type="scalar" private="1">
 <params count="1">
  <param name="str" type="string"/>
 </params>
<code>ops = &quot;&gt; &lt; &gt;= &lt;= | || &amp; &amp;&amp; = ==  % !=&quot;
opss = strsplit(ops)
posi = zeros(nelem(opss),1)
loop i=1..nelem(opss) -q
  posi[i]=isstrstr(str,opss[i])
endloop
return sum(posi)&gt;0
</code>
</gretl-function>
<gretl-function name="t_discr_grads2" type="matrix" private="1">
 <params count="10">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar" default="1"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
 </params>
<code>matrix Z = substvals2(allnam,allval,nam,factlevs,alllevs )
rz = rows(Z)
nb = nelem(b)
smallb = b
b = b|s__
if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
string NAM = &quot;&quot;
strings  factlevss = strsplit(factlevs)
nns = nelem(factlevss)
strings nams = array(nns)
matrix indi = zeros(nns,1)
string fun2 = mfun
loop i = 1.. nns -q
  nams[i] = nam~&quot;_&quot;~factlevss[i]
  indi[i] = findind(nams[i],allnam)
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
NAM = strjoin(nams)
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
matrix z = {}
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,NAM)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
matrix xbackup = x
funs2 = strsplit(fun2)
nf = nelem(funs2)
matrix ret222 = zeros(1,nf)
nnxx = nelem(x)
matrix ret = zeros(rz,nb+2)
loop j = 1..rz -q
  x = Z[j,indi]
  matrix grads = zeros(1,nf)
  loop i=1..nf -q
    string fun3 = funs2[i]
    grads[i] = @fun3
  endloop
  if nb &gt; nf
    grads = 1~grads
  endif
  matrix xbs = grads*smallb
  cnorm1 = cnorm((lo__-(xbs))/s__)
  cnorm2 = cnorm(-(hi__-(xbs))/s__)
  cnorm3 = cnorm((hi__-(xbs))/s__)
  dnorm1 = dnorm((lo__-(xbs))/s__)
  dnorm2 = dnorm((hi__-(xbs))/s__)
  ret000 = lo__*cnorm1+hi__*cnorm2 +(cnorm3-cnorm1).*((xbs) + s__*(dnorm1-dnorm2)./ (cnorm3-cnorm1))
  fxbs = cnorm3-cnorm1
  gxbs = dnorm1-dnorm2
  matrix retj = ret000 ~ (fxbs*grads) ~ gxbs
  #x = xbackup
  ret[j,] = retj
endloop
return ret[2:,] .- ret[1,]
</code>
</gretl-function>
<gretl-function name="ml_cont_grads" type="matrix" private="1">
 <params count="7">
  <param name="b" type="matrix"/>
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="nalts" type="int"/>
  <param name="ismucst" type="int"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
string fun2 = fun
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
string fun223 = &quot;{&quot;~strsub(fun2,&quot; &quot;,&quot;,&quot;)~&quot;}&quot;
matrix svals = @fun223
if nns &lt; bign
  matrix grads0 = fdjac(x,for_djac(x,fun223,z))'
  if ismucst
    matrix grads0 = zeros(nns,1)~ grads0
  endif
  matrix zzz = ml_cont_grads56 ( b,nalts,&amp;svals,&amp;grads0,ismucst)
  matrix uuu = fdjac(b,ml_cont_grads56( b,nalts,&amp;svals,&amp;grads0,ismucst))
else
  matrix grads0 = fdjac(x,for_djac(x,fun223))'
  if ismucst
    matrix grads0 = zeros(nns,1)~ grads0
  endif
  matrix zzz = ml_cont_grads56 ( b,nalts,&amp;svals,&amp;grads0,ismucst)
  matrix uuu = fdjac(b,ml_cont_grads56( b,nalts,&amp;svals,&amp;grads0,ismucst))
endif
return zzz~uuu
</code>
</gretl-function>
<gretl-function name="ml_discr_grads2" type="matrix" private="1">
 <params count="9">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
  <param name="b" type="matrix"/>
  <param name="nalts" type="int"/>
  <param name="ismucst" type="int"/>
 </params>
<code>matrix b = vec(b)
matrix Z = substvals2(allnam,allval,nam,factlevs,alllevs )
rz = rows(Z)
nb = nelem(b)
strings  factlevss = strsplit(factlevs)
nns = nelem(factlevss)
strings nams = array(nns)
matrix indi = zeros(nns,1)
string NUM = &quot;&quot;
loop i = 1.. nns -q
  nams[i] = nam~&quot;_&quot;~factlevss[i]
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = mfun
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
NAM = strjoin(nams)
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,NAM)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
string prefun2s = &quot;(&quot;~strsub(fun2,&quot; &quot;,&quot;) (&quot;)~&quot;)&quot;
string fun23 = &quot;{&quot;~strsub(prefun2s,&quot; &quot;,&quot;,&quot;)~&quot;}&quot;
matrix svals
matrix ret0 = zeros(rz,nalts)
matrix ret20 = zeros(rz,nb*nalts)
matrix seqnal = seq(1,nalts)
loop j=1..rz -q
  x = Z[j,indi]
  svals = @fun23
  ret0[j,] =  mc_p17(b,svals,nalts,ismucst)
  matrix dpij1 = fdjac(b, mc_p17(b,svals,nalts,ismucst))
  ret20[j,] = vec(dpij1')'
endloop
ret0 = vec(ret0[2:,] .- ret0[1,])
ret20 = ret20[2:,] .- ret20[1,]
matrix ret30 = zeros((rz-1)*nalts,nb)
matrix newseqi = seq(1,rz-1)
matrix seqb = seq(1,nb)
loop i = 1..nalts -q
  ret30[(i-1)*(rz-1)+newseqi,] = ret20[,(i-1)*nb+seqb]
endloop
return ret0 ~ ret30
</code>
</gretl-function>
<gretl-function name="isstrstr" type="scalar" private="1">
 <params count="2">
  <param name="s1" type="string">
<description>big</description>
  </param>
  <param name="s2" type="string">
<description>small</description>
  </param>
 </params>
<code>xx = strstr(s1,s2)
nxx = strlen(xx)
ret = (nxx&gt;0)
return ret
</code>
</gretl-function>
<gretl-function name="posstrstr" type="matrix" private="1">
 <params count="2">
  <param name="s1" type="string">
<description>big</description>
  </param>
  <param name="s2" type="string">
<description>small</description>
  </param>
 </params>
<code>xx = cutstrstr(s1,s2)
nxx = strlen(xx)
ww = isstrstr(s1,s2)
if nxx + ww == 0
  ret = {0}
else
  ret = {strlen(s1)-strlen(strstr(s1,s2))+1}
  xx = s1
  loop while nxx&gt;0 -q
    xx = cutstrstr(xx,s2)
    nxx = strlen(xx)
    if nxx&gt;0&amp;&amp;isstrstr(xx,s2)
      ret = ret~(strlen(s1)-strlen(strstr(xx,s2))+1)
    endif
  endloop
endif
return ret
</code>
</gretl-function>
<gretl-function name="repchar" type="string" private="1">
 <params count="2">
  <param name="char" type="string"/>
  <param name="n" type="int"/>
 </params>
<code>ret = &quot;&quot;
loop i=1..n -q
  ret=ret~char
endloop
return ret
</code>
</gretl-function>
<gretl-function name="strsplit2" type="strings" private="1">
 <params count="2">
  <param name="str" type="string"/>
  <param name="sep" type="string" optional="true"/>
 </params>
<code>scalar isn = !exists(sep)
if isn||sep == &quot; &quot;
  ret = strsplit(str)
else
  string str2 = strsub(str,&quot; &quot;,&quot;&quot;)
  str2 = strsub(str2,sep,&quot; &quot;)
  ret = strsplit(str2)
endif
return ret
</code>
</gretl-function>
<gretl-function name="mk_factlevs2" type="string" private="1">
 <params count="3">
  <param name="formula" type="string"/>
  <param name="name" type="string"/>
  <param name="unil" type="string"/>
 </params>
<code>unils = strsplit(unil)
n = nelem(unils)
nm = name~&quot;_&quot;
matrix ret = {}
loop i=1..n -q
  isi = isstrstr(unils[i],nm)
  if isi
    str2 = strsub(unils[i],&quot;_&quot;,&quot; &quot;)
    nmsi = strsplit(str2)
    nmi = nmsi[2]
    ret = ret~atof(nmi)
  endif
endloop
ret = sort(ret)
n2 = nelem(ret)
ret2 = &quot;&quot;
loop i=1..n2 -q
  reti = sprintf(&quot;%d&quot;,ret[i])
  ret2 = ret2~&quot; &quot;~reti
endloop
ret2 = strstrip(ret2)
return ret2
</code>
</gretl-function>
<gretl-function name="str_setinrersect" type="string" private="1">
 <params count="2">
  <param name="str1" type="string"/>
  <param name="str2" type="string"/>
 </params>
<code>matrix inds = findinds(str1,str2)
str1s = strsplit(str1)
n = nelem(str1s)
ret = &quot;&quot;
loop i=1..n -q
  if  inds[i]
    ret = ret~&quot; &quot;~str1s[i]
  endif
endloop
ret = strstrip(ret)
return ret
</code>
</gretl-function>
<gretl-function name="doret2" type="string" private="1">
 <params count="4">
  <param name="str" type="string"/>
  <param name="str20" type="string"/>
  <param name="dinames" type="string" optional="true"/>
  <param name="othernames" type="string" optional="true"/>
 </params>
<code>if !exists(dinames)&amp;&amp;!exists(othernames)
  funcerr &quot;no names given&quot;
endif
iseq = (substr(str,1,1)==&quot;=&quot;)
n = strlen(str)
if iseq
  ret3 = &quot;_empty&quot;
  sqr = check_sq (str20,str,othernames)
  if sqr != &quot;_empty&quot;
    ret3 = sqr
  else
    logo = check_log (str20,str,othernames)
    if logo != &quot;_empty&quot;
      ret3 = logo
    else
      times1 = check_times (str20,str,othernames)
      if times1 != &quot;_empty&quot;
        ret3 = times1
      endif
    endif
  endif
  if ret3==&quot;_empty&quot;
    funcerr &quot;incomplete indep. vars. list&quot;
  endif
else
  intera =  substr(str,1,15) == &quot;interaction of &quot;
  if intera
    isdi = !exists(dinames)
    if isdi
      tei1 = &quot;interactions in description &quot;
      tei2 = &quot;but no discrete variables&quot;
      emsg = tei1~tei2
      funcerr emsg
    endif
    ret33 = substr(str,16,n)
    ret33s = strstr(ret33,&quot; and &quot;)
    n33 = strlen(ret33)
    n33s = strlen(ret33s)
    ret3a = substr(ret33,1,n33-n33s)
    ret3b = substr(ret33s,7,n33s-1)
    ret3bs = strsplit2(ret3b,&quot;==&quot;)
    ret3c = strjoin(ret3bs,&quot;_&quot;)
    isund = isstrstr(ret3a,&quot;_&quot;)
    if isund
      sret3a = strsplit2(ret3a,&quot;_&quot;)
      sret3a1 = sret3a[1]
      isD = substr(sret3a1,1,1)==&quot;D&quot;
      ret3d = ret3a
      if isD
        n3a1 = strlen(sret3a1)
        sret3a2 = substr(sret3a1,2,n3a1)
        iind = findind(sret3a2,dinames)
        if iind
          n3a = strlen(ret3a)
          ret3d = substr(ret3a,2,n3a)
        endif
      endif
    else
      ret3d = ret3a
    endif
    ret3 = ret3d~&quot;*&quot;~ret3c
  else
    isnotdi = !exists(dinames)
    isdu = &quot;_empty&quot;
    if (!isnotdi)
      isdu =  check_dum(str20,str,dinames)
    endif
    if !(isdu==&quot;_empty&quot;)
      ret3 = isdu
    else
      ret3=str
      isspace = isstrstr(str,&quot; &quot;)
      if isspace
        txt1 = str
        txt2 = &quot;'&quot;~str~&quot;' looks like a description,&quot;
        txt2 = txt2~&quot;it is not a variable name or formula&quot;
        funcerr txt2
      endif
      str2 = uniqvarlist(str)
      isnuoth = !exists(othernames)
      if isnuoth
        othernames = &quot;&quot;
      endif
      fis = findinds(str2,othernames)
      nfis = nelem(fis)
      str2s = strsplit(str2)
      loop i= 1..nfis -q
        ck50 = (fis[i]==0)
        if ck50
          txt60 = &quot;Warning: '&quot;~str2s[i]
          txt62 = &quot;' is not in the list of independent variables&quot;
          txt63 = txt60~txt62
          printf &quot;\n%s\n&quot;,txt63
        endif
      endloop
    endif
  endif
endif
return ret3
</code>
</gretl-function>
<gretl-function name="getdiname" type="string" private="1">
 <params count="1">
  <param name="name" type="string"/>
 </params>
<code>ret = &quot;&quot;
str = name
if isduname(name)
  str = corr_duname(name)
endif
bign = strlen(str)
matrix mapo = posstrstr(str,&quot;_&quot;)
ck2 = mapo!=0
ck3 = 0
if (ck2&gt;0)
  nma = nelem(mapo)
  lapo = mapo[nma]
  level = substr(str,lapo+1,bign)
  ck3 = isnat(level)
  if ck3&gt;0
    ret = substr(str,1,lapo-1)
  endif
endif
return ret
</code>
</gretl-function>
<gretl-function name="corr_d_n_cb2" type="strings" private="1">
 <params count="4">
  <param name="name1" type="string"/>
  <param name="name2" type="string"/>
  <param name="name3" type="string"/>
  <param name="des" type="string"/>
 </params>
<code>uni = uniqvarlist(des)
unis = strsplit(uni)
n = nelem(unis)
if n == 1
  retname = &quot;cb_&quot;~name1
  retdes = uni~&quot;^3&quot;
elif n == 2
  des2s = strsplit3(des,&quot;*&quot;)
  des2= strjoin(des2s)
  matrix fi1 = findind3(unis[1],des2)
  matrix fi2 = findind3(unis[2],des2)
  matrix ma = {nelem(fi1),nelem(fi2)}
  ima = imaxr(ma)
  imi = iminr(ma)
  retdes = unis[ima]~&quot;^2*&quot;~unis[imi]
  smallnames = name1~&quot; &quot;~name2~&quot; &quot;~name3
  matrix fi1 = findind3(name1,smallnames)
  matrix fi2 = findind3(name2,smallnames)
  matrix fi3 = findind3(name3,smallnames)
  matrix ma2 = {nelem(fi1),nelem(fi2),nelem(fi3)}
  ima2 = imaxr(ma2)
  imi2 = iminr(ma2)
  smallnamess = strsplit(smallnames)
  retname = &quot;sq_&quot;~smallnamess[ima2]~&quot;_&quot;~smallnamess[imi2]
else
  retname = name1~&quot;_&quot;~name2~&quot;_&quot;~name3
  retdes = des
endif
strings S = array(2)
S[1]= retname
S[2] = retdes
return S
</code>
</gretl-function>
<gretl-function name="isdigit" type="scalar" private="1">
 <params count="1">
  <param name="s" type="string"/>
 </params>
<code>n = strlen(s)
if n != 1
  ret = 0
else
  string lts = &quot;0123456789&quot;
  ret = isstrstr(lts,s)
endif
return ret
</code>
</gretl-function>
<gretl-function name="mexclude" type="matrix" private="1">
 <params count="2">
  <param name="x" type="matrix"/>
  <param name="inds" type="matrix"/>
 </params>
<code>nx = nelem(x)
cx = cols(x)
rx = rows(x)
mrc = xmin(cx,rx)
if mrc &gt; 1
  funcerr &quot;'x' should be a column or row vector&quot;
endif
ninds = nelem(inds)
if ninds &gt; nx
  funcerr &quot;you can't exclude more elements than the length of vector&quot;
endif
inds = vec(inds)
mi = minc(inds)
mai = maxc(inds)
if (mi &lt; 1)||(mai &gt; nx)
  funcerr &quot;subscript(s) is(are) out of range&quot;
endif
if ninds == nx
  matrix ret = {}
else
  matrix eind = indclude(nx,inds)
  matrix ret = x[eind]
endif
return ret
</code>
</gretl-function>
<gretl-function name="discrnams2" type="string" private="1">
 <params count="2">
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
 </params>
<code>levss = strsplit(factlevs)
n = nelem(levss)
ret = &quot;&quot;
loop i=1..n -q
  reti = nam~&quot;_&quot;~levss[i]
  ret = ret~&quot; &quot;~reti
endloop
ret = strstrip(ret)
return ret
</code>
</gretl-function>
<gretl-function name="check_times" type="string" private="1">
 <params count="3">
  <param name="str1" type="string"/>
  <param name="str2" type="string"/>
  <param name="othernames" type="string" optional="true"/>
 </params>
<code>ch2 = exists(othernames)
ret = 0
if (ch2 &gt; 0)
  tt2 = str_setinrersect(str2,othernames)
  tt2s = strsplit(tt2)
  ttn = nelem(tt2s)
  if ttn==2
    tt21 = tt2s[1]
    ntt21 = strlen(tt21)
    tt22 = tt2s[2]
    ntt22 = strlen(tt22)
    if (ntt21 &gt; 0)&amp;&amp; (ntt22 &gt; 0)
      ret = 1
    endif
  endif
endif
if ret == 0
  sret = &quot;_empty&quot;
else
  sret = tt21~&quot;*&quot;~tt22
endif
return sret
</code>
</gretl-function>
<gretl-function name="isdiname" type="scalar" private="1">
 <params count="1">
  <param name="str" type="string"/>
 </params>
<code>ns = strlen(str)
posi = posstrstr(str,&quot;_&quot;)
nposi = nelem(posi)
ck1 = (posi[1]!=0)
ret = 0
if ck1
  lp = posi[nposi]
  if lp &lt; ns
    ckck = substr(str,lp+1,ns)
    ret = isnat(ckck)
  endif
endif
if nposi&gt;=2
  ck3 = posi[nposi]-posi[nposi-1]
  if ck3&lt;2
    ret=0
  endif
endif
return ret
</code>
</gretl-function>
<gretl-function name="catch_times" type="scalar" private="1">
 <params count="2">
  <param name="vvv" type="string"/>
  <param name="uuu" type="string"/>
 </params>
<code>matrix posi = posstrstr(vvv,&quot;_&quot;)
np = nelem(posi)
if posi[1]==0
  ret = 0
else
  nvvv = strlen(vvv)
  matrix indii = {}
  loop i=1..np -q
    part1 = substr(vvv,1,posi[i]-1)
    part2 = substr(vvv,posi[i]+1,nvvv)
    wordi = part1~&quot; &quot;~part2
    findis = findinds(wordi,uuu)
    timis = sum(findis .&gt;0)==2
    if timis==1
      indii = indii~posi[i]
    endif
  endloop
  if (nelem(indii)==1)&amp;&amp;(indii[1]&gt;0)
    ret = indii[1]
  else
    ret = 0
  endif
endif
return ret
</code>
</gretl-function>
<gretl-function name="corr_d_n_sq" type="strings" private="1">
 <params count="2">
  <param name="name" type="string"/>
  <param name="des" type="string"/>
 </params>
<code>uni = uniqvarlist(des)
unis = strsplit(uni)
n = nelem(unis)
retname = name
retdes = des
if n == 1
  strn = strlen(name)
  smalln = floor(strn/2)
  smallname = substr(name,1,smalln)
  retname = &quot;sq_&quot;~smallname
  retdes = uni~&quot;^2&quot;
endif
strings S = array(2)
S[1]= retname
S[2] = retdes
return S
</code>
</gretl-function>
<gretl-function name="intquote" type="string" private="1">
 <params count="1">
  <param name="n" type="int"/>
 </params>
<code>sprintf ret &quot;%d&quot;,n
return ret
</code>
</gretl-function>
<gretl-function name="findind" type="scalar" private="1">
 <params count="2">
  <param name="smallstr" type="string"/>
  <param name="bigstr" type="string"/>
 </params>
<code>strs = strsplit(bigstr)
n = nelem(strs)
scalar ret = 0
loop i=1..n -q
  if smallstr==strs[i]
    ret = i
    break
  endif
endloop
return ret
#     function scalar findind (string smallstr,
#                          string bigstr,
#                          string sep[null])
#     if !exists(sep)
#         sep = &quot; &quot;
#     endif
#     strs = strsplit2(bigstr,sep)
#     n = nelem(strs)
#     matrix ret = {}
#     loop i=1..n -q
#         if smallstr==strs[i]
#             ret = ret~i
#         endif
#     endloop
#     nret = nelem(ret)
#     if nret == 0
#         ret = 0
#     endif
#     if nret &gt; 1
#         funcerr &quot;duplicated names&quot;
#     endif
#     scalar retu = ret[1,1]
#     return retu
</code>
</gretl-function>
<gretl-function name="defvals" type="bundle" private="1">
 <params count="3">
  <param name="formula" type="string" optional="true"/>
  <param name="clist" type="list" optional="true"/>
  <param name="dilist" type="list" optional="true"/>
 </params>
<code>#funcerr &quot;just stopped&quot;
ret1 = &quot;&quot;
mret1 = {}
dret1 = &quot;&quot;
mdret1 = {}
n1 = nelem(clist)
if n1&gt;0
  cvns = varnames(clist)
  loop i=1..n1 -q
    isdui = isdummy(clist[i])
    if isdui
      dret1 = dret1~cvns[i]~&quot; &quot;
      mdret1 = mdret1~mean(clist[i])
    else
      ret1 = ret1~cvns[i]~&quot; &quot;
      mret1 = mret1~mean(clist[i])
    endif
  endloop
  dret1 = strstrip(dret1)
  if dret1==&quot;&quot;
    dret1a=&quot;_empty&quot;
  endif
  ret1 = strstrip(ret1)
  if ret1==&quot;&quot;
    ret1a=&quot;_empty&quot;
  endif
endif
if dret1==&quot;&quot;
  dret1a=&quot;_empty&quot;
else
  dret1a=dret1
endif
if ret1==&quot;&quot;
  ret1a=&quot;_empty&quot;
else
  ret1a=ret1
endif
n2 = nelem(dilist)
ret2 = &quot;&quot;
mret2 = {}
if n2&gt;0
  uli = uniqvarlist(formula)
  divns = varnames(dilist)
  matrix vali = {}
  loop i=1..n2 -q
    levi = mk_factlevs2 (formula, divns[i],uli)
    dini = discrnams2(divns[i],levi)
    vali = getdidvals(levi,dilist[i])
    ret2 = ret2~&quot; &quot;~dini
    mret2 = mret2~vali
  endloop
  ret2 = strstrip(ret2)
endif
if ret2==&quot;&quot;
  ret2a=&quot;_empty&quot;
else
  ret2a=strjoin(varnames(dilist))
endif
nam1 = ret1~&quot; &quot;~dret1
nam1 = strstrip(nam1)
matrix mat1 = mret1~mdret1
anams = strstrip(nam1~&quot; &quot;~ret2)
matrix avals = mat1~mret2
bundle bu
bu[&quot;contvars&quot;]=ret1a
bu[&quot;dumvars&quot;]=dret1a
bu[&quot;divars&quot;]=ret2a
bu[&quot;allnames&quot;]=anams
matrix bu[&quot;allvalues&quot;]=avals
return bu
</code>
</gretl-function>
<gretl-function name="mk_namlevi" type="string" private="1">
 <params count="2">
  <param name="nam" type="string"/>
  <param name="levs" type="string"/>
 </params>
<code>levss = strsplit(levs)
ns = nelem(levss)
txt = &quot;&quot;
loop i=1..ns -q
  txt = txt~&quot; &quot;~nam~&quot;_&quot;~levss[i]
endloop
txt = strstrip(txt)
return txt
</code>
</gretl-function>
<gretl-function name="isfla" type="scalar" private="1">
 <params count="1">
  <param name="des" type="string"/>
 </params>
<code>matrix posleft = posstrstr(des,&quot;(&quot;)
matrix posright = posstrstr(des,&quot;)&quot;)
ckp1 = nelem(posleft)==nelem(posright)
if (posleft[1]==1)||(posright[nelem(posright)]==nelem(posright))
  ckp1 = 0
endif
ckp2 = 0
if ckp1&gt;0
  ma = posright - posleft
  mima = minr(ma)
  if mima&gt;=0
    ckp2 = 1
  endif
endif
ck3 = 0
if ckp2&gt;0
  uni = uniqvarlist(des)
  ck3 = uni!=des
  des2 = strsub(des,&quot;(&quot;,&quot; &quot;)
  des2 = strsub(des2,&quot;)&quot;,&quot; &quot;)
  uni2 = uniqvarlist(des2)
  funs = str_setdiff(uni2,uni)
  if (strlen(funs)==0)&amp;&amp;isop(des)==0
    ck3 = 0
  endif
endif
if islogical(des)
  ck3 = 0
endif
return ck3
</code>
</gretl-function>
<gretl-function name="chek_intname" type="scalar" private="1">
 <params count="1">
  <param name="name" type="string"/>
 </params>
<code>ret = 0
posi = posstrstr(name,&quot;_&quot;)
nposi = nelem(posi)
#print nposi
bign = strlen(name)
if nposi&gt;1
  loop i=1..nposi -q
    str1 = substr(name,1,posi[i]-1)
    str2 = substr(name,posi[i]+1,bign)
    ck11 = isduname(str1)
    ck12 = isdiname(str1)
    ck21 = isduname(str2)
    ck22 = isdiname(str2)
    #print i ck11 ck12 ck21 ck22
    if (ck11+ck12+ck21+ck22)&gt;0
      ret = 1
    endif
  endloop
endif
return ret
</code>
</gretl-function>
<gretl-function name="uniqvarlist" type="string" private="1">
 <params count="1">
  <param name="fla" type="string"/>
 </params>
<code>fla2 = &quot;#&quot;~fla~&quot;#&quot;
chars = &quot;qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM&quot;
digits = &quot;0123456789&quot;
lefla = strlen(fla2)
matrix charmap = zeros(lefla,1)
matrix digmap = charmap
matrix bramap = charmap
matrix undmap = charmap
loop i = 1..lefla -q
  chari = substr(fla2,i,i)
  if strlen(strstr(chars,chari))
    charmap[i] =  1
  endif
  if strlen(strstr(digits,chari))
    digmap[i] =  1
  endif
  if chari == &quot;_&quot;
    undmap[i] = 1
  endif
  if (chari == &quot;(&quot;)||(chari == &quot;[&quot;)
    bramap[i] = 1
  endif
endloop
all_charmap = charmap + digmap + undmap
matrix seql = seq(0,lefla-1)'
matrix begins = seql .*(diff(all_charmap).&gt; 0)
matrix ends = seql.*mlag((diff(all_charmap).&lt; 0),-1)
if  sumc(uniq(begins))
  matrix numbegins = uniq(begins)[2:]
  matrix numends = uniq(ends)[2:]
  smalln = nelem(numends)
  ret = &quot;&quot;
  strings rets
  loop i =1..smalln -q
    summ = 0
    reti = substr(fla,numbegins[i],numends[i])
    nofun = substr(fla,numends[i]+1,numends[i]+1)!=&quot;(&quot;
    if nofun
      if i==1
        rets +=reti
        ret = ret~&quot; &quot;~reti
      else
        nrets = nelem(rets)
        summ = 0
        loop j=1..nrets -q
          summ += reti == rets[j]
        endloop
        if !(digmap[numbegins[i]+1]+bramap[numends[i]+2]+summ)
          rets +=reti
          ret = ret~&quot; &quot;~reti
        endif
      endif
    endif
  endloop
  return strstrip(ret)
else
  return &quot;_empty&quot;
endif
</code>
</gretl-function>
<gretl-function name="myx" type="scalar" private="1">
 <params count="1">
  <param name="x" type="scalar"/>
 </params>
<code>return x
</code>
</gretl-function>
<gretl-function name="check_dum" type="string" private="1">
 <params count="3">
  <param name="str1" type="string"/>
  <param name="str2" type="string"/>
  <param name="dinames" type="string" optional="true"/>
 </params>
<code>ret = &quot;_empty&quot;
str1s = strsplit3(str1,&quot;_&quot;)
n1 = nelem(str1s)
ck11 = n1 &gt; 1
ck12 = 0
ck13 = 0
if ck11
  str1s1 = str1s[1]
  str1s2 = str1s[n1]
  ck12 = isnat(str1s2)
  ck13 = (substr(str1s1,1,1) == &quot;D&quot;)
endif
ck21 = 0
ck22 = 0
ck23 = 0
ck24 = 0
if ck11&amp;&amp;ck12&amp;&amp;ck13
  str2s = strsplit(str2)
  n2 = nelem(str2s)
  ck21 = n2 &gt; 3
  if ck21
    strx = str2s[n2-2]
    ck22 = findind(strx,dinames) &gt; 0
    stry = str2s[n2-1]
    ck23 = (stry == &quot;=&quot;)
    strz = str2s[n2]
    ck24 = isnat(strz)
    if ck22&amp;&amp;ck23&amp;&amp;ck24
      ret = strx~&quot;_&quot;~strz
    endif
  endif
endif
return ret
</code>
</gretl-function>
<gretl-function name="corr_duname" type="string" private="1">
 <params count="1">
  <param name="name" type="string"/>
 </params>
<code>ret = name
if isduname(name)
  bign = strlen(name)
  ret = substr(ret,2,bign)
endif
return ret
</code>
</gretl-function>
<gretl-function name="mk_at" type="string" private="1">
 <params count="1">
  <param name="nam" type="string"/>
 </params>
<code>poseq = posstrstr(nam,&quot;=&quot;)
nposeq = nelem(poseq)
ret=&quot;&quot;
if nposeq &gt; 1
  nams = strsplit3(nam,&quot;;&quot;)
  loop i=1..nposeq -q
    namss = strsplit3(nams[i],&quot;=&quot;)
    namss1 = strstrip(namss[1])
    if namss1 == &quot;at&quot;
      ret = strstrip(namss[2])
    endif
  endloop
endif
if nposeq == 1
  #print nam
  nams = strsplit3(nam,&quot;=&quot;)
  ck = strstrip(nams[1]) == &quot;at&quot;
  if ck
    ret = strstrip(nams[2])
  endif
endif
#printf &quot;ret: &quot;
#print ret
return ret
</code>
</gretl-function>
<gretl-function name="findind3" type="matrix" private="1">
 <params count="3">
  <param name="smallstr" type="string"/>
  <param name="bigstr" type="string"/>
  <param name="sep" type="string" optional="true"/>
 </params>
<code>if !exists(sep)
  sep = &quot; &quot;
endif
strs = strsplit3(bigstr,sep)
n = nelem(strs)
matrix ret = {}
loop i=1..n -q
  if smallstr==strs[i]
    ret = ret~i
  endif
endloop
#nret = nelem(ret)
return ret
</code>
</gretl-function>
<gretl-function name="tb_cont_grads" type="matrix" private="1">
 <params count="8">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
string fun2 = fun
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
string prefun2s = &quot;myx(&quot;~strsub(fun2,&quot; &quot;,&quot;) myx(&quot;)~&quot;)&quot;
strings fun2s = strsplit(prefun2s)
nfs = nelem(fun2s)
matrix svals = zeros(1,nfs)
matrix grads0 = zeros(nns,nfs)
loop i = 1..nfs -q
  funsi = fun2s[i]
  svals[i] = @funsi
  grads0[,i] = fdjac(x,@funsi)'
endloop
if nelem(b) &gt; nfs
  svals = 1~svals
  grads0 = zeros(nns,1)~grads0
endif
matrix dxb_dx =  grads0 * b
scalar  xb = svals*b
scalar  term1 =  (hi__-xb)/s__
scalar term2 = (lo__-xb)/s__
scalar fxb = cnorm(term1)-cnorm(term2)
scalar gxb = dnorm(term1)-dnorm(term2)
matrix ret222 = (-gxb*(dxb_dx .*svals)/s__ + fxb *grads0)~(gxb*dxb_dx*xb/s__^2)
matrix  ret000 = fxb*dxb_dx
return ret000 ~ ret222
</code>
</gretl-function>
<gretl-function name="ml_dum_grads" type="matrix" private="1">
 <params count="7">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="nalts" type="int"/>
  <param name="ismucst" type="int"/>
 </params>
<code>strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
string fun2 = fun
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
string prefun2s = &quot;(&quot;~strsub(fun2,&quot; &quot;,&quot;) (&quot;)~&quot;)&quot;
matrix svals
xbackup = x
matrix ret0 = zeros(nns,nalts)
matrix ret20 = zeros(nns*nalts,nelem(b))
matrix r20seq = nns*seq(0,nalts-1)
string fun23 = &quot;{&quot;~strsub(prefun2s,&quot; &quot;,&quot;,&quot;)~&quot;}&quot;
loop j=1..nns -q
  x[j] = 1
  svals = @fun23
  matrix pij1 = mc_p17(b,svals,nalts,ismucst)
  matrix dpij1 = fdjac(b, mc_p17(b,svals,nalts,ismucst))
  x[j] = 0
  svals = @fun23
  matrix pij0 = mc_p17(b,svals,nalts,ismucst)
  matrix dpij0 = fdjac(b, mc_p17(b,svals,nalts,ismucst))
  x = xbackup
  ret0[j,] =  pij1 - pij0
  ret20[j+r20seq,] = dpij1 - dpij0
endloop
return vec(ret0) ~ret20
</code>
</gretl-function>
<gretl-function name="strsplit3" type="strings" private="1">
 <params count="2">
  <param name="str" type="string"/>
  <param name="sep" type="string" optional="true"/>
 </params>
<code>scalar isn = !exists(sep)
if isn||sep==&quot; &quot;
  rets = strsplit(str)
else
  bign = strlen(str)
  n = strlen(sep)
  sep1 = substr(sep,1,1)
  isds1 = isdigit(sep1)
  if isds1
    str2 = repchar(&quot;a&quot;,n)~str
  else
    str2 = repchar(&quot;0&quot;,n)~str
  endif
  sepn = substr(sep,n,n)
  isdsn = isdigit(sepn)
  if isdsn
    str2 = str2~repchar(&quot;a&quot;,n)
  else
    str2 = str2~repchar(&quot;0&quot;,n)
  endif
  matrix posi = posstrstr(str2,sep)
  if posi[1] == 0
    strings rets
    rets+=str
  else
    matrix posi2 = posi .+ (n-1)
    strings rets
    np = nelem(posi)
    pos0 = n+1
    posn = n+bign
    posi0 = posi~(n+bign+1)
    posi20 = n~posi2
    loop i = 1..(np+1) -q
      minp = posi20[i]+1
      maxp = posi0[i]-1
      if minp&lt;=maxp
        rets+=substr(str2,minp,maxp)
      endif
    endloop
  endif
endif
return rets
</code>
</gretl-function>
<gretl-function name="insertc" type="matrix" private="1">
 <params count="2">
  <param name="x" type="matrix"/>
  <param name="pos" type="int" min="1" default="1"/>
 </params>
<code>rx = rows(x)
cx = cols(x)
matrix y = zeros(rx,1)
matrix ret
if pos==1
  ret = y~x
elif pos&gt;cx
  ret = x~y
else
  ret = x[,1:(pos-1)]~y~x[,pos:]
endif
return ret
</code>
</gretl-function>
<gretl-function name="mc_p17" type="matrix" private="1">
 <params count="4">
  <param name="theta" type="matrix"/>
  <param name="X" type="matrix">
<description>ind.-specific variables</description>
  </param>
  <param name="n" type="int"/>
  <param name="ismucst" type="bool" default="1"/>
 </params>
<code>if ismucst
  X = 1~X
endif
scalar k = cols(X)
matrix b0 = zeros(k,1) ~ mshape(theta[1:(k*(n-1))],k,n-1)
matrix tmp = X*b0
matrix exbadj2 = exp(tmp)
return exbadj2./sumr(exbadj2)
</code>
</gretl-function>
<gretl-function name="for_djac" type="matrix" private="1">
 <params count="3">
  <param name="x" type="matrix"/>
  <param name="fun" type="string"/>
  <param name="z" type="matrix" optional="true"/>
 </params>
<code>return @fun
</code>
</gretl-function>
<gretl-function name="didindi" type="matrix" private="1">
 <params count="2">
  <param name="didims" type="matrix"/>
  <param name="nalts" type="scalar"/>
 </params>
<code>alldim = sum(didims)
nvars = nelem(didims)
if nvars &gt; 1
  matrix cudidims = 1|(cum(didims')[1:(nvars-1)]+1)
else
  matrix cudidims = {1}
endif
matrix ret = {}
loop i = 1..nalts -q
  loop j = 1..nvars -q
    qurindj = cudidims[j] + didims[j]*(i-1)/nalts + seq(0,didims[j]/nalts-1)
    ret = ret~ qurindj
  endloop
endloop
return ret
</code>
</gretl-function>
<gretl-function name="mk_txt_range" type="string" private="1">
 <params count="1">
  <param name="n" type="int"/>
 </params>
<code>ret = &quot;1&quot;
if n &gt; 1
  loop i=2..n -q
    reti = sprintf(&quot; %d&quot;,i)
    ret = ret~reti
  endloop
endif
ret = strstrip(ret)
return ret
</code>
</gretl-function>
<gretl-function name="smart_formula200" type="string" private="1">
 <params count="5">
  <param name="x" type="list">
<description>$xlist in most cases</description>
  </param>
  <param name="indlist" type="list" optional="true">
<description>forced ind. vars</description>
  </param>
  <param name="stri" type="string"/>
  <param name="da" type="list"/>
  <param name="allvns" type="string"/>
 </params>
<code>list x = x-0
bignamss = varnames(x)
cknull = nelem(indlist)==0
if !cknull
  indnams = strjoin(varnames(indlist))
else
  indnams = &quot;&quot;
endif
string line
dili = &quot;&quot;
coli = &quot;&quot;
dilis = &quot;&quot;
colis = &quot;&quot;
string first
rets = &quot;&quot;
rets_left = &quot;&quot;
rets_right = &quot;&quot;
loop foreach i x -q
  cknull = 0
  if !cknull
    fififi = inlist(indlist,x[i])
    if fififi
      bignamsi = bignamss[i]
      rets = strstrip(rets~&quot; &quot;~bignamsi)
      colis = strstrip(colis~&quot; &quot;~bignamsi)
    else
      cknull = 1
    endif
  endif
  if cknull
    bundle bui = getinfo(x[i])
    vvv = bui.name
    uuu = bui.description
    ul = uniqvarlist(uuu)
    isspace = isstrstr(uuu,&quot; &quot;)
    if isspace == 0
      isfrla = isfla(uuu)
      isfrla2 = vf(uuu)
      #print isfrla2
      if isfrla&amp;&amp;(isfrla2 &gt; 0)
        #if isfrla
        ret3 = uuu
        flavars = uniqvarlist(uuu)
      else
        ret3 = vvv
        flavars = vvv
      endif
      nfla = nelem(strsplit(flavars))
      ret3s = parse_fla3(ret3,indnams)
      ret3 = ret3s[1]
      current_li = ret3s[2]
      current_di = ret3s[3]
      lili = strsub(current_li,&quot;#&quot;,&quot;&quot;)
      didi = strsub(current_di,&quot;#&quot;,&quot;&quot;)
      colis = colis~&quot; &quot;~lili
      dilis = dilis~&quot; &quot;~didi
      rets = rets~&quot; &quot;~ret3
    else
      iseq = substr(uuu,1,1)==&quot;=&quot;
      if iseq
        issq = substr(vvv,1,3)==&quot;sq_&quot;
        sdpart = substr(vvv,4,strlen(vvv))
        fifi = findind(sdpart,ul)
        issq = issq*fifi&gt;0
        islg = substr(vvv,1,2)==&quot;l_&quot;
        sdpart2 = substr(vvv,3,strlen(vvv))
        fifi2 = findind(sdpart2,ul)
        fifi20l = str_setinrersect(ul,allvns)
        new_condition = sdpart2==fifi20l
        islg = islg*fifi2*new_condition&gt;0
        underscpos = catch_times(vvv, uuu)
        if issq
          ret3 = strstrip(sdpart~&quot;^2&quot;)
          flavars = uniqvarlist(ret3)
          lili = flavars
          colis = colis~&quot; &quot;~lili
          rets = rets~&quot; &quot;~ret3
        elif islg
          ret3 = strstrip(&quot;log(&quot;~sdpart2~&quot;)&quot;)
          flavars = uniqvarlist(ret3)
          lili = flavars
          colis = colis~&quot; &quot;~lili
          rets = rets~&quot; &quot;~ret3
        elif  underscpos &gt; 0
          nvvv = strlen(vvv)
          part1 = substr(vvv,1,underscpos-1)
          part2 = substr(vvv,underscpos+1,nvvv)
          ret3 = part1~&quot;*&quot;~part2
          rets = rets~&quot; &quot;~ret3
        else
          ret3 = vvv
          rets = rets~&quot; &quot;~ret3
        endif
        flavars = uniqvarlist(ret3)
        lili = flavars
        colis = colis~&quot; &quot;~lili
      else
        inti = substr(uuu,1,14)==&quot;interaction of&quot;
        inti2 = isstrstr(uuu,&quot;==&quot;)
        intis = strsplit3(uuu,&quot;==&quot;)
        nintis = nelem(intis)
        inti3 = (nintis==2)
        inti4 = 0
        if inti3
          intis2 = intis[2]
          nintis2 = strlen(intis2)
          cknin1 = substr(intis2,nintis2,nintis2)==&quot;)&quot;
          cknin2 = isnat(strstrip(substr(intis2,1,nintis2-1)))
          inti4 = cknin1*cknin2
        endif
        inti = inti*inti2*inti3*inti4&gt;0
        if inti
          zx = strsplit3(uuu,&quot;and (&quot;)
          zx2 = zx[2]
          zx1 = zx[1]
          namis2 = strsplit3(zx2,&quot;==&quot;)
          nami2 = strstrip(namis2[1])
          ni1 = strlen(zx1)
          nami1 = strstrip(substr(zx1,15,ni1))
          didi = getdiname(nami1)
          if strlen(didi) == 0
            first = nami1
          else
            first = null
          endif
          lili = strstrip(didi~&quot; &quot;~nami2)
          ret3 = doret2(uuu,vvv,lili,first)
          if !exists(first)
            first= &quot;&quot;
          endif
          rets = rets~&quot; &quot;~ret3
          dilis = dilis~&quot; &quot;~lili
          colis = colis~&quot; &quot;~first
        else
          doommy = isduname(vvv)
          if doommy
            ret3 = corr_duname(vvv)
            didi = getdiname(ret3)
            dilis = dilis~&quot; &quot;~didi
          else
            ret3 = vvv
            lili = ret3
            colis = colis~&quot; &quot;~lili
          endif
          rets = rets~&quot; &quot;~ret3
        endif
      endif
    endif
    colis = strstrip(colis)
    dilis = strstrip(dilis)
    rets_left = strstrip(rets_left~&quot; &quot;~vvv)
    rets_right = rets_right~&quot; &quot;~ret3
  endif
endloop
rets = strstrip(rets)
discrsi = uniqvarlist(dilis)
conti = uniqvarlist(colis)
return strstrip(rets)~&quot;;&quot;~ strstrip(conti)~&quot;;&quot;~strstrip(discrsi)
</code>
</gretl-function>
<gretl-function name="dum_grads_many" type="matrix" private="1">
 <params count="6">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="cmd" type="string"/>
 </params>
<code>nams = strsplit(nam)
nn = nelem(nams)
nb = nelem(b)
nns = nn
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = mfun
loop i=1..nns -q
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
xbackup = x
funs2 = strsplit(fun2)
nf = nelem(funs2)
matrix ret = zeros(nn,nf)
matrix ret222 = zeros(1,nf)
nnxx = nelem(x)
matrix ret = zeros(nn,nb+1)
loop j = 1..nnxx -q
  x[j] = 0
  grads = zeros(2,nf)
  loop i=1..nf -q
    string fun3 = funs2[i]
    grads[1,i] = @fun3
  endloop
  x[j] = 1
  loop i=1..nf -q
    string fun3 = funs2[i]
    grads[2,i] = @fun3
  endloop
  if nb &gt; nf
    grads = ones(2,1)~grads
  endif
  matrix mafx = grads*b
  if cmd == &quot;lin&quot;
    matrix logi0 = mafx
    matrix logi = mafx
    matrix ret1 = grads
  elif cmd == &quot;probit&quot;
    matrix logi0 = cnorm(mafx)
    matrix logi = dnorm(mafx)
    matrix ret1 = grads .*logi
  elif cmd == &quot;logit&quot;
    matrix exb = exp(mafx)
    matrix logi0 = exb ./(exb .+ 1)
    matrix logi = logi0 ./(exb .+ 1)
    matrix ret1 = grads .*logi
  elif cmd == &quot;poisson&quot;
    matrix logi0 = exp(mafx)
    matrix ret1 = grads .*logi0
  endif
  ret1 = ret1[2,]-ret1[1,]
  matrix retj = (logi0[2]-logi0[1])~ret1
  x = xbackup
  ret[j,] = retj
endloop
return ret
</code>
</gretl-function>
<gretl-function name="cont_grads_many" type="matrix" private="1">
 <params count="6">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="cmd" type="string"/>
 </params>
<code>matrix b = vec(b)
nb = nelem(b)
nn = nelem(strsplit(nam))
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
string fun2 = mfun
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    fun2 = smartstrsub(fun2,znams[i],sprintf(&quot;z[%d]&quot;,i))
  endloop
endif
string fun223 = &quot;{&quot;~strsub(fun2,&quot; &quot;,&quot;,&quot;)~&quot;}&quot;
if nns &lt; bign
  matrix ret = fdjac(x,for_djac(x,fun223,z))'
else
  matrix ret = fdjac(x,for_djac(x,fun223))'
endif
nf = nelem(strsplit(fun2))
if cmd == &quot;lin&quot;
  if nb &gt; nf
    ret = zeros(nn,1)~ret
  endif
  return (ret*b)~ret
elif cmd == &quot;poisson&quot;
  matrix ret222 = @fun223
  if nb &gt; nf
    ret222 = 1~ret222
    ret = zeros(nn,1)~ret
  endif
  scalar xb = ret222*b
  logixb = exp(xb)
  matrix ret0 = ret*b
  matrix mafx = ret0.*logixb
  matrix ret4 = ret0*ret222
  ret4 = ret + ret4
  return mafx~ (ret4 .*logixb)
elif cmd == &quot;logit&quot;
  matrix ret222 = @fun223
  if nb &gt; nf
    ret222 = 1~ret222
    ret = zeros(nn,1)~ret
  endif
  scalar xb = ret222*b
  matrix xb2 = ret222
  exb = exp(xb)
  logixb = exb/(exb+1)^2
  second = -exb*(exb-1)/((exb+1)^3)
  matrix ret2 = ret.*logixb
  matrix mafx = (ret*b).*logixb
  matrix ret0 = ret*b
  matrix ret4 = ret0*xb2
  ret4 = ret4.*second
  ret = (mafx~(ret4+ret2))
  return ret
elif cmd == &quot;probit&quot;
  matrix ret222 = @fun223
  if nb &gt; nf
    ret222 = 1~ret222
    ret = zeros(nn,1)~ret
  endif
  scalar xb = ret222*b
  matrix xb2 = ret222
  logixb = dnorm(xb)
  second = -logixb*xb
  matrix ret2 = ret.*logixb
  matrix mafx = (ret*b).*logixb
  matrix ret0 = ret*b
  matrix ret4 = ret0*xb2
  ret4 = ret4.*second
  ret = (mafx~(ret4+ret2))
  return ret
endif
</code>
</gretl-function>
<gretl-function name="discr_grads2_many" type="matrix" private="1">
 <params count="8">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
  <param name="b" type="matrix"/>
  <param name="cmd" type="string"/>
 </params>
<code>strings  factlevss = strsplit(factlevs)
nns = nelem(factlevss)
strings nams = array(nns)
string fun2 = mfun
strings allnamess = strsplit(allnam)
scalar bign = nelem(allnamess)
loop i=1..bign -q
  fun2 = smartstrsub(fun2,allnamess[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix indi = zeros(nns,1)
loop i = 1.. nns -q
  nams[i] = nam~&quot;_&quot;~factlevss[i]
  indi[i] = findind(nams[i],allnam)
endloop
funs2 = strsplit(fun2)
nf = nelem(funs2)
nb = nelem(b)
matrix x = allval
bignns = nelem(strsplit(alllevs))
if bignns &gt; nns
  x[indi] = zeros(1,nns)
  matrix grads2 = zeros(nns+1,nf)
  loop i=1..nf -q
    string fun3 = funs2[i]
    grads2[1,i] = @fun3
  endloop
  loop j = 1..nns -q
    x[indi[j]] = 1
    loop i=1..nf -q
      string fun3 = funs2[i]
      grads2[j+1,i] = @fun3
    endloop
    x[indi] = zeros(1,nns)
  endloop
  if nb &gt; nf
    grads2=ones(nns+1,1)~grads2
  endif
else
  matrix grads2 = zeros(nns,nf)
  x[indi] = zeros(1,nns)
  loop j = 1..nns -q
    x[indi[j]] = 1
    loop i=1..nf -q
      string fun3 = funs2[i]
      grads2[j,i] = @fun3
    endloop
    x[indi] = zeros(1,nns)
  endloop
  if nb &gt; nf
    grads2=ones(nns,1)~grads2
  endif
endif
matrix mafx = grads2*b
if cmd == &quot;logit&quot;
  matrix exb = exp(mafx)
  matrix logi0 = exb ./(exb .+ 1)
  matrix logi = logi0 ./(exb .+ 1)
  matrix ret10 = grads2 .*logi
  ret10 = ret10[2:,] .- ret10[1,]
  matrix ret00 = (logi0[2:] .- logi0[1])~ret10
  return ret00
elif cmd == &quot;poisson&quot;
  matrix logi0 = exp(mafx)
  matrix logi = logi0
  matrix ret10 = grads2 .*logi
  ret10 = ret10[2:,] .- ret10[1,]
  matrix ret00 = (logi0[2:] .- logi0[1])~ret10
  return ret00
elif cmd == &quot;probit&quot;
  matrix logi0 = cnorm(mafx)
  matrix logi = dnorm(mafx)
  matrix ret10 = grads2 .*logi
  ret10 = ret10[2:,] .- ret10[1,]
  matrix ret00 = (logi0[2:] .- logi0[1])~ret10
  return ret00
elif cmd == &quot;lin&quot;
  matrix mafx = grads2*b
  matrix logi0 = mafx
  matrix logi = logi0
  matrix ret10 = grads2
  ret10 = ret10[2:,] .- ret10[1,]
  matrix ret00 = (logi0[2:] .- logi0[1])~ret10
  return ret00
endif
</code>
</gretl-function>
<gretl-function name="olp_cont_grads2" type="matrix" private="1">
 <params count="7">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="nalts" type="int" min="2" default="3"/>
  <param name="cmd" type="string"/>
 </params>
<code>nams = strsplit(nam)
nn = nelem(nams)
nb = nelem(b)
matrix bigb = vec(b)
matrix b = bigb[1:(nb-nalts+1)]
matrix cuts = bigb[(nb-nalts+2):]
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = mfun
string txti
loop i=1..nns -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,nams[i],txti)
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
endif
fun2 = &quot;myx(&quot;~strsub(fun2,&quot; &quot;,&quot;) myx(&quot;)~&quot;)&quot;
funs2 = strsplit(fun2)
nf = nelem(funs2)
matrix ret22 = zeros(nn,nf)
matrix ret222 = zeros(1,nf)
loop i=1..nf -q
  string fun3 = funs2[i]
  ret22[,i] = fdjac(x,@fun3)'
  ret222[i]=@fun3
endloop
matrix xb = ret222*b
matrix xbm = cuts.-xb
if cmd == &quot;logit&quot;
  matrix exbm = exp(xbm)
  matrix logixbm = exbm ./(exbm .+1).^2
  matrix  logixbm1 = 0|logixbm
  matrix  logixbm2 = logixbm|0
  logixbm = logixbm1-logixbm2
  matrix mfxm = vec(logixbm*(ret22*b)')
  ggg = ret222.*ones(nalts-1,1)
  matrix xb2m = ggg~(-I(nalts-1))
  xb100 = xb2m*bigb
  exb100 = exp(xb100)
  logixb100 = exb100./(exb100.+1).^2
  second100 = -exb100.*(exb100.-1)./((exb100.+1).^3)
  ret10 = ret22~zeros(nns,nalts-1)
  matrix ret200 = ret10**logixb100
  matrix ret00 = ret22*b
  matrix ret400 = ret00**xb2m
  ret400 = ret400.*mshape(second100,nns*nelem(second100),1)
  ret600 = ret200+ret400
  ret601 = zeros(nalts*nns,nb)
  ret602 = ret601
  indind = vec(seq(1,nalts-1)'.+ (seq(0,nns-1)*nalts))
  ret601[indind,] = ret600
  ret602[indind+1,] = ret600
  return  mfxm ~(ret601- ret602)
else
  matrix logixbm = dnorm(xbm)
  matrix  logixbm1 = 0|logixbm
  matrix  logixbm2 = logixbm|0
  logixbm = logixbm1-logixbm2
  matrix mfxm = vec(logixbm*(ret22*b)')
  ggg = ret222.*ones(nalts-1,1)
  matrix xb2m = ggg~(-I(nalts-1))
  xb100 = xb2m*bigb
  exb100 = exp(xb100)
  logixb100 = dnorm(xb100)
  second100 = -logixb100.*xb100
  ret10 = ret22~zeros(nns,nalts-1)
  matrix ret200 = ret10**logixb100
  matrix ret00 = ret22*b
  matrix ret400 = ret00**xb2m
  ret400 = ret400.*mshape(second100,nns*nelem(second100),1)
  ret600 = ret200+ret400
  ret601 = zeros(nalts*nns,nb)
  ret602 = ret601
  indind = vec(seq(1,nalts-1)'.+ (seq(0,nns-1)*nalts))
  ret601[indind,] = ret600
  ret602[indind+1,] = ret600
  return  mfxm ~(ret601- ret602)
endif
</code>
</gretl-function>
<gretl-function name="olp_dum_grads2" type="matrix" private="1">
 <params count="7">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="nalts" type="int" min="2" default="3"/>
  <param name="cmd" type="string"/>
 </params>
<code>nams = strsplit(nam)
nn = nelem(nams)
nb = nelem(b)
matrix ret = zeros(nn*nalts,nb+1)
matrix bigb = vec(b)
matrix b = bigb[1:(nb-nalts+1)]
matrix cuts = bigb[(nb-nalts+2):]
strings allnams = strsplit(allnam)
scalar nlas = nelem(allnams)
string fun2 = mfun
loop i=1..nlas -q
  fun2 = smartstrsub(fun2,allnams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
strings fun2s = strsplit(fun2)
seqna = seq(1,nalts)
loop i=1..nn -q
  indi20 = nalts*(i-1).+ seqna
  ret[indi20,] = olp_dum_grad2(fun2,fun2s,mfun, allnam, &amp;allval, nams[i], &amp;b,&amp;bigb,&amp;cuts,nb, nalts, cmd)
endloop
return ret
</code>
</gretl-function>
<gretl-function name="olp_dum_grad2" type="matrix" private="1">
 <params count="12">
  <param name="fun2" type="string"/>
  <param name="fun2s" type="strings"/>
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrixref"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrixref"/>
  <param name="bigb" type="matrixref"/>
  <param name="cuts" type="matrixref"/>
  <param name="nb" type="scalar"/>
  <param name="nalts" type="int" min="2" default="3"/>
  <param name="cmd" type="string"/>
 </params>
<code>scalar indi = findind(nam,allnam)
matrix Z = zeros(2,nelem(allval))
matrix allvi = allval
allvi[indi]=0
Z[1,]= allvi
allvi = allval
allvi[indi]=1
Z[2,]= allvi
rz = 2
scalar nf = nelem(fun2s)
matrix grads = zeros(rz*(nalts-1),nb)
Im = I(nalts-1)
kk = nb-nalts+1
loop i=1..rz -q
  matrix x = Z[i,]
  matrix retX = zeros(1,nf)
  loop iii=1..nf -q
    fun2si = fun2s[iii]
    retX[iii]=@fun2si
  endloop
  jj = seq(1,nalts-1)
  ll = rz*(jj-1)+i
  grads[ll,1:kk] = {1;1} .* retX
  grads[ll,kk+1:nb] = -Im[jj,]
endloop
matrix mfxx = grads*bigb
if cmd == &quot;probit&quot;
  matrix exbx = cnorm(mfxx)
  matrix exbxx =dnorm(mfxx)
  matrix ret300 = grads.*exbxx
  matrix ret400 = zeros(nalts-1,nb)
  matrix mfx0=zeros(nalts-1,1)
  loop i=1..(nalts-1) -q
    mfx0[i]=exbx[2*i-1]-exbx[2*i]
    ret400[i,]=ret300[2*i-1,]-ret300[2*i,]
  endloop
  mfx1 = 0|mfx0
  mfx2 = mfx0|0
  ret11 = mfx2-mfx1
  ret4001 = 0|ret400
  ret4002 = ret400|0
  ret21 = ret4001-ret4002
  return ret11~ret21
else
  matrix exbx0 = exp(mfxx)
  matrix exbx = exbx0./(exbx0.+1)
  matrix exbxx =exbx./(exbx0.+1)
  matrix ret300 = grads.*exbxx
  matrix ret400 = zeros(nalts-1,nb)
  matrix mfx0=zeros(nalts-1,1)
  loop i=1..(nalts-1) -q
    mfx0[i]=exbx[2*i-1]-exbx[2*i]
    ret400[i,]=ret300[2*i-1,]-ret300[2*i,]
  endloop
  mfx1 = 0|mfx0
  mfx2 = mfx0|0
  ret11 = mfx2-mfx1
  ret4001 = 0|ret400
  ret4002 = ret400|0
  ret21 = ret4001-ret4002
  return ret11~ret21
endif
</code>
</gretl-function>
<gretl-function name="olp_discr_grad2" type="matrix" private="1">
 <params count="9">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
  <param name="b" type="matrix"/>
  <param name="nalts" type="int" min="2" default="3"/>
  <param name="cmd" type="string"/>
 </params>
<code>matrix bigb = vec(b)
# sorted by levels of discrete variable
nb = nelem(bigb)
matrix b = bigb[1:(nb-nalts+1)]
matrix cuts = bigb[(nb-nalts+2):]
string fun2 = mfun
strings allnams = strsplit(allnam)
scalar nlas = nelem(allnams)
loop i=1..nlas -q
  fun2 = smartstrsub(fun2,allnams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
strings fun2s = strsplit(fun2)
scalar nf = nelem(fun2s)
matrix Z = substvals2(allnam,allval,nam,factlevs,alllevs )
rz = rows(Z)
matrix grads = zeros(rz*(nalts-1),nb)
matrix Im = I(nalts-1)
kk = nb-nalts+1
loop i=1..rz -q
  matrix x = Z[i,]
  matrix retX = zeros(1,nf)
  loop iii=1..nf -q
    fun2si = fun2s[iii]
    retX[iii]=@fun2si
  endloop
  jj = seq(1,nalts-1)
  ll = rz*(jj-1)+i
  grads[ll,1:kk] = {1;1} .* retX
  grads[ll,kk+1:nb] = -Im[jj,]
endloop
matrix mfxx = grads*bigb
if cmd == &quot;logit&quot;
  matrix exbx0 = exp(mfxx)
  matrix exbx = exbx0./(exbx0.+1)
  matrix exbxx =exbx./(exbx0.+1)
else
  matrix exbx = cnorm(mfxx)
  matrix exbxx =dnorm(mfxx)
endif
matrix ret300 = grads.*exbxx
matrix ret400 = zeros(nalts-1,nb)
matrix Zi = zeros(rz,1)
matrix indi = Zi
matrix indi2 = zeros(rz-1,1)
matrix Zis = zeros((rz-1)*(nalts-1),1)
matrix ret400 = zeros((rz-1)*(nalts-1),nb)
matrix ret400i = {}
loop i=1..(nalts-1) -q
  indi = rz*(i-1).+seq(1,rz)
  Zi = exbx[indi]
  ret400i = ret300[indi,]
  Zi=Zi[2:,].-Zi[1,]
  ret400i = ret400i[2:,].-ret400i[1,]
  indi2 = i .+ (nalts-1).*seq(0,rz-2)
  Zis[indi2]=Zi
  ret400[indi2,]=ret400i
endloop
matrix mfal = {}
matrix zindi = {}
matrix mret400 = {}
matrix m400i = {}
matrix zi ={}
loop i=1..(rz-1) -q
  zindi =(i-1)*(nalts-1).+ seq(1,nalts-1)
  zi = Zis[zindi]
  m400i = ret400[zindi,]
  mfx1 = 0|zi
  mfx2 = zi|0
  m400i1 = zeros(1,nb)|m400i
  m400i2 = m400i|zeros(1,nb)
  mfal=mfal|(mfx1-mfx2)
  matrix mret400 = mret400|(m400i1-m400i2)
endloop
return mfal~mret400
</code>
</gretl-function>
<gretl-function name="ml_cont_grads56" type="matrix" private="1">
 <params count="5">
  <param name="b" type="matrix"/>
  <param name="nalts" type="int"/>
  <param name="svals" type="matrixref"/>
  <param name="grads0" type="matrixref"/>
  <param name="ismuc" type="int"/>
 </params>
<code>n = nalts
matrix X = svals
if ismuc
  X = 1~X
endif
scalar k = cols(X)
matrix b0 = mshape(b[1:(k*(n-1))],k,n-1)
b0 = zeros(k,1) ~ b0
matrix tmp = X*b0
matrix exbadj2 = exp(tmp)
matrix pij = exbadj2./sumr(exbadj2)
betam = grads0*b0
alphabar = betam * pij'
mfixes = pij.*(betam .-alphabar)
return vec(mfixes)
</code>
</gretl-function>
<gretl-function name="tobit_text" type="string" private="1">
 <params count="1">
  <param name="xb" type="string"/>
 </params>
<code>xb = &quot;(&quot;~xb~&quot;)&quot;
cey = &quot;(xb__ + s__*(dnorm((lo__-xb__)/s__)-dnorm((hi__-xb__)/s__))/ (cnorm((hi__-xb__)/s__)-cnorm((lo__-xb__)/s__)))&quot;
cey = smartstrsub(cey,&quot;xb__&quot;,xb)
ey = &quot;lo__*cnorm((lo__-xb__)/s__)+hi__*cnorm(-(hi__-xb__)/s__)+(cnorm((hi__-xb__)/s__)-cnorm((lo__-xb__)/s__))*cey__&quot;
ey = smartstrsub(ey,&quot;xb__&quot;,xb)
ey = smartstrsub(ey,&quot;cey__&quot;,cey)
return ey
</code>
</gretl-function>
<gretl-function name="mk_tob_outtext" type="string" private="1">
 <params count="3">
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
  <param name="ynam" type="string"/>
 </params>
<code>if missing(lo__)&amp;&amp;missing(hi__)
  ret = ynam
elif !missing(lo__)
  if missing(hi__)
    ret = sprintf(&quot;%s &gt; %g&quot;,ynam,lo__)
  else
    ret = sprintf(&quot;%g &lt; %s &lt; %g&quot;,lo__,ynam,hi__)
  endif
else
  ret = sprintf(&quot;%s &lt; %g&quot;,ynam,hi)
endif
return ret
</code>
</gretl-function>
<gretl-function name="tobit_text2" type="string" private="1">
 <params count="1">
  <param name="xb" type="string"/>
 </params>
<code>xb = &quot;(&quot;~xb~&quot;)&quot;
Phi1 = &quot;cnorm((lo__-xb__)/s__)&quot;
Phi2 = &quot;cnorm((hi__-xb__)/s__)&quot;
phi1 = &quot;dnorm((lo__-xb__)/s__)&quot;
phi2 = &quot;dnorm((hi__-xb__)/s__)&quot;
num = &quot;(&quot;~phi1~&quot;-&quot;~phi2~&quot;)&quot;
den = &quot;(&quot;~Phi2~&quot;-&quot;~Phi1~&quot;)&quot;
ratio = &quot;s__*&quot;~num~&quot;/&quot;~den
ratio = smartstrsub(ratio,&quot;xb__&quot;,xb)
ret = xb~&quot;+&quot;~ratio
return ret
</code>
</gretl-function>
<gretl-function name="text_xb" type="string" private="1">
 <params count="2">
  <param name="fun" type="string"/>
  <param name="n" type="int"/>
 </params>
<code>funs = strsplit(fun)
nf = nelem(funs)
ret = &quot;&quot;
if nf == n
  loop i = 1..n -q
    term = sprintf(&quot;b[%d]*%s&quot;, i , funs[i])
    #print term
    if i == 1
      ret = ret~term
    else
      ret = ret~&quot;+&quot;~term
    endif
  endloop
elif n == (nf + 1)
  ret = &quot;b[1]&quot;
  loop i = 2..n -q
    term = sprintf(&quot;b[%d]*%s&quot;, i , funs[i-1])
    ret = ret~&quot;+&quot;~term
  endloop
else
  funcerr &quot;Wrong lengths of b&quot;
endif
return ret
</code>
</gretl-function>
<gretl-function name="text_xb3" type="string" private="1">
 <params count="3">
  <param name="fun" type="string"/>
  <param name="nx" type="int"/>
  <param name="n" type="int"/>
 </params>
<code>funs = strsplit(fun)
nf = nelem(funs)
ret = &quot;&quot;
if nf == n
  loop i = 1..n -q
    j = i+nx
    term = sprintf(&quot;x[%d]*%s&quot;, j , funs[i])
    #print term
    if i == 1
      ret = ret~term
    else
      ret = ret~&quot;+&quot;~term
    endif
  endloop
elif n == (nf + 1)
  j = nx + 1
  ret = sprintf(&quot;x[%d]&quot;, j)
  loop i = 2..n -q
    j = i+nx
    term = sprintf(&quot;x[%d]*%s&quot;, j , funs[i-1])
    ret = ret~&quot;+&quot;~term
  endloop
else
  funcerr &quot;Wrong lengths of b&quot;
endif
return ret
</code>
</gretl-function>
<gretl-function name="tb_elast1" type="matrices" private="1">
 <params count="9">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
  <param name="vcv" type="matrix"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
string txti
loop i=1..nns -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,nams[i],txti)
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z ={}
endif
fun2bkp = fun2
fun2 = text_xb(fun2,nelem(b))
fun200 = text_xb3(fun2bkp,nelem(x),nelem(b))
fun2 = tobit_text(fun2)
fun200 = tobit_text(fun200)
string fun3 = &quot;log(&quot;~fun2~&quot;)&quot;
string fun300 = &quot;log(&quot;~fun200~&quot;)&quot;
if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
matrix valval = @fun2
matrix ret = fdjac(x,@fun3)
nz = nelem(z)
sub1 = sprintf(&quot;z[%d]&quot;,(nz+1))
sub2 = sprintf(&quot;z[%d]&quot;,(nz+2))
z = z~lo__~hi__
nb = nelem(b)
b = b|s__
nx = nelem(x)
sub400 = sprintf(&quot;x[%d]&quot;,(nx+nb+1))
fun400 = smartstrsub(fun300,&quot;lo__&quot;,sub1)
fun400 = smartstrsub(fun400,&quot;hi__&quot;,sub2)
fun400 = smartstrsub(fun400,&quot;s__&quot;,sub400)
xbkp = x
ret = (ret.*x)'
matrices M = array(4)
M[1] = valval
M[2] = ret
x = x~b'
matrix hess0 = numhess(x,@fun400)[1:nx,(nx+1):]
#print hess0
matrix hess = numhess(x,@fun400)[1:nx,(nx+1):].*xbkp'
nnn = cols(vcv)
matrix Jm = I(nnn)
Jm[nnn,nnn] = s__
print s__
print vcv
matrix Vbig = qform(Jm, vcv)
matrix mvc = qform(hess,Vbig)
M[3] = mvc
M[4] = sqrt(diag(mvc))
return M
</code>
</gretl-function>
<gretl-function name="tb_elast2" type="matrices" private="1">
 <params count="9">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
  <param name="vcv" type="matrix"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
string txti
loop i=1..nns -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,nams[i],txti)
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z ={}
endif
fun2bkp = fun2
fun2 = text_xb(fun2,nelem(b))
fun200 = text_xb3(fun2bkp,nelem(x),nelem(b))
fun2 = tobit_text2(fun2)
fun200 = tobit_text2(fun200)
string fun3 = &quot;log(&quot;~fun2~&quot;)&quot;
string fun300 = &quot;log(&quot;~fun200~&quot;)&quot;
if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
matrix valval = @fun2
matrix ret = fdjac(x,@fun3)
ret = (ret.*x)'
nz = nelem(z)
sub1 = sprintf(&quot;z[%d]&quot;,(nz+1))
sub2 = sprintf(&quot;z[%d]&quot;,(nz+2))
z = z~lo__~hi__
nb = nelem(b)
b = b|s__
nx = nelem(x)
sub400 = sprintf(&quot;x[%d]&quot;,(nx+nb+1))
fun400 = smartstrsub(fun300,&quot;lo__&quot;,sub1)
fun400 = smartstrsub(fun400,&quot;hi__&quot;,sub2)
fun400 = smartstrsub(fun400,&quot;s__&quot;,sub400)
xbkp = x
matrices M = array(4)
M[1] = valval
M[2] = ret
x = x~b'

matrix hess = numhess(x,@fun400)[1:nx,(nx+1):].*xbkp'
nnn = cols(vcv)
matrix Jm = I(nnn)
Jm[nnn,nnn] = s__
matrix Vbig = qform(Jm, vcv)
matrix mvc = qform(hess,Vbig)
M[3] = mvc
M[4] = sqrt(diag(mvc))
return M
</code>
</gretl-function>
<gretl-function name="tb_cont_grads22" type="matrix" private="1">
 <params count="8">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
string txti
loop i=1..nns -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,nams[i],txti)
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z ={}
endif
fun2bkp = fun2
fun2 = text_xb(fun2,nelem(b))
fun200 = text_xb3(fun2bkp,nelem(x),nelem(b))
fun2 = tobit_text2(fun2)
fun200 = tobit_text2(fun200)
string fun3 = &quot;(&quot;~fun2~&quot;)&quot;
string fun300 = &quot;(&quot;~fun200~&quot;)&quot;
if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
matrix valval = @fun2
matrix ret = fdjac(x,@fun3)'
#ret = (ret.*x)'
nz = nelem(z)
sub1 = sprintf(&quot;z[%d]&quot;,(nz+1))
sub2 = sprintf(&quot;z[%d]&quot;,(nz+2))
z = z~lo__~hi__
nb = nelem(b)
b = b|s__
nx = nelem(x)
sub400 = sprintf(&quot;x[%d]&quot;,(nx+nb+1))
fun400 = smartstrsub(fun300,&quot;lo__&quot;,sub1)
fun400 = smartstrsub(fun400,&quot;hi__&quot;,sub2)
fun400 = smartstrsub(fun400,&quot;s__&quot;,sub400)
xbkp = x
x = x~b'
matrix hess = numhess(x,@fun400)[1:nx,(nx+1):]
return ret~hess
</code>
</gretl-function>
<gretl-function name="tb_dum_grads22" type="matrix" private="1">
 <params count="8">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
 </params>
<code>if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
smallb = b
b = b|s__
nams = strsplit(nam)
nn = nelem(nams)
nb = nelem(b)
nns = nn
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
loop i=1..nns -q
  fun2 = smartstrsub(fun2,nams[i],sprintf(&quot;x[%d]&quot;,i))
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z = {}
endif
nz = nelem(z)
sub1 = sprintf(&quot;z[%d]&quot;,(nz+1))
sub2 = sprintf(&quot;z[%d]&quot;,(nz+2))
z = z~lo__~hi__
matrix xbackup = x
fun2a = tobit_text2(text_xb(fun2,nb-1))
funs2 = strsplit(fun2)
nf = nelem(funs2)
matrix ret222 = zeros(1,nf)
nnxx = nelem(x)
matrix ret1 = zeros(nn,nb)
matrix ret2 = ret1
matrix retZ1 = zeros(nn,1)
matrix retZ2 = retZ1
sub4 = sprintf(&quot;b[%d]&quot;,(nb))
fun4 = smartstrsub(fun2a,&quot;lo__&quot;,sub1)
fun4 = smartstrsub(fun4,&quot;hi__&quot;,sub2)
fun4 = smartstrsub(fun4,&quot;s__&quot;,sub4)
fun4 = &quot;(&quot;~fun4~&quot;)&quot;
loop j = 1..nnxx -q
  x[j] = 0
  retZ1[j] = @fun2a
  ret1[j,] = fdjac(b,@fun4)
  x[j] = 1
  retZ2[j] = @fun2a
  ret2[j,] = fdjac(b,@fun4)
  x = xbackup
endloop
return (retZ2 - retZ1)~(ret2 - ret1)
</code>
</gretl-function>
<gretl-function name="t_discr_grads222" type="matrix" private="1">
 <params count="10">
  <param name="mfun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
  <param name="b" type="matrix"/>
  <param name="s__" type="scalar" default="1"/>
  <param name="lo__" type="scalar" default="0"/>
  <param name="hi__" type="scalar" default="NA"/>
 </params>
<code>matrix b = vec(b)
if missing(hi__)
  hi__ = $huge
endif
if missing(lo__)
  lo__ = -$huge
endif
matrix Z = substvals2(allnam,allval,nam,factlevs,alllevs )
rz = rows(Z)
n = nelem(b)
fun3 = text_xb(mfun,n)
fun4 = tobit_text2(fun3)
sub4 = sprintf(&quot;b[%d]&quot;,(n+1))
fun4 = smartstrsub(fun4,&quot;s__&quot;,sub4)
sub1 = sprintf(&quot;z[%d]&quot;,1)
sub2 = sprintf(&quot;z[%d]&quot;,2)
fun4 = smartstrsub(fun4,&quot;lo__&quot;,sub1)
fun4 = smartstrsub(fun4,&quot;hi__&quot;,sub2)
b = b|s__
matrix z = {lo__,hi__}
# print fun4
matrix ret3 = zeros(rz,n+2)
loop i=1..rz -q
  ret3[i,] = t_txtfun(fun4,allnam,Z[i,],z,b)
endloop
ret3 = ret3[2:,] .- ret3[1,]
#return ret3
return ret3
</code>
</gretl-function>
<gretl-function name="t_txtfun" type="matrix" private="1">
 <params count="5">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="z" type="matrix" optional="true"/>
  <param name="b" type="matrix" optional="true"/>
 </params>
<code>strings allnams = strsplit(allnam)
scalar n = nelem(allnams)
string fun2 = fun
string txti
loop i=1..n -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,allnams[i],txti)
endloop
#print fun2
matrix x = allval
fun3 = &quot;myx(&quot;~fun2~&quot;)&quot;
matrix ret2 = fdjac(b,@fun3)
matrix ret = @fun2~ret2
return ret
</code>
</gretl-function>
<gretl-function name="cuti" type="string" private="1">
 <params count="4">
  <param name="nume" type="int"/>
  <param name="xb" type="string"/>
  <param name="lette" type="string"/>
  <param name="type" type="int" default="1"/>
 </params>
<code>ccut = sprintf(&quot;%s[%d]&quot;,lette,nume)
if type == 1
  ret = sprintf(&quot;cnorm(%s-(%s))&quot;,ccut,xb)
else
  ret = sprintf(&quot;1/(1+exp(-(%s-(%s))))&quot;,ccut,xb)
endif
return ret
</code>
</gretl-function>
<gretl-function name="op_elast1" type="matrices" private="1">
 <params count="8">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="vcv" type="matrix"/>
  <param name="numofx" type="scalar"/>
  <param name="type" type="scalar" default="1"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
string txti
loop i=1..nns -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,nams[i],txti)
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z ={}
endif
fun2bkp = fun2
fun2 = text_xb(fun2,numofx)
fun200 = text_xb3(fun2bkp,nns,numofx)
ncuts = nelem(b) - numofx
n_alts = ncuts + 1
ret0100 = zeros(n_alts,nns)
xbkp = x
hessis0100 = zeros(nns*n_alts,nelem(b))
matrix fun2ss = zeros(ncuts,1)
loop i=1..n_alts  -q
  cuf =  cuti(i+numofx,fun2,&quot;b&quot;,type)
  cutf = cuti(i+numofx+nns,fun200,&quot;x&quot;,type)
  if i == 1
    cuf = &quot;log(&quot;~cuf~&quot;)&quot;
    cutf = &quot;log(&quot;~cutf~&quot;)&quot;
  elif i &lt; n_alts
    cuf = &quot;log(&quot;~cuf~&quot;-(&quot;~cuti(i-1+numofx,fun2,&quot;b&quot;,type)~&quot;))&quot;
    cutf = &quot;log(&quot;~cutf~&quot;-(&quot;~cuti(i-1+numofx+nns,fun200,&quot;x&quot;,type)~&quot;))&quot;
  else
    cuf = &quot;log(1-(&quot;~cuti(i-1+numofx,fun2,&quot;b&quot;,type)~&quot;))&quot;
    cutf = &quot;log(1-(&quot;~cuti(i-1+numofx+nns,fun200,&quot;x&quot;,type)~&quot;))&quot;
  endif
  ret0100[i,] = fdjac(x,@cuf).*x
  x = x~b'
  hrows = (i-1)*nns.+seq(1,nns)
  hessis0100[hrows,] = numhess(x,@cutf)[1:nns,(nns+1):].*xbkp'
  x = xbkp
endloop
matrix mama = qform(hessis0100,vcv)
matrix ses = sqrt(diag(mama))
matrices M = array(5)
M[1] = fun2ss
M[2] = ret0100
M[3] = mama
M[4] = mshape(ses,nns,n_alts)'
M[5] = {n_alts}
return M
</code>
</gretl-function>
<gretl-function name="ml_text_xb" type="string" private="1">
 <params count="3">
  <param name="fun" type="string"/>
  <param name="n" type="int"/>
  <param name="start" type="int" default="1"/>
 </params>
<code>funs = strsplit(fun)
nf = nelem(funs)
ret = &quot;&quot;
if nf == n
  loop i = 1..n -q
    term = sprintf(&quot;b[%d]*%s&quot;, i+start-1 , funs[i])
    if i == 1
      ret = ret~term
    else
      ret = ret~&quot;+&quot;~term
    endif
  endloop
elif n == (nf + 1)
  ret = sprintf(&quot;b[%d]&quot; , start)
  loop i = 2..n -q
    term = sprintf(&quot;b[%d]*%s&quot;, i+start-1 , funs[i-1])
    ret = ret~&quot;+&quot;~term
  endloop
else
  funcerr &quot;Wrong lengths of b&quot;
endif
return ret
</code>
</gretl-function>
<gretl-function name="ml_text_den" type="string" private="1">
 <params count="3">
  <param name="fun" type="string"/>
  <param name="bign" type="int"/>
  <param name="nalts" type="int"/>
 </params>
<code>smalln = bign/(nalts-1)
ret0 = ml_text_sum(nalts-1)
loop i = 1..(nalts-1) -q
  find = sprintf(&quot;#%d&quot;,i)
  subst = ml_text_xb(fun,smalln,smalln*(i-1)+1)
  ret0 = strsub(ret0,find,subst)
endloop
return &quot;1+&quot;~ret0
</code>
</gretl-function>
<gretl-function name="ml_text_sum" type="string" private="1">
 <params count="1">
  <param name="k" type="int"/>
 </params>
<code>ret = &quot;exp(#1)&quot;
if k &gt; 1
  loop i = 2..k -q
    reti = sprintf(&quot;exp(#%d)&quot;, i)
    ret = ret~&quot;+&quot;~reti
  endloop
endif
return ret
</code>
</gretl-function>
<gretl-function name="ml_text" type="string" private="1">
 <params count="4">
  <param name="fun" type="string"/>
  <param name="bign" type="int"/>
  <param name="nalts" type="int"/>
  <param name="alt" type="int" default="1"/>
 </params>
<code>den =  ml_text_den(fun,bign,nalts)
num = &quot;1&quot;
if alt &gt; 1
  smalln = bign/(nalts-1)
  num = sprintf(&quot;exp(#%d)&quot;, alt)
  find = sprintf(&quot;#%d&quot;,alt)
  subst = ml_text_xb(fun,smalln,smalln*(alt-2)+1)
  num = strsub(num,find,subst)
endif
ret = num~&quot;/(&quot;~den~&quot;)&quot;
return ret
</code>
</gretl-function>
<gretl-function name="ml_text_xx" type="string" private="1">
 <params count="3">
  <param name="fun" type="string"/>
  <param name="nb" type="int"/>
  <param name="nx" type="int"/>
 </params>
<code>funre = fun
loop i=1..nb -q
  find = sprintf(&quot;b[%d]&quot;,i)
  repl = sprintf(&quot;x[%d]&quot;,i+nx)
  funre = smartstrsub(funre, find, repl)
endloop
return funre
</code>
</gretl-function>
<gretl-function name="ml_elast22" type="matrices" private="1">
 <params count="7">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="nam" type="string"/>
  <param name="b" type="matrix"/>
  <param name="nalts" type="int"/>
  <param name="vcv" type="matrix"/>
 </params>
<code>matrix b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
matrix indi = zeros(nns,1)
loop i=1..nns -q
  indi[i] = findind(nams[i],allnam)
endloop
string fun2 = fun
string txti
loop i=1..nns -q
  txti = sprintf(&quot;x[%d]&quot;,i)
  fun2 = smartstrsub(fun2,nams[i],txti)
endloop
matrix x = allval[indi]
scalar bign = nelem(strsplit(allnam))
if nns &lt; bign
  matrix z = mexclude(allval,indi)
  string znam = str_setdiff(allnam,nam)
  scalar nnz = bign - nns
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  z ={}
endif
matrix ret = zeros(nalts,nns)
hessis0100 = zeros(nns*nalts,nelem(b))
xbkp = x
nnbb = nelem(b)
matrix valval = zeros(nalts,1)
loop i=1..nalts -q
  fun3 = ml_text(fun2,nelem(b),nalts,i)
  valval[i] = @fun3
  fun3 = &quot;log(&quot;~fun3~&quot;)&quot;
  ret[i,] = fdjac(x,@fun3).*x
  x = x~b'
  hrows = (i-1)*nns.+seq(1,nns)
  fun4 = ml_text_xx(fun3,nnbb,nns)
  hessis0100[hrows,] = numhess(x,@fun4)[1:nns,(nns+1):].*xbkp'
  x = xbkp
endloop
matrix mama = qform(hessis0100,vcv)
matrix ses = sqrt(diag(mama))
matrices M = array(5)
M[1] = valval
M[2] = ret
M[3] = mama
M[4] = mshape(ses,nns,nalts)'
M[5] = {nalts}
return M
</code>
</gretl-function>
<gretl-function name="fndtype" type="strings" private="1">
 <params count="1">
  <param name="str" type="string"/>
 </params>
<code>strs = strsplit3(str,&quot;;&quot;)
n = nelem(strs)
rty = &quot;&quot;
rw = &quot;&quot;
rat = &quot;&quot;
if n &gt; 0
  loop i = 1..n -q
    stri = strs[i]
    stri2 = strstrip(strsub(stri,&quot; &quot;,&quot;&quot;))
    ckt = substr(stri2,1,5) == &quot;type=&quot;
    ckw = substr(stri2,1,4) == &quot;wrt=&quot;
    cka = substr(stri2,1,3) == &quot;at=&quot;
    if ckw
      rw = strstrip(strsplit3(stri,&quot;=&quot;)[2])
    elif cka
      rat = strstrip(strsplit3(stri,&quot;=&quot;)[2])
    elif ckt
      rty =  strstrip(strsplit3(stri,&quot;=&quot;)[2])
    endif
  endloop
endif
strings rets = array(3)
rets[1] = rw
rets[2] = rat
rets[3] = rty
return rets
</code>
</gretl-function>
<gretl-function name="all_hk_fun" type="matrix" private="1">
 <params count="13">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="nam" type="string"/>
  <param name="funZ" type="string"/>
  <param name="allnamZ" type="string"/>
  <param name="namZ" type="string"/>
  <param name="n1" type="int"/>
  <param name="n2" type="int"/>
  <param name="allval" type="matrix"/>
  <param name="allvalZ" type="matrix"/>
  <param name="b" type="matrix"/>
  <param name="etype" type="int" default="1"/>
  <param name="link" type="string"/>
 </params>
<code>b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
if nns &gt; 0
  matrix indi = zeros(nns,1)
  loop i=1..nns -q
    indi[i] = findind(nams[i],allnam)
  endloop
  string fun2 = fun
  string txti
  if nns &gt; 0
    loop i=1..nns -q
      txti = sprintf(&quot;x[%d]&quot;,i)
      fun2 = smartstrsub(fun2,nams[i],txti)
    endloop
  endif
  matrix x = allval[indi]
else
  string fun2 = fun
  matrix x = {}
  matrix indi = {}
endif
scalar bign = nelem(strsplit(allnam))
scalar nnz = bign - nns
matrix z = {}
if (nns &lt; bign)&amp;&amp;(bign &gt; 0)
  if nelem(indi) == 0
    matrix z = allval
  else
    matrix z = mexclude(allval,indi)
  endif
  string znam = str_setdiff(allnam,nam)
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z ={}
  string znam = &quot;&quot;
endif
fun2bkp = fun2
fun2 = text_xb(fun2,n1-1)
fun2s = strsplit(fun2bkp)
isscst = (n1-1) &gt; nelem(fun2s)
fun321 = xtextfun(fun2s,1,isscst,&quot;b&quot;)
fun321bkp = fun321
maxX = nns
maxZ = nnz
ZNAM = znam
strings nams = strsplit(namZ)
scalar nns = nelem(nams)
matrix indiz = {}
if nns &gt; 0
  matrix indiz = zeros(nns,1)
  loop i=1..nns -q
    indiz[i] = findind(nams[i],allnamZ)
  endloop
endif
string fun2 = funZ
commonX = str_setinrersect(namZ,nam)
commonXs = strsplit(commonX)
ncX = nelem(commonXs)
aloneX = str_setdiff(namZ,nam)
aloneXs = strsplit(aloneX)
naX = nelem(aloneXs)
ALLX = maxX + naX
if ncX &gt; 0
  coindi = findinds(commonX,nam)
  loop i=1..ncX -q
    txti = sprintf(&quot;x[%d]&quot;,coindi[i])
    fun2 = smartstrsub(fun2,commonXs[i],txti)
  endloop
endif
matrix aindiX = {}
matrix xZZ = {}
matrix aindiZ = {}
matrix zZZ = {}
if naX &gt; 0
  matrix aindiX = findinds(aloneX,namZ)
  matrix xZZ = allvalZ[aindiX]
  loop i=1..naX -q
    txti = sprintf(&quot;x[%d]&quot;,i+maxX)
    fun2 = smartstrsub(fun2,aloneXs[i],txti)
  endloop
endif
scalar bign = nelem(strsplit(allnamZ))
scalar nnz = bign - nns
if nns &lt; bign
  string znamZ = str_setdiff(allnamZ,namZ)
  strings znamZs = strsplit(znamZ)
  if maxZ == 0
    matrix aindiZ = findinds(znamZ,allnamZ)
    matrix zZZ = allvalZ[aindiZ]
    loop i=1..nnz -q
      txti = sprintf(&quot;z[%d]&quot;,i)
      fun2 = smartstrsub(fun2,znamZs[i],txti)
    endloop
  else
    commonZ = str_setinrersect(znamZ,ZNAM)
    commonZs = strsplit(commonZ)
    aloneZ = str_setdiff(znamZ,ZNAM)
    aloneZs = strsplit(aloneZ)
    ncZ = nelem(commonZs)
    naZ = nelem(aloneZs)
    if ncZ &gt; 0
      coindiZ = findinds(commonZ,ZNAM)
      loop i=1..ncZ -q
        txti = sprintf(&quot;z[%d]&quot;,coindiZ[i])
        fun2 = smartstrsub(fun2,commonZs[i],txti)
      endloop
    endif
    ALLZ = maxZ + naZ
    if naZ &gt; 0
      matrix aindiZ = findinds(aloneZ,allnamZ)
      matrix zZZ = allvalZ[aindiZ]
      loop i=1..naZ -q
        txti = sprintf(&quot;z[%d]&quot;,i+maxZ)
        fun2 = smartstrsub(fun2,aloneZs[i],txti)
      endloop
    endif
  endif
endif
fun2bkpZ = fun2
fun2s = strsplit(fun2bkpZ)
isscst = (n2-n1) &gt; nelem(fun2s)
fun321Z = xtextfun(fun2s,n1+1,isscst,&quot;b&quot;)
fun321Zbkp = fun321Z
x = x~xZZ
z = z~zZZ
matrix xBACKUP = x
#print link
if link != &quot;Ey&quot;
  fun321Z = &quot;invmills(-(&quot;~fun321Z~&quot;))&quot;
  bzzzz = sprintf(&quot;b[%d]&quot;,n1)
  fun321Z = bzzzz~&quot;*&quot;~fun321Z
  fun421 = &quot;(&quot;~fun321~&quot;+&quot;~fun321Z~&quot;)&quot;
  if etype == 1
    dydx = fdjac(x,@fun421)'
    funHe = fun421
    loop i=1..n2 -q
      finD = sprintf(&quot;b[%d]&quot;,i)
      repL = sprintf(&quot;x[%d]&quot;,i+ALLX)
      funHe = strsub(funHe,finD,repL)
    endloop
    x = x~b'
    hess =  numhess(x,@funHe)[1:ALLX,(ALLX+1):]
    return dydx~hess
    # endif
    #matrix xBACKUP = x
  elif etype == 2
    retd = zeros(ALLX,n2)
    matrix retdmf = zeros(ALLX,1)
    matrix x = xBACKUP
    loop i = 1..ALLX -q
      x[i] = 0
      nfun1 = @fun421
      ndy1 = fdjac(b,@fun421)
      #print ndy1
      x[i] = 1
      retdmf[i] = @fun421 - nfun1
      retd[i,] = fdjac(b,@fun421) - ndy1
      x = xBACKUP
    endloop
    return retdmf~retd
  endif
else
  fun521Z = &quot;dnorm((&quot;~fun321Zbkp~&quot;))&quot;
  fun521 = &quot;cnorm(&quot;~fun321Zbkp~&quot;)&quot;
  fun521 = fun521~&quot;*(&quot;~fun321~&quot;)&quot;
  bzzzz = sprintf(&quot;b[%d]&quot;,n1)
  fun521Z = bzzzz~&quot;*&quot;~fun521Z
  fun721 = &quot;(&quot;~fun521~&quot;+&quot;~fun521Z~&quot;)&quot;
  if etype == 1
    dydx = fdjac(x,@fun721)'
    #eval fdjac(x,@fun721)'
    funHe = fun721
    loop i=1..n2 -q
      finD = sprintf(&quot;b[%d]&quot;,i)
      repL = sprintf(&quot;x[%d]&quot;,i+ALLX)
      funHe = strsub(funHe,finD,repL)
    endloop
    x = x~b'
    hess =  numhess(x,@funHe)[1:ALLX,(ALLX+1):]
    return dydx~hess
  else
    retd = zeros(ALLX,n2)
    matrix retdmf = zeros(ALLX,1)
    matrix x = xBACKUP
    loop i = 1..ALLX -q
      x[i] = 0
      nfun1 = @fun721
      ndy1 = fdjac(b,@fun721)
      #print ndy1
      x[i] = 1
      retdmf[i] = @fun721 - nfun1
      retd[i,] = fdjac(b,@fun721) - ndy1
      x = xBACKUP
    endloop
    return retdmf~retd
  endif
endif
#return dydx~hess
</code>
</gretl-function>
<gretl-function name="hk_prefun" type="matrix" private="1">
 <params count="13">
  <param name="fla" type="string"/>
  <param name="flaZ" type="string"/>
  <param name="allnam" type="string"/>
  <param name="nam" type="string"/>
  <param name="factlevs" type="string"/>
  <param name="alllevs" type="string"/>
  <param name="allval" type="matrix"/>
  <param name="n1" type="scalar"/>
  <param name="n2" type="scalar"/>
  <param name="isc1" type="bool" default="1"/>
  <param name="isc2" type="bool" default="1"/>
  <param name="b" type="matrix"/>
  <param name="link" type="string"/>
 </params>
<code>b = vec(b)
fun11 = xtextfun(strsplit(fla),1,isc1,&quot;b&quot;)
fun12 = xtextfun(strsplit(flaZ),n1+2,isc2,&quot;b&quot;)
matrix Z = substvals2(allnam,allval,nam,factlevs,alllevs )
allnams = strsplit(allnam)
nna = nelem(allnams)
if link != &quot;Ey&quot;
  fun12 = sprintf(&quot;b[%d]*invmills(-(%s))&quot;, n1+1,fun12)
  fun3 = sprintf(&quot;(%s+%s)&quot;,fun11,fun12)
  fun4 = fun3
else
  fun12bkp = fun12
  fun12 = sprintf(&quot;b[%d]*dnorm(%s)&quot;, n1+1,fun12)
  fun12a = sprintf(&quot;cnorm(%s)*(%s)&quot;,fun12bkp,fun11)
  fun3 = sprintf(&quot;(%s+%s)&quot;,fun12a,fun12)
  fun4 = fun3
endif
loop i = 1..nna -q
  findi = allnams[i]
  substi = sprintf(&quot;x[%d]&quot;,i)
  fun4 = smartstrsub(fun4,findi,substi)
endloop
rz = rows(Z)
matrix ret0 = zeros(rz,1)
matrix ret20 = zeros(rz,nelem(b))
matrix x = allval
matrix xbkp = x
loop i = 1..rz -q
  x = Z[i,]
  ret20[i,]= fdjac(b,@fun4)
  ret0[i] = @fun4
  x = xbkp
endloop
matrix ret01 = (ret0 .-ret0[1])[2:]
matrix ret200 = (ret20 .- ret20[1,])[2:,]
return ret01~ret200
</code>
</gretl-function>
<gretl-function name="ALL_hk_fun" type="matrices" private="1">
 <params count="14">
  <param name="fun" type="string"/>
  <param name="allnam" type="string"/>
  <param name="nam" type="string"/>
  <param name="funZ" type="string"/>
  <param name="allnamZ" type="string"/>
  <param name="namZ" type="string"/>
  <param name="n1" type="int"/>
  <param name="n2" type="int"/>
  <param name="allval" type="matrix"/>
  <param name="allvalZ" type="matrix"/>
  <param name="b" type="matrix"/>
  <param name="vcv" type="matrix"/>
  <param name="etype" type="int" default="1"/>
  <param name="link" type="string"/>
 </params>
<code>b = vec(b)
strings nams = strsplit(nam)
scalar nns = nelem(nams)
if nns &gt; 0
  matrix indi = zeros(nns,1)
  loop i=1..nns -q
    indi[i] = findind(nams[i],allnam)
  endloop
  string fun2 = fun
  string txti
  if nns &gt; 0
    loop i=1..nns -q
      txti = sprintf(&quot;x[%d]&quot;,i)
      fun2 = smartstrsub(fun2,nams[i],txti)
    endloop
  endif
  matrix x = allval[indi]
else
  string fun2 = fun
  matrix x = {}
  matrix indi = {}
endif
scalar bign = nelem(strsplit(allnam))
scalar nnz = bign - nns
matrix z = {}
if (nns &lt; bign)&amp;&amp;(bign &gt; 0)
  if nelem(indi) == 0
    matrix z = allval
  else
    matrix z = mexclude(allval,indi)
  endif
  string znam = str_setdiff(allnam,nam)
  strings znams = strsplit(znam)
  loop i=1..nnz -q
    txti = sprintf(&quot;z[%d]&quot;,i)
    fun2 = smartstrsub(fun2,znams[i],txti)
  endloop
else
  matrix z ={}
  string znam = &quot;&quot;
endif
fun2bkp = fun2
fun2 = text_xb(fun2,n1-1)
fun2s = strsplit(fun2bkp)
isscst = (n1-1) &gt; nelem(fun2s)
fun321 = xtextfun(fun2s,1,isscst,&quot;b&quot;)
fun321bkp = fun321
maxX = nns
maxZ = nnz
ZNAM = znam
strings nams = strsplit(namZ)
scalar nns = nelem(nams)
matrix indiz = {}
if nns &gt; 0
  matrix indiz = zeros(nns,1)
  loop i=1..nns -q
    indiz[i] = findind(nams[i],allnamZ)
  endloop
endif
string fun2 = funZ
commonX = str_setinrersect(namZ,nam)
commonXs = strsplit(commonX)
ncX = nelem(commonXs)
aloneX = str_setdiff(namZ,nam)
aloneXs = strsplit(aloneX)
naX = nelem(aloneXs)
ALLX = maxX + naX
if ncX &gt; 0
  coindi = findinds(commonX,nam)
  loop i=1..ncX -q
    txti = sprintf(&quot;x[%d]&quot;,coindi[i])
    fun2 = smartstrsub(fun2,commonXs[i],txti)
  endloop
endif
matrix aindiX = {}
matrix xZZ = {}
matrix aindiZ = {}
matrix zZZ = {}
if naX &gt; 0
  matrix aindiX = findinds(aloneX,namZ)
  matrix xZZ = allvalZ[aindiX]
  loop i=1..naX -q
    txti = sprintf(&quot;x[%d]&quot;,i+maxX)
    fun2 = smartstrsub(fun2,aloneXs[i],txti)
  endloop
endif
scalar bign = nelem(strsplit(allnamZ))
scalar nnz = bign - nns
if nns &lt; bign
  string znamZ = str_setdiff(allnamZ,namZ)
  strings znamZs = strsplit(znamZ)
  if maxZ == 0
    matrix aindiZ = findinds(znamZ,allnamZ)
    matrix zZZ = allvalZ[aindiZ]
    loop i=1..nnz -q
      txti = sprintf(&quot;z[%d]&quot;,i)
      fun2 = smartstrsub(fun2,znamZs[i],txti)
    endloop
  else
    commonZ = str_setinrersect(znamZ,ZNAM)
    commonZs = strsplit(commonZ)
    aloneZ = str_setdiff(znamZ,ZNAM)
    aloneZs = strsplit(aloneZ)
    ncZ = nelem(commonZs)
    naZ = nelem(aloneZs)
    if ncZ &gt; 0
      coindiZ = findinds(commonZ,ZNAM)
      loop i=1..ncZ -q
        txti = sprintf(&quot;z[%d]&quot;,coindiZ[i])
        fun2 = smartstrsub(fun2,commonZs[i],txti)
      endloop
    endif
    ALLZ = maxZ + naZ
    if naZ &gt; 0
      matrix aindiZ = findinds(aloneZ,allnamZ)
      matrix zZZ = allvalZ[aindiZ]
      loop i=1..naZ -q
        txti = sprintf(&quot;z[%d]&quot;,i+maxZ)
        fun2 = smartstrsub(fun2,aloneZs[i],txti)
      endloop
    endif
  endif
endif
fun2bkpZ = fun2
fun2s = strsplit(fun2bkpZ)
isscst = (n2-n1) &gt; nelem(fun2s)
fun321Z = xtextfun(fun2s,n1+1,isscst,&quot;b&quot;)
fun321Zbkp = fun321Z
x = x~xZZ
z = z~zZZ
matrix xBACKUP = x
#print link
if link != &quot;Ey&quot;
  fun321Z = &quot;invmills(-(&quot;~fun321Z~&quot;))&quot;
  bzzzz = sprintf(&quot;b[%d]&quot;,n1)
  fun321Z = bzzzz~&quot;*&quot;~fun321Z
  fun421 = &quot;log(&quot;~fun321~&quot;+&quot;~fun321Z~&quot;)&quot;
  if etype == 1
    #print x
    dydx = fdjac(x,@fun421)'.*x'
    #print dydx
    funHe = fun421
    loop i=1..n2 -q
      finD = sprintf(&quot;b[%d]&quot;,i)
      repL = sprintf(&quot;x[%d]&quot;,i+ALLX)
      funHe = strsub(funHe,finD,repL)
    endloop
    x = x'|b
    #print x
    hess =  numhess(x,@funHe)[1:ALLX,(ALLX+1):].*xBACKUP'
    #print hess
    matrix VCV = qform(hess,vcv)
    matrix SES = sqrt(diag(VCV))
    matrices M = array(4)
    M[1] = 0
    M[2] = dydx
    M[3] = VCV
    M[4] = SES
    return M
  endif
else
  fun521Z = &quot;dnorm((&quot;~fun321Zbkp~&quot;))&quot;
  fun521 = &quot;cnorm(&quot;~fun321Zbkp~&quot;)&quot;
  fun521 = fun521~&quot;*(&quot;~fun321~&quot;)&quot;
  bzzzz = sprintf(&quot;b[%d]&quot;,n1)
  fun521Z = bzzzz~&quot;*&quot;~fun521Z
  fun721 = &quot;log(&quot;~fun521~&quot;+&quot;~fun521Z~&quot;)&quot;
  if etype == 1
    dydx = fdjac(x,@fun721)'.*x'
    #eval fdjac(x,@fun721)'
    funHe = fun721
    loop i=1..n2 -q
      finD = sprintf(&quot;b[%d]&quot;,i)
      repL = sprintf(&quot;x[%d]&quot;,i+ALLX)
      funHe = strsub(funHe,finD,repL)
    endloop
    x = x'|b
    hess =  numhess(x,@funHe)[1:ALLX,(ALLX+1):].*xBACKUP'
    matrix VCV = qform(hess,vcv)
    matrix SES = sqrt(diag(VCV))
    matrices M = array(4)
    M[1] = 0
    M[2] = dydx
    M[3] = VCV
    M[4] = SES
    return M
  else
  endif
endif
#return dydx~hess
</code>
</gretl-function>
<gretl-function name="no_arith" type="string" private="1">
<code>text1 = &quot;abs         acos        acosh       aggregate   argname        array       asin        asinh       atan        atanh        atof        bessel      BFGSmax     BFGSmin     BFGScmax        BFGScmin    bkfilt      boxcox      bread       bwfilt        bwrite      cdemean     cdf         cdiv        cdummify        ceil        cholesky    chowlin     cmult       cnorm        cnumber     colname     colnames    cols        corr        corrgm      cos         cosh        cov         critical        cum         curl        dayspan     defarray    defbundle        deflist     deseas      det         diag        diagcat        diff        digamma     dnorm       dropcoll    dsort        dummify     easterday   ecdf        eigengen    eigensym        eigsolve    epochday    errmsg      exists      exp        fcstats     fdjac       fft         ffti        filter        firstobs    fixname     floor       fracdiff    gammafun        genseries   getenv      getinfo     getline     ghk        gini        ginv        GSSmax      GSSmin      halton        hdprod      hfdiff      hfldiff     hflags      hflist        hpfilt      I           imaxc       imaxr       imhof        iminc       iminr       inbundle    infnorm     inlist        int         inv         invcdf      invmills    invpd        irf         irr         isconst     isdiscrete  isdummy        isnan       isoconv     isodate     iwishart    jsonget        juldate     kdensity    kdsmooth    kfilter     kmeier        kpsscrit    ksetup      ksimul      ksmooth     kurtosis        lags        lastobs     ldet        ldiff       lincomb        linearize   ljungbox    lngamma     loess       log        log10       log2        logistic    lower       lrvar        max         maxc        maxr        mcorr       mcov        mcovg       mean        meanc       meanr       median        mexp        mgradient   min         minc        minr        missing     misszero    mlag        mlincomb    mnormal        mols        monthlen    movavg      mpols       mrandgen        mread       mreverse    mrls        mshape      msortby        muniform    mweights    mwrite      mxtab       naalen        nadarwat    nelem       ngetenv     nlines      NMmax        NMmin       nobs        normal      normtest    npcorr        npv         NRmax       NRmin       nullspace   numhess        obs         obslabel    obsnum      ok          onenorm        ones        orthdev     pdf         pergm       pexpand        pmax        pmean       pmin        pnobs       polroots        polyfit     princomp    prodc       prodr       psd        psdroot     pshrink     psum        pvalue      pxnobs        pxsum       qform       qlrpval     qnorm       qrdecomp        quadtable   quantile    randgen     randgen1    randint        rank        ranking     rcond       readfile    regsub        remove      replace     resample    round       rownames        rows        sd          sdc         sdiff       seasonals        selifc      selifr      seq         setnote     simann        sin         sinh        skewness    sleep       smplspan        sort        sortby      sprintf     sqrt        square        sscanf      sst         stringify   strlen      strncmp        strsplit    strstr      strstrip    strsub      strvals        substr      sum         sumall      sumc        sumr        svd         tan         tanh        toepsolv    tolower        toupper     tr          transp      trimr       typeof        typestr     uniform     uniq        unvech      upper        urcpval     values      var         varname     varnames        varnum      varsimul    vec         vech        weekday        wmean       wsd         wvar        xmax        xmin        xmlget      zeromiss    zeros&quot;
line1 = &quot;acos acosh asin asinh atan atanh cos cosh &quot;
line2 = &quot;digamma exp gammafun lngamma log log10 log2 &quot;
line3 = &quot;logistic sin sinh sqrt tan tanh&quot;
text2 = line1~line2~line3
noar = str_setdiff(text1,text2)
return noar
</code>
</gretl-function>
<gretl-function name="uniqfunlist" type="string" private="1">
 <params count="1">
  <param name="fla" type="string"/>
 </params>
<code>fla2 = &quot;#&quot;~fla~&quot;#&quot;
chars = &quot;qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM&quot;
digits = &quot;0123456789&quot;
lefla = strlen(fla2)
matrix charmap = zeros(lefla,1)
matrix digmap = charmap
matrix bramap = charmap
matrix undmap = charmap
loop i = 1..lefla -q
  chari = substr(fla2,i,i)
  if strlen(strstr(chars,chari))
    charmap[i] =  1
  endif
  if strlen(strstr(digits,chari))
    digmap[i] =  1
  endif
  if chari == &quot;_&quot;
    undmap[i] = 1
  endif
  #if (chari == &quot;(&quot;)||(chari == &quot;[&quot;)
  if (chari == &quot;[&quot;)
    bramap[i] = 1
  endif
endloop
all_charmap = charmap + digmap + undmap
matrix seql = seq(0,lefla-1)'
matrix begins = seql .*(diff(all_charmap).&gt; 0)
matrix ends = seql.*mlag((diff(all_charmap).&lt; 0),-1)
if  sumc(uniq(begins))
  matrix numbegins = uniq(begins)[2:]
  matrix numends = uniq(ends)[2:]
  smalln = nelem(numends)
  ret = &quot;&quot;
  strings rets
  loop i =1..smalln -q
    summ = 0
    reti = substr(fla,numbegins[i],numends[i])
    #print reti
    nofun = substr(fla,numends[i]+1,numends[i]+1)!=&quot;(&quot;
    if !nofun
      if i==1
        rets +=reti
        ret = ret~&quot; &quot;~reti
      else
        nrets = nelem(rets)
        summ = 0
        loop j=1..nrets -q
          summ += reti == rets[j]
        endloop
        if !(digmap[numbegins[i]+1]+bramap[numends[i]+2]+summ)
          rets +=reti
          ret = ret~&quot; &quot;~reti
        endif
      endif
    endif
  endloop
  return strstrip(ret)
else
  return &quot;_empty&quot;
endif
</code>
</gretl-function>
<gretl-function name="vf" type="scalar" private="1">
 <params count="1">
  <param name="descr" type="string"/>
 </params>
<code>nv = $nvars
list li = seq(1,nv-1)
vns = varname(li)
vns = strsub(vns,&quot;,&quot;,&quot; &quot;)
#print vns
descr0 = strsub(descr,&quot; &quot;,&quot;&quot;)
vars = uniqvarlist(descr)
vars0 = uniqvarlist(descr0)
#print vars vars0
ret = 1
funs = &quot;&quot;
if vars != vars0
  return 0
elif vars == &quot;_empty&quot;
  return 0
else
  funs = uniqfunlist(descr)
  #print funs
  noar = no_arith()
  matrix noaris = findinds(funs,noar)
  if nelem(noaris) &gt; 0
    if max(noaris) &gt; 0
      return 0
    endif
  endif
endif
#print vars funs
ck11 = strlen(strstr(descr,&quot;=&quot;))
ck12 = strlen(strstr(descr,&quot;&lt;&quot;))
ck13 = strlen(strstr(descr,&quot;&gt;&quot;))
if (ck11 + ck12 + ck13) &gt; 0
  ret = 0
endif
#print ret
return ret
</code>
</gretl-function>
<gretl-function name="disuspect" type="string" private="1">
 <params count="1">
  <param name="vname" type="string"/>
 </params>
<code>firstcheck = strlen(strstr(vname,&quot;_&quot;))
if firstcheck == 0
  return &quot;_empty&quot;
endif
vnn = strlen(vname)
matrix posi = {}
j = 0
loop i = 1..vnn -q
  if substr(vname,i,i) == &quot;_&quot;
    posi = posi~i
    j++
  endif
endloop
pref = substr(vname,1,posi[j]-1)
suff = &quot;&quot;
if posi[j] &lt; vnn
  suff = substr(vname,posi[j]+1,vnn)
endif
if strlen(suff) == 0
  return &quot;_empty&quot;
endif
nsu = atof(suff)
isnasu = missing(nsu)
if isnasu
  return &quot;_empty&quot;
endif
zck = nsu == round(nsu)
if zck == 0
  return &quot;_empty&quot;
endif
if nsu &lt;= 0
  return &quot;_empty&quot;
endif
suff2 = sprintf(&quot;%d&quot;,nsu)
if suff != suff2
  return &quot;_empty&quot;
else
  return pref~&quot; &quot;~suff
endif
</code>
</gretl-function>
<sample-script>
include a_eff.gfn
open greene22_2.gdt --quiet
gretl_version = $version

    set echo on
    list z_small = Z* -Z5
    Ymlog = 1+ (Y &gt; 0) + (Y &gt; 1)
    ###
    ### marginal effects after multinomial logit
    ### with group dummies and a nonlinear function
    ### of a continuous variable
    #

    logit Ymlog 0 z_small square(Z2) dummify(Z5) --multinomial
    bundle b_ml = $model
    mfx(&amp;b_ml)

    ###
    ### marginal effects after tobit
    ### at different data points for subset of variables
    #

    tobit Y 0 z_small square(Z2) dummify(Z5)
    #
    # b[sq_Z2] has the expected sign but is insignificant,
    # multicollinearity?
    # after tobit Y 0 Z1 Z2 square(Z2) p-value for sq_Z2 is 0.0032
    #
    bundle b_t = $model
    formula = smart_formula2($xlist)
    #
    # note: you can set either one of &quot;at = Z1&quot; or &quot;wrt = Z8&quot;,
    # or the both
    #
    mfx(&amp;b_t,formula,&quot;wrt = Z3 Z2; at = Z1 Z2 Z5 Z8&quot;, {1,52,2,1})
    #
    # with the same marriage Z2 and Z3 grow at the same rate
    # so Y grows even at Z1 = 1 and Z2 = 52!
    #
    # for E(y|lb&lt;y&lt;rb)
    #
    mfx(&amp;b_t,formula,&quot;wrt = Z2; type = inside&quot;)
    #
    ### elasticities
    #
    # for E(y)
    #
    eyex(&amp;b_t,formula,&quot;wrt = Z2 Z3; at = Z2 Z3 Z5&quot;,{30,10,2})
    #
    # for E(y|lb&lt;y&lt;rb)
    #
    eyex(&amp;b_t,formula,&quot;wrt = Z2; type = inside; at = Z5&quot;,{2})


    ###
    ### Translog production function:
    ### tricks with smart_formula2(), double_formula(),
    ### and 'type' parameter to compute
    ### different kinds of effects

    ## creating artifical data for translog production function
    #
    set seed 13
    K = normal(0,3)
    K = K - min(K)+3+uniform()
    L = normal(0,2)
    L =  0.4*K + K/10*normal(0,1)
    logs L K
    list p_fact = l_K l_L
    list squar = square(p_fact,1)
    list xxlist = 0 p_fact squar
    beta = {1,0.946,1.254,-0.108,-0.063,-0.108}
    l_Q = lincomb(xxlist,beta)+normal(0,0.05)

    # Cobb -- Douglas
    #
    ols l_Q 0 p_fact --simple-print
    reset --squares-only -q

    # Translog
    #
    ols l_Q xxlist --simple-print
    bundle b_trl = $model
    #
    # here we have 2-stage variables creation: logs then squared logs
    # so default smart_formula2($xlist) does not work as desirable
    #
    eval smart_formula2($xlist)
    #
    # then we force l_K and l_L to be independent variables
    #
    efla = smart_formula2($xlist,p_fact)

    eval efla
    #
    # the next line wil get elasticities of output wrt. factors
    # at means of their logs
    #
    mfx(&amp;b_trl,efla)
    #
    # at sample minima and maxima
    #
    bundle bm = mfx(&amp;b_trl,efla,&quot;at = l_L l_K&quot;,{min(l_L),min(l_K)})
    #
    # Confidence intervals:
    #
    eval eff_confint(&amp;bm)
    # note that we can test hypotheses in terms of
    # effects directly:
    # Copy-paste code region between '/*' and '/*'
    # into new script editor window to run
    # (requires waldTest.gfn v. &gt;= 1.1 installed)
    /*
       include waldTest.gfn
       nlwaldtest(&quot;b[1]+b[2]=1&quot;,&amp;bm)
    */

    mfx(&amp;b_trl,efla,&quot;at = l_L l_K&quot;,{max(l_L),max(l_K)})

    # double_fla() can deal with 2-stage variables creation:
    mfla = double_formula($xlist)
    eval mfla

    # the next line wil get marginal effects of output wrt. factors
    # at means

    mfx(&amp;b_trl,mfla,&quot;type = exp&quot;)

    #
    ### heckit
    #
    open mroz87.gdt --quiet
    kidsi = ((KL6+K618) == 0)+ 2*((KL6+K618) == 1) +3*((KL6+K618) &gt; 1)

    heckit WW 0 WE AX; LFP 0 WA WE dummify(kidsi) MTR
    b_he = $model
    #
    # y conditional
    #
    mfx(&amp;b_he,null,&quot;wrt = kidsi&quot;)
    #
    # y expected
    #
    mfx(&amp;b_he,null,&quot;wrt = WE; type = Ey&quot;)
    
    eyex(&amp;b_he,null,&quot;wrt = AX; type = Ey&quot;)
</sample-script>
</gretl-function-package>
</gretl-functions>
