s_nlp_hclust Subroutine

public impure subroutine s_nlp_hclust(x, nd, nv, nc, gm, cm, cl, cc, cov, sigma)

Impure wrapper procedure for s_nlp_hclust_core.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: x(nd,nv)

input data matrix (samples, variables)
integer(kind=i4), intent(in) :: nd

number of data points
integer(kind=i4), intent(in) :: nv

number of variables
integer(kind=i4), intent(in) :: nc

number of clusters (target)
real(kind=wp), intent(out) :: gm(nv)

global means for each variable
real(kind=wp), intent(out) :: cm(nv,nc)

cluster centroids
integer(kind=i4), intent(out) :: cl(nd)

cluster assignments for each data point
integer(kind=i4), intent(out) :: cc(nc)

cluster sizes
real(kind=wp), intent(out) :: cov(nv,nv)

covariance matrix
real(kind=wp), intent(out) :: sigma(nv)

standard deviation per variable

Calls

proc~~s_nlp_hclust~~CallsGraph proc~s_nlp_hclust s_nlp_hclust proc~s_err_print s_err_print proc~s_nlp_hclust->proc~s_err_print proc~s_err_warn s_err_warn proc~s_nlp_hclust->proc~s_err_warn proc~s_nlp_hclust_core s_nlp_hclust_core proc~s_nlp_hclust->proc~s_nlp_hclust_core proc~f_utl_r2c f_utl_r2c proc~s_err_print->proc~f_utl_r2c proc~s_err_warn->proc~f_utl_r2c proc~f_lin_mahalanobis_core f_lin_mahalanobis_core proc~s_nlp_hclust_core->proc~f_lin_mahalanobis_core proc~f_sts_cov_core f_sts_cov_core proc~s_nlp_hclust_core->proc~f_sts_cov_core proc~f_sts_mean_core f_sts_mean_core proc~s_nlp_hclust_core->proc~f_sts_mean_core proc~f_sts_var_core f_sts_var_core proc~s_nlp_hclust_core->proc~f_sts_var_core proc~s_utl_sort s_utl_sort proc~s_nlp_hclust_core->proc~s_utl_sort proc~f_lin_mahalanobis_core->proc~f_sts_cov_core proc~s_utl_cholesky_solve s_utl_cholesky_solve proc~f_lin_mahalanobis_core->proc~s_utl_cholesky_solve proc~f_sts_cov_core->proc~f_sts_mean_core proc~f_sts_var_core->proc~f_sts_mean_core chol chol proc~s_utl_cholesky_solve->chol

Called by

proc~~s_nlp_hclust~~CalledByGraph proc~s_nlp_hclust s_nlp_hclust interface~fsml_hclust fsml_hclust interface~fsml_hclust->proc~s_nlp_hclust

Source Code

impure subroutine s_nlp_hclust(x, nd, nv, nc, gm, cm, cl, cc, cov, sigma)

! ==== Description
!! Impure wrapper procedure for `s_nlp_hclust_core`.

! ==== Declarations
  real(wp)   , intent(in)  :: x(nd, nv)  !! input data matrix (samples, variables)
  integer(i4), intent(in)  :: nd         !! number of data points
  integer(i4), intent(in)  :: nv         !! number of variables
  integer(i4), intent(in)  :: nc         !! number of clusters (target)
  real(wp)   , intent(out) :: gm(nv)     !! global means for each variable
  real(wp)   , intent(out) :: cm(nv,nc)  !! cluster centroids
  integer(i4), intent(out) :: cl(nd)     !! cluster assignments for each data point
  integer(i4), intent(out) :: cc(nc)     !! cluster sizes
  real(wp)   , intent(out) :: cov(nv,nv) !! covariance matrix
  real(wp)   , intent(out) :: sigma(nv)  !! standard deviation per variable

! ==== Instructions

! ---- handle input

  ! check if argument values are valid - data points
  if (nd .le. 1) then
     ! write error message and assign sentinel value if invalid
     call s_err_print(fsml_error(1))
     gm    = c_sentinel_r
     cm    = c_sentinel_r
     cov   = c_sentinel_r
     sigma = c_sentinel_r
     cl    = c_sentinel_i
     cc    = c_sentinel_i
     return
  endif

  ! issue warning for small datasets
  if (nd .le. 15) then
     ! write error message and assign sentinel value if invalid
     call s_err_warn("[fsml warning] hcluster: small datasets can create&
                    & problems with Cholesky fractionisation.")
  endif

  ! check if argument values are valid - variable/feature number
  if (nv .lt. 1) then
     ! write error message and assign sentinel value if invalid
     call s_err_print(fsml_error(1))
     gm    = c_sentinel_r
     cm    = c_sentinel_r
     cov   = c_sentinel_r
     sigma = c_sentinel_r
     cl    = c_sentinel_i
     cc    = c_sentinel_i
     return
  endif

  ! check if argument values are valid - cluster number
  if (nc .lt. 1) then
     ! write error message and assign sentinel value if invalid
     call s_err_print(fsml_error(1))
     gm    = c_sentinel_r
     cm    = c_sentinel_r
     cov   = c_sentinel_r
     sigma = c_sentinel_r
     cl    = c_sentinel_i
     cc    = c_sentinel_i
     return
  endif

  ! check if argument values are valid - cluster number must be smaller than data points
  if (nc .gt. nd) then
     ! write error message and assign sentinel value if invalid
     call s_err_print("[fsml error] hcluster: cluster number must be&
                    & equal or less than number of data points.")
     gm    = c_sentinel_r
     cm    = c_sentinel_r
     cov   = c_sentinel_r
     sigma = c_sentinel_r
     cl    = c_sentinel_i
     cc    = c_sentinel_i
     return
  endif

! ---- compute clusters

  ! call pure procedure
  call s_nlp_hclust_core(x, nd, nv, nc, gm, cm, cl, cc, cov, sigma)

end subroutine s_nlp_hclust