s_nlp_kmeans Subroutine

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

Impure wrapper procedure for s_nlp_kmeans_core.

Arguments

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

raw data (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
real(kind=wp), intent(in) :: cm_in(nv,nc)

initial centroids (raw, not standardised)
real(kind=wp), intent(out) :: gm(nv)

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

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

cluster assignments
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 deviations per variable
real(kind=wp), intent(in), optional :: cov_in(nv,nv)

optional covariance matrix

Calls

proc~~s_nlp_kmeans~~CallsGraph proc~s_nlp_kmeans s_nlp_kmeans proc~s_err_print s_err_print proc~s_nlp_kmeans->proc~s_err_print proc~s_err_warn s_err_warn proc~s_nlp_kmeans->proc~s_err_warn proc~s_nlp_kmeans_core s_nlp_kmeans_core proc~s_nlp_kmeans->proc~s_nlp_kmeans_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_kmeans_core->proc~f_lin_mahalanobis_core proc~f_sts_cov_core f_sts_cov_core proc~s_nlp_kmeans_core->proc~f_sts_cov_core proc~f_sts_mean_core f_sts_mean_core proc~s_nlp_kmeans_core->proc~f_sts_mean_core proc~f_sts_var_core f_sts_var_core proc~s_nlp_kmeans_core->proc~f_sts_var_core proc~s_utl_sort s_utl_sort proc~s_nlp_kmeans_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_kmeans~~CalledByGraph proc~s_nlp_kmeans s_nlp_kmeans interface~fsml_kmeans fsml_kmeans interface~fsml_kmeans->proc~s_nlp_kmeans

Source Code

impure subroutine s_nlp_kmeans(x, nd, nv, nc, cm_in, gm, cm, cl, cc, &
                             & cov, sigma, cov_in)

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

! ==== Declarations
  real(wp)   , intent(in)            :: x(nd, nv)      !! raw data (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
  real(wp)   , intent(in)            :: cm_in(nv,nc)   !! initial centroids (raw, not standardised)
  real(wp)   , intent(out)           :: cm(nv, nc)     !! centroids (refined, standardised)
  real(wp)   , intent(out)           :: gm(nv)         !! global means
  integer(i4), intent(out)           :: cl(nd)         !! cluster assignments
  integer(i4), intent(out)           :: cc(nc)         !! cluster sizes
  real(wp)   , intent(out)           :: cov(nv,nv)     !! covariance matrix
  real(wp)   , intent(out)           :: sigma(nv)      !! standard deviations per variable
  real(wp)   , intent(in) , optional :: cov_in(nv,nv)  !! optional covariance matrix

! ==== 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] k-means: 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] k-means: 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_kmeans_core(x, nd, nv, nc, cm_in, gm, cm, cl, cc, &
                       & cov, sigma, cov_in=cov_in)

end subroutine s_nlp_kmeans