cleaner = function(dlist, isel=NULL, ilab=NULL, dsel=NULL, dlab=NULL, csel=NULL,
                   how_sort="none", tot_sort=FALSE, theta=seq(-6,6,0.1),highlight=NULL,
                   empirical=NULL,empbins=NULL, empcuts=NULL, smoothargs=NULL, smoothrange=NULL,
                   debug=TRUE){
  
  drange = function(x,na.rm=TRUE) diff(range(x,na.rm=na.rm))

  if (debug) message("Entering cleaner...")
  
  data = attributes(dlist)$data

# ============================================================== TODO: !
#  Fehler in attr(ilab, "was.null") <- TRUE :
#  Versuch ein Attribut von NULL zu setzen
#  if no colnames were provided. pcmodel handles it, but not plotPIccc!
# =====================================================================

  if (is.null(ilab)) {
         ilab = names(dlist$freq)
         attr(ilab, "was.null") = TRUE
  } else {
        attr(ilab, "was.null") = FALSE
        if (length(ilab) > length(dlist$freq)) {
          stop(paste("Too many item labels:",length(ilab),"labels for",length(dlist$freq),"items."))
        } else if (length(ilab) < length(dlist$freq)) {
          stop(paste("Too few item labels:",length(ilab),"labels for",length(dlist$freq),"items."))
        } else if (length(unique(ilab)) < length(ilab)) {
          print(sort(table(ilab)))
          stop(paste("Non-unique item labels."))
        } # end else
  } # end else (not is.null)

  if (!attributes(ilab)$was.null) {
      if ((length(dlist)-1) > 1) {
        stop("Item names cannot be modified for multi-dimensional models.\nYou might want to consider renaming of original data.")
      } else {
        colnames(dlist[[1]]$thresholds)     = ilab
        colnames(dlist[[1]]$discrimination) = ilab
           names(dlist[[1]]$guessing)       = ilab
           names(dlist[[1]]$laziness)       = ilab
           names(dlist[[1]]$model)          = ilab
           names(dlist$freq)                = ilab
        colnames(data)                      = ilab
      } # end else = rename
  } # end rename required

  freq = dlist$freq  # temporarily "outsourced"
  dlist$freq = NULL  # so that length of dlist = no. of dims.!

  if (all(is.null(isel),is.null(dsel),is.null(dlab)))  {  # no user changes

    dlist_sel_itm = dlist
    isel = unlist(lapply(sapply(dlist,"[","thresholds"),colnames))

  } else {     # any changes (isel, dsel, dlab)
    
    # --- 0. Dimension and item labels

    if     (is.null(dlab))                   dlab = names(dlist)
    else if(length(dlab) != length(dlist))   stop(paste0("Invalid length of dlab. \nNumber of labels must equal number of dimensions.\nLabels: ", length(dlab), ", dimensions:", length(dlist), "."),call.=FALSE)
    else if(!is.character(dlab))             dlab = as.character(dlab) 
    
    names(dlist) = dlab
    
    # --- 1. Select dimensions

    if (is.null(dsel)) {

      dlist_sel_dim = dlist

    }else{        # execute dsels
      
      if(anyNA(dsel))           stop("Invalid Input for dsel: Missing values (NA) are not accepted." )
      if(any(duplicated(dsel))) stop("Invalid Input for dsel: Same dimension was selected multiple times.")
      
      if(is.character(dsel)){
        if(all(dsel %in% dlab)){

#         dlist_sel_dim = dlist[dlab]
          dlist_sel_dim = dlist[dsel]  # RWA 23-06-19
          
        }else stop(paste0("Dimension selection did not work: Non-matching dsel values \ndsel: ", dsel, "\ndimension labels: ", dlab, "\n"))
        
      }else if(is.numeric(dsel)){
        
        if(!all(is.int(dsel)))        stop("Invalid Input for dsel: All values need to be integers.", call. = FALSE)
        if(any(dsel <= 0))            stop("Invalid Input for dsel: Only positive integers allowed.", call. = FALSE)
        if(any(dsel > length(dlist))) stop(paste0("Invalid Input: dsel ",dsel," exceeds total number of dimensions (",length(dlist),")"))
        
        dlist_sel_dim = dlist[dsel]
#        isel = unlist(lapply(sapply(dlist_sel_dim,"[","thresholds"),colnames))
        
      } # end of if input was numeric
      
    } # end if/else dimension selection
    
    # --- 2. Select items (selection string character)

    if(is.null(isel)){

       dlist_sel_itm = dlist_sel_dim  # no item selection: is.null(isel)
       isel = unlist(lapply(sapply(dlist_sel_dim,"[","thresholds"),colnames))

    } else {  # execute isels

      dlist_sel_itm = vector(mode="list", length=length(dlist_sel_dim)) 
      names(dlist_sel_itm) = names(dlist_sel_dim)
      
      if(anyNA(isel) != 0)        stop("Invalid Input for isel! Missing values (NA) are not accepted." )
      if(anyDuplicated(isel)!= 0) stop("Invalid Input for isel! Same Items were selected multiple times.")
      if(is.numeric(isel)) isel = ilab[isel]    # convert numeric indices to label strings

      for(d in seq_along(dlist_sel_dim)){

          i_lab = colnames(dlist_sel_dim[[d]]$thresholds)
          isitm = i_lab %in% isel

          if (sum(isitm)==0) {
               warning(paste0("\nItem '", isel[!(isel %in% i_lab)], "' not found in dimension ", d, " (", dlab[d], ")." ), call. = FALSE)
               dlist_sel_itm[[d]] = NA  # not NULL here -- loop counter d!
          }else{
               dlist_sel_itm[[d]]$thresholds     = dlist_sel_dim[[d]]$thresholds    [,isitm, drop=FALSE]
               dlist_sel_itm[[d]]$discrimination = dlist_sel_dim[[d]]$discrimination[,isitm, drop=FALSE]
               dlist_sel_itm[[d]]$guessing       = dlist_sel_dim[[d]]$guessing      [ isitm ]
               dlist_sel_itm[[d]]$laziness       = dlist_sel_dim[[d]]$laziness      [ isitm ]
               dlist_sel_itm[[d]]$model          = dlist_sel_dim[[d]]$model         [ isitm ]
               dlist_sel_itm[[d]]$person_par     = dlist_sel_dim[[d]]$person_par
               
               dlist_sel_itm[[d]]$SE_par$se.thresholds     = dlist_sel_dim[[d]]$SE_par$se.thresholds    [ isitm, , drop=FALSE]
               dlist_sel_itm[[d]]$SE_par$se.discrimination = dlist_sel_dim[[d]]$SE_par$se.discrimination[,isitm, drop=FALSE]
               dlist_sel_itm[[d]]$SE_par$se.guessing       = dlist_sel_dim[[d]]$SE_par$se.guessing[ isitm ]
               dlist_sel_itm[[d]]$SE_par$se.laziness       = dlist_sel_dim[[d]]$SE_par$se.laziness[ isitm ]
                 
          }# end of if/else isitm valid
          
          

      } # for d

    } # end if/else isel=NULL

  } # end of if/else all _sel=NULL
  

  dlist_sel_itm[is.na(dlist_sel_itm)] = NULL # eliminate unused dims
  freq_sel = freq[isel]
  data = data[,isel,drop=FALSE]

  # --- sorting
  ks = unlist(lapply(lapply(dlist_sel_itm,"[[","thresholds"),ncol)) # items/dim
  sortvec = 1:sum(ks)
  sortopt = c("mean","median","var","min","max","range","disc","guess","lazy", "none")
  sorterr = paste0("Invalid sorting option '",how_sort,"'.\n  Use one out of: ",paste(sortopt,collapse="/"),".\n  No sorting will be performed.")

  if (length(how_sort) == 1 & how_sort != "none") { # any sorting wishes?

      if (how_sort %in% sortopt) {
           D0 = length(dlist_sel_itm)

           if(tot_sort){ # over all dimensions (total sort) ?

                tx = NULL
                dx = NULL
                gx = NULL
                lx = NULL
                for(d in 1:D0) {
                    tx = cbind(tx,dlist_sel_itm[[d]]$thresholds)
                    dx = cbind(dx,dlist_sel_itm[[d]]$discrimination)
                    gx =     c(gx,dlist_sel_itm[[d]]$guessing)
                    lx =     c(lx,dlist_sel_itm[[d]]$laziness)
                } # end for d
                sortvec = switch(how_sort,
                                 "mean"   = rank(colMeans(tx         ,na.rm=TRUE),ties.method="first"),
                                 "median" = rank(   apply(tx,2,median,na.rm=TRUE),ties.method="first"),
                                 "var"    = rank(   apply(tx,2,var   ,na.rm=TRUE),ties.method="first"),
                                 "min"    = rank(   apply(tx,2,min   ,na.rm=TRUE),ties.method="first"),
                                 "max"    = rank(   apply(tx,2,max   ,na.rm=TRUE),ties.method="first"),
                                 "range"  = rank(   apply(tx,2,drange,na.rm=TRUE),ties.method="first"),
                                 "disc"   = rank(colMeans(dx         ,na.rm=TRUE),ties.method="first"),
                                 "guess"  = rank(         gx                     ,ties.method="first"),
                                 "lazy"   = rank(         lx                     ,ties.method="first")
                                 ) # end switch
           }else {  # sort per dimension

                sortvec = NULL
                kk = c(0,cumsum(ks))
                for (d in 1:D0) {
                     sortmodel = unique(dlist_sel_itm[[d]]$model)
                     if (length(sortmodel) > 1) {

                       warning(paste0("Mixed model types currently not supported (",sortmodel,"). No sorting will be performed for dimension",d,".\n"))

                     } else { # only items of the same type present

                       if (how_sort=="disc"  & length(unique(as.vector(dlist_sel_itm[[d]]$discrimination)))==1)             message(       "Note: Sorting by discrimination parameter has no effect if all items have equal discrimination parameter values.\n")
                       if (how_sort=="guess" & length(unique(as.vector(dlist_sel_itm[[d]]$guessing)))==1)                   message(       "Note: Sorting by guessing parameter has no effect if all items have equal guessing parameter values.\n")
                       if (how_sort=="lazy"  & length(unique(as.vector(dlist_sel_itm[[d]]$laziness)))==1)                   message(       "Note: Sorting by laziness parameter has no effect if all items have equal laziness parameter values.\n")
                       if (sortmodel %in% c("Rasch","2PL","3PL","3PLu","4PL") & how_sort %in% c("var","min","max","range")) message(paste0("Note: Sorting by variance, min, max, and range will have no effect for model ",sortmodel,".\n"))

                       # TODO: adapt model names for eRm, ltm, psychotools, TAM

                       if (how_sort=="mean" )  sortvec = c(sortvec, kk[d] + rank(colMeans(dlist_sel_itm[[d]]$thresholds         ,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="median") sortvec = c(sortvec, kk[d] + rank(   apply(dlist_sel_itm[[d]]$thresholds,2,median,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="var"  )  sortvec = c(sortvec, kk[d] + rank(   apply(dlist_sel_itm[[d]]$thresholds,2,var   ,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="min"  )  sortvec = c(sortvec, kk[d] + rank(   apply(dlist_sel_itm[[d]]$thresholds,2,min   ,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="max"  )  sortvec = c(sortvec, kk[d] + rank(   apply(dlist_sel_itm[[d]]$thresholds,2,max   ,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="range")  sortvec = c(sortvec, kk[d] + rank(   apply(dlist_sel_itm[[d]]$thresholds,2,drange,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="disc" )  sortvec = c(sortvec, kk[d] + rank(colMeans(dlist_sel_itm[[d]]$discrimination     ,na.rm=TRUE),ties.method="first"))
                       if (how_sort=="guess")  sortvec = c(sortvec, kk[d] + rank(         dlist_sel_itm[[d]]$guessing                       ,ties.method="first"))
                       if (how_sort=="lazy" )  sortvec = c(sortvec, kk[d] + rank(         dlist_sel_itm[[d]]$laziness                       ,ties.method="first"))

                     } # end else (items of same type)

                       # TODO: GRM/dicho --> error
                       # TODO: NRM/dicho --> no sorting (poly?)
                       # TODO: variance  --> only polytomous!

                       # warning: sort result will not be visible

                } # end for d
           } # ende else (= sort per dim
      }else warning(sorterr) # end valid sort option
  } # end any sorting wishes

  dlist_final = dlist_sel_itm

  # --- calculate iif and prob

  dlist_final[is.na(dlist_final)] = NULL
  D = length(dlist_final)
  
  # --- calculate TIF for all (also not selected) items
  for(d in 1:D){

  # k  = dim(dlist[[d]]$thresholds)[2]      MK 14.04.2024: use dlist_final (not dlist without selection)
    k  = dim(dlist_final[[d]]$thresholds)[2]  # final list with selected items
    kf = dim(dlist[[d]]$thresholds)[2]        # original
    
    test_info     = matrix(NA,nrow=length(theta),ncol=k)
    test_info_all = matrix(NA,nrow=length(theta),ncol=kf)
    check = rep(NA, k) # for csel
    


    dlist_final[[d]]$OBS = calc_obs(X=data, perspar=na.omit(dlist_final[[d]]$person_par), empbins = empbins, empcuts = empcuts)
 
    dlist_final[[d]]$SMOspline = calc_smo(cat_freqlist = dlist_final[[d]]$OBS, sortperspar = attributes(dlist_final[[d]]$OBS)$sort_perspar,
                                    smoothargs=smoothargs, smoothrange=smoothrange, smooth = "spline") 
    
    dlist_final[[d]]$SMOloess  = calc_smo(cat_freqlist = dlist_final[[d]]$OBS, sortperspar = attributes(dlist_final[[d]]$OBS)$sort_perspar,
                                     smoothargs=smoothargs, smoothrange=smoothrange, smooth = "loess") 
    
    
    # --- selected list for sTIF & sSE
    
    for(j in 1:k){
      if      (       dlist_final[[d]]$model[j]        == "nominal")        test_info[,j] = with(dlist_final[[d]], info_nom(diff =thresholds[,j], alpha=discrimination[,j], theta=theta))$iif
      else if (       dlist_final[[d]]$model[j] %in% c("graded","grsmIRT")) test_info[,j] = with(dlist_final[[d]], info_sam(thres=thresholds[,j], alpha=discrimination[,j], theta=theta))$iif
      else if (length(dlist_final[[d]]$thresholds[,j]) == 1)                test_info[,j] = with(dlist_final[[d]], info_4pl(thres=thresholds[,j], alpha=discrimination[,j], theta=theta, gamma=guessing[j], upper=laziness[j]))$iif
      else                                                                  test_info[,j] = with(dlist_final[[d]], info_mas(thres=thresholds[,j], alpha=discrimination[,j], theta=theta, gamma=guessing[j], graded=FALSE))$iif
    } # end of j
    
    # --- original list for TIF & SE
    
    for(j in 1:kf){
      if      (       dlist[[d]]$model[j]        == "nominal")              test_info_all[,j] = with(dlist[[d]], info_nom(diff =thresholds[,j], alpha=discrimination[,j], theta=theta))$iif
      else if (       dlist[[d]]$model[j] %in% c("graded","grsmIRT"))       test_info_all[,j] = with(dlist[[d]], info_sam(thres=thresholds[,j], alpha=discrimination[,j], theta=theta))$iif
      else if (length(dlist[[d]]$thresholds[,j]) == 1)                      test_info_all[,j] = with(dlist[[d]], info_4pl(thres=thresholds[,j], alpha=discrimination[,j], theta=theta, gamma=guessing[j], upper=laziness[j]))$iif
      else                                                                  test_info_all[,j] = with(dlist[[d]], info_mas(thres=thresholds[,j], alpha=discrimination[,j], theta=theta, gamma=guessing[j], graded=FALSE))$iif
    } # end of 

    dlist_final[[d]]$TIF = rowSums(test_info_all)
    dlist_final[[d]]$SE  = sqrt(1/rowSums(test_info_all))
    dlist_final[[d]]$REL = dlist_final[[d]]$TIF /(1 + dlist_final[[d]]$TIF) # OConnor, 2018, p.993, eq.6
    
    dlist_final[[d]]$sTIF = rowSums(test_info)
    dlist_final[[d]]$sSE  = sqrt(1/rowSums(test_info))
    dlist_final[[d]]$sREL = dlist_final[[d]]$sTIF / (1 + dlist_final[[d]]$sTIF)
  } # end of d for all TIF

  for (d in 1:D) {
    
     k = dim(dlist_final[[d]]$thresholds)[2]
     test_info = matrix(NA,nrow=length(theta),ncol=k)
     
      
     for (j in 1:k) {
        if (dlist_final[[d]]$model[j] == "nominal") {

          prob = with(dlist_final[[d]], calc_nom(diff=thresholds[,j], alpha=discrimination[,j], theta=theta))
          dlist_final[[d]]$CCC[[j]] = prob$prob_ccc
          dlist_final[[d]]$TCC[[j]] = prob$prob_tcc

          temp = with(dlist_final[[d]], info_nom(diff=thresholds[,j], alpha=discrimination[,j], theta=theta))
          dlist_final[[d]]$CIF[[j]] = temp$cif
          dlist_final[[d]]$IIF[[j]] = matrix(temp$iif,length(theta),1)
          test_info[,j]             = temp$iif

        } else if (dlist_final[[d]]$model[j]%in% c("graded","grsmIRT")) {
          
          prob = with(dlist_final[[d]], calc_ccc(delta=thresholds[,j], alpha=discrimination[,j], gamma=guessing[j], graded=TRUE, theta=theta))
          dlist_final[[d]]$CCC[[j]] = prob$prob_ccc
          dlist_final[[d]]$TCC[[j]] = prob$prob_tcc
          
          temp = with(dlist_final[[d]], info_sam(thres=thresholds[,j], alpha=discrimination[,j], theta=theta))
          dlist_final[[d]]$CIF[[j]] = temp$cif
          dlist_final[[d]]$IIF[[j]] = matrix(temp$iif,length(theta),1)
          test_info[,j]             = temp$iif
          
        } else if(length(dlist_final[[d]]$thresholds[,j])==1){  # dichotom (for upper and gamma)
          
          prob = with(dlist_final[[d]], calc_ccc(delta=thresholds[,j], alpha=discrimination[,j], gamma=guessing[j], graded=FALSE, theta=theta))
          dlist_final[[d]]$CCC[[j]] = prob$prob_ccc
          dlist_final[[d]]$TCC[[j]] = prob$prob_tcc
          
          temp = with(dlist_final[[d]], info_4pl(thres=thresholds[,j], alpha=discrimination[,j], gamma=guessing[j], upper=laziness[j], theta=theta))
          dlist_final[[d]]$CIF[[j]] = temp$cif
          dlist_final[[d]]$IIF[[j]] = matrix(temp$iif,length(theta),1)
          test_info[,j]             = temp$iif
          
        }else{   # PCM, GPCM
          
          prob = with(dlist_final[[d]], calc_ccc(delta=thresholds[,j], alpha=discrimination[,j], gamma=guessing[j], graded=FALSE, theta=theta))
          dlist_final[[d]]$CCC[[j]] = prob$prob_ccc
          dlist_final[[d]]$TCC[[j]] = prob$prob_tcc
          
          temp = with(dlist_final[[d]], info_mas(thres=thresholds[,j], alpha=discrimination[,j], gamma=guessing[j], graded=FALSE, theta=theta))
          dlist_final[[d]]$CIF[[j]] = temp$cif
          dlist_final[[d]]$IIF[[j]] = matrix(temp$iif,length(theta),1)
          test_info[,j]             = temp$iif
          
        } # end else
       
       # expected total score function (ESC)
       
       dlist_final[[d]]$ESC[[j]] = emp_score(ccc=dlist_final[[d]]$CCC[[j]])
       
       if(!is.null(csel)){
        
         stopifnot(is.numeric(csel))
         if(any(csel<=0)) stop("Invalid csel argument! Please use values >= 1.")
         
         
         iscat = csel > ncol(dlist_final[[d]]$CCC[[j]])   # has the user selected invalid categories (itemwise)
         check[j] = all(iscat)
         
         
         if (length(iscat) == 1){
           if(iscat){
             catsel=1:ncol(dlist_final[[d]]$CCC[[j]])
             warning(paste0("'csel' value is larger than the total numer of categories for item ", j, " on dimension ", d, ". The 'csel' argument will be ignored.\n"), call. = FALSE)
            }else catsel=csel
         } else if(length(iscat)  > 1) {
           catsel = csel[iscat==FALSE]  # if many take only the valid ones
           csel=catsel
         }
         if(length(catsel) == 0){
           catsel = 1:ncol(dlist_final[[d]]$CCC[[j]])
           csel   = 1:ncol(dlist_final[[d]]$CCC[[j]])
           warning(paste0("'csel' values are larger than the total numer of categories for item ", j, " on dimension ", d, ". The 'csel' argument will be ignored.\n"), call. = FALSE)
         } 
         
        if(j==k & all(check)) stop(paste0("Invalid 'csel' argument was defined for all items from dimension ", d, ". PIccc cannot be plotted. You may use 'dsel' to select only valid dimensions. \n"), call. = FALSE)
         
         dlist_final[[d]]$CCC[[j]] = dlist_final[[d]]$CCC[[j]][,catsel, drop=FALSE]
         dlist_final[[d]]$CIF[[j]] = dlist_final[[d]]$CIF[[j]][,catsel, drop=FALSE]
         dlist_final[[d]]$OBS[[j]] = dlist_final[[d]]$OBS[[j]][,catsel, drop=FALSE]  
         
         dlist_final[[d]]$SMOspline[[j]] = dlist_final[[d]]$SMOspline[[j]][,catsel, drop=FALSE]  
         dlist_final[[d]]$SMOloess [[j]] = dlist_final[[d]]$SMOloess [[j]][,catsel, drop=FALSE]  
  
       } # end of csel
  
     } # end for j
     
     dlist_final[[d]]$toalESC = rowSums(do.call(cbind, dlist_final[[d]]$ESC))
      
     nx = colnames(dlist_final[[d]]$thresholds) # paste0("I",1:k)
     names(dlist_final[[d]]$CCC) = nx
     names(dlist_final[[d]]$TCC) = nx
     names(dlist_final[[d]]$CIF) = nx
     names(dlist_final[[d]]$IIF) = nx
     names(dlist_final[[d]]$OBS) = nx  
     names(dlist_final[[d]]$ESC) = nx  
     
     names(dlist_final[[d]]$SMOspline) = nx  
     names(dlist_final[[d]]$SMOloess ) = nx  
     
     

  } # end for d
  
  dlist_final$freq = freq_sel  # mod 23-04-12: freq$freq; 23-06-27
  dlist_final$sortvec = sortvec

  attr(dlist_final,"source") = attr(dlist,"source")
  attr(dlist_final,"pp")     = attr(dlist,"pp")
  attr(dlist_final,"theta")  = theta

  if (debug) message("Leaving cleaner...")

  return(dlist_final)
  
  
} # end cleaner

