#' @include zzz.R
#' @importClassesFrom Matrix dgCMatrix dgRMatrix dgeMatrix
#' @importClassesFrom S4Arrays Array
NULL

####
# Objects and Classes ####
####

## vrAssay and vrAssayV2####

## UpdateAssay ####

updateAssayvrAssay <- function(object){
  
  # data matrix and feature data
  data_list <- list(main = object@rawdata, main_norm = object@normdata)
  featuredata_list <- list(main = object@featuredata)
  
  # create assay v2
  methods::new("vrAssayV2",
               data = data_list,
               featuredata = featuredata_list,
               embeddings = object@embeddings,
               image = object@image,
               params = object@params,
               type = object@type,
               name = object@name,
               main_image = object@main_image,
               main_featureset = "main")
}

#' @param object a vrAssay object to be converted to vrAssayV2
#' @rdname updateAssay
#' @method updateAssay vrAssay
#' @importFrom methods new
setMethod("updateAssay", "vrAssay", updateAssayvrAssay)

updateAssayvrAssayV2 <- function(object){
  message("The assay is of version 2, nothing to change!")
  return(object)
}

#' @param object a vrAssayV2 object to be converted to vrAssayV2
#' @rdname updateAssay
#' @method updateAssay vrAssayV2
setMethod("updateAssay", "vrAssayV2", updateAssayvrAssayV2)

####
# Methods ####
####

### Create vrAssay Object ####

#' formAssay
#'
#' Create a vrAssay (VoltRon assay) object
#'
#' @param data the feature matrix of spatialpoints
#' @param coords the coordinates of the spatial points
#' @param segments the list of segments each associated with a spatial point (optional)
#' @param image a singelton or list of images as magick-image objects
#' @param params additional parameters of the object
#' @param type the type of the assay (tile, molecule, cell, spot or ROI)
#' @param name the name of the assay
#' @param main_image the name of the main_image
#' @param main_featureset the name of the main_featureset
#' @param assay_version the assay version
#' @param ... additional arguements passed to \link{formImage}
#'
#' @importFrom methods new
#'
#' @export
#'
formAssay <- function(data = NULL, 
                      coords, 
                      segments = list(), 
                      image = NULL, 
                      params = list(), 
                      type = "ROI", 
                      name = "Assay1", 
                      main_image = "image_1", 
                      main_featureset = NULL, 
                      assay_version = "v2", 
                      ...){

  # get data
  if(is.null(data)){
    data <- matrix(nrow = 0, ncol = nrow(coords))
    colnames(data) <- rownames(coords)
  }

  # get image object
  image <- formImage(coords = coords, segments = segments, image = image, ...)
  image <- list(image)
  names(image) <- main_image

  # check feature
  if(is.null(main_featureset))
    main_featureset <- "main"
  
  # make vrAssay object
  data_list <- list(main = data, main_norm = data)
  names(data_list) <- c(main_featureset, paste0(main_featureset, "_norm"))
  if(assay_version == "v2"){
    object <-   methods::new("vrAssayV2", 
                             data = data_list,
                             image = image, params = params, type = type, name = name, 
                             main_image = main_image, main_featureset = main_featureset)
  } else {
    object <-   methods::new("vrAssay", 
                             rawdata = data, normdata = data,
                             image = image, params = params, type = type, name = name, 
                             main_image = main_image)
  }
  return(object)
}

### Subset vrAssay objects ####

subsetvrAssay <- function(x, subset, spatialpoints = NULL, features = NULL, image = NULL) {
  
  # start 
  object <- x
  
  if (!missing(x = subset)) {
    subset <- rlang::enquo(arg = subset)
  }
  
  # subseting on samples, layers and assays
  if(!is.null(features)){
    
    # select features
    nonmatching_features <- setdiff(features, vrFeatures(object))
    features <- intersect(vrFeatures(object), features)
    
    if(length(features) > 0){
      # object@rawdata <- object@rawdata[rownames(object@rawdata) %in% features,, drop = FALSE]
      # object@normdata <- object@normdata[rownames(object@normdata) %in% features,, drop = FALSE]
      object <- subsetData(object, features = features)
      object <- subsetData(object, features = features)
      
    } else {
      stop("none of the provided features are found in the assay")
    }
    
    if(length(nonmatching_features))
      message("the following features are not found in the assay: ", paste(nonmatching_features, collapse = ", "))
    
  } else {
    
    if(!is.null(spatialpoints)){
      
      # check if spatial points are here
      spatialpoints <- intersect(spatialpoints, vrSpatialPoints(object))
      if(length(spatialpoints) == 0){
        return(NULL)
      }
      
      # data
      # object@rawdata  <- object@rawdata[,spatialpoints, drop = FALSE]
      # object@normdata  <- object@normdata[,spatialpoints, drop = FALSE]
      object <- subsetData(object, spatialpoints = spatialpoints)
      object <- subsetData(object, spatialpoints = spatialpoints)
      
      # embeddings
      for(embed in vrEmbeddingNames(object)){
        embedding <- vrEmbeddings(object, type = embed)
        vrEmbeddings(object, type = embed) <- embedding[spatialpoints[spatialpoints %in% rownames(embedding)],, drop = FALSE]
      }
      
      # image
      # for(img in vrImageNames(object))
      for(img in vrSpatialNames(object))
        object@image[[img]] <- subsetvrImage(object@image[[img]], spatialpoints = spatialpoints)
        # object@image[[img]] <- subset.vrImage(object@image[[img]], spatialpoints = spatialpoints)
      
    } else if(!is.null(image)) {
      
      # images
      img <- vrMainSpatial(object)
      object@image <- object@image[img]
      object@image[[img]] <- subsetvrImage(object@image[[img]], image = image)
      # object@image[[img]] <- subset.vrImage(object@image[[img]], image = image)
      spatialpoints <- rownames(vrCoordinates(object@image[[img]]))
      
      # data
      # object@rawdata  <- object@rawdata[,colnames(object@rawdata) %in% spatialpoints, drop = FALSE]
      # object@normdata  <- object@normdata[,colnames(object@normdata) %in% spatialpoints, drop = FALSE]
      object <- subsetData(object, spatialpoints = spatialpoints)
      object <- subsetData(object, spatialpoints = spatialpoints)
      
      # embeddings
      for(embed in vrEmbeddingNames(object)){
        embedding <- vrEmbeddings(object, type = embed)
        vrEmbeddings(object, type = embed) <- embedding[rownames(embedding) %in% spatialpoints,, drop = FALSE]
      }
    } else {
      
      # else return empty
      return(NULL)
    }
  }
  
  # set VoltRon class
  return(object)
}

#' Subsetting vrAssay objects
#'
#' Given a vrAssay object, subset the object given one of the attributes
#'
#' @param x a vrAssay object
#' @param subset Logical statement for subsetting
#' @param spatialpoints the set of spatial points to subset the object
#' @param features the set of features to subset the object
#' @param image the subseting string passed to \link{image_crop}
#'
#' @method subset vrAssay
#' @order 4
#'
#' @importFrom rlang enquo
#'
#' @export
setMethod("subset", "vrAssay", subsetvrAssay)

#' Subsetting vrAssayV2 objects
#'
#' Given a vrAssayV2 object, subset the object given one of the attributes
#'
#' @param x a vrAssayV2 object
#' @param subset Logical statement for subsetting
#' @param spatialpoints the set of spatial points to subset the object
#' @param features the set of features to subset the object
#' @param image the subseting string passed to \link{image_crop}
#'
#' @method subset vrAssayV2
#' @order 4
#'
#' @export
setMethod("subset", "vrAssayV2", subsetvrAssay)

#' subsetCoordinates
#'
#' subsetting coordinates given cropping parameters of a magick image objects
#'
#' @param coords the coordinates of the spatial points
#' @param image the magick image associated with the coordinates
#' @param crop_info the subseting string passed to \link{image_crop}
#'
subsetCoordinates <- function(coords, image, crop_info){

  # image
  imageinfo <- image_info(image)

  # get crop information
  crop_info <- strsplit(crop_info, split = "\\+")[[1]]
  crop_info <- unlist(lapply(crop_info, function(x) strsplit(x, "x")))
  crop_info <- as.numeric(crop_info)

  # get uncropped spatial points
  xlim <- c(crop_info[3], crop_info[3]+crop_info[1])
  ylim <- c(crop_info[4], crop_info[4]+crop_info[2])
  ylim <- rev(imageinfo$height - ylim)

  # adjust for maximum res
  if(ylim[2] < 0){
    ylim[2] <- 0
    # ylim[1] <- ylim[2] - imageinfo$height + crop_info[2] # CHANGE THIS LATER ?
  }
  if(xlim[2] > imageinfo$width){
    xlim[2] <- imageinfo$width
    # xlim[1] <- xlim[2] - crop_info[1] # CHANGE THIS LATER ?
  }

  # get inside coords
  if(inherits(coords, "IterableMatrix")){
    # BPCells only accepts e1 > e2 ## S4 method for signature 'IterableMatrix,numeric'
    inside <- (!!as.vector(as(coords[,1] > xlim[1], "dgCMatrix")) & 
                 !!!as.vector(as(coords[,1] > xlim[2], "dgCMatrix"))) & 
      (!!as.vector(as(coords[,2] > ylim[1], "dgCMatrix")) & 
         !!!as.vector(as(coords[,2] > ylim[2], "dgCMatrix"))) 
  } else {
    inside <- (coords[,1] > xlim[1] & coords[,1] < xlim[2]) & (coords[,2] > ylim[1] & coords[,2] < ylim[2])
  }
  coords <- coords[inside,]

  if(nrow(coords) > 0){
    # adjust coordinates
    coords[,1] <- coords[,1] - xlim[1]
    coords[,2] <- coords[,2] - ylim[1]

    # return new coords
    return(coords)
  } else {
    stop("No spatial points remain after cropping!")
  }
}

#' subsetSegments
#'
#' subsetting segments given cropping parameters of a magick image objects
#'
#' @param segments the list of segments each associated with a spatial point
#' @param image the magick image associated with the coordinates
#' @param crop_info the subseting string passed to \link{image_crop}
#'
#' @importFrom dplyr bind_rows
subsetSegments <- function(segments, image, crop_info){

  # get segments
  segment_names <- names(segments)
  segments <- do.call(dplyr::bind_rows, segments)
  rownames(segments) <- seq_len(nrow(segments))
  segments <- data.frame(segments, row_id = rownames(segments))
  
  # subset
  cropped_segments <- subsetCoordinates(segments[,c("x","y")], image, crop_info)
  if(any(colnames(segments) %in% c("rx", "ry"))){
    cropped_segments_extra <- segments[rownames(cropped_segments), c("rx", "ry")]
    cropped_segments <- cbind(cropped_segments, cropped_segments_extra)
  }
  cropped_segments <- data.frame(cropped_segments, id = segments[rownames(cropped_segments),1], row_id = rownames(cropped_segments))
  cropped_segments <- cropped_segments %>% right_join(segments[,c(colnames(segments)[1], "row_id")], by = c("row_id" = "row_id"))
  if(any(colnames(segments) %in% c("rx", "ry"))){
    cropped_segments <- cropped_segments[,c(colnames(cropped_segments)[which(grepl(colnames(segments)[1], colnames(cropped_segments)))[1]], "x", "y", "rx", "ry")]
    colnames(cropped_segments) <- c("id", "x", "y", "rx", "ry")
    
  } else {
    cropped_segments <- cropped_segments[,c(colnames(cropped_segments)[which(grepl(colnames(segments)[1], colnames(cropped_segments)))[1]], "x", "y")]
    colnames(cropped_segments) <- c("id", "x", "y")
  }
  # split back to segments
  segments <- split(cropped_segments, cropped_segments[,1])
  segments <- lapply(segments, function(df){
    df[,colSums(is.na(df))<nrow(df), drop = FALSE]
  })
  names(segments) <- segment_names
  
  # return
  return(segments)
}

#' subsetData
#'
#' subsetting data matrices given spatialpoints, features etc.
#'
#' @param object a vrAssay object
#' @param spatialpoints the set of spatial points to subset the object
#' @param features the set of features to subset the object
#'
#' @noRd
subsetData <- function(object, spatialpoints = NULL, features = NULL){
  
  # features
  if(!is.null(features)){
    
    if(inherits(object, "vrAssay")){
      if(nrow(object@rawdata) > 0){
        object@rawdata <- object@rawdata[rownames(object@rawdata) %in% features,, drop = FALSE]
        object@normdata <- object@normdata[rownames(object@normdata) %in% features,, drop = FALSE]
      }
    } else {
      main <- vrMainFeatureType(object)
      if(nrow(object@data[[main]]) > 0){
        object@data[[main]] <- object@data[[main]][rownames(object@data[[main]]) %in% features,, drop = FALSE]
        object@data[[paste0(main, "_norm")]] <- object@data[[paste0(main, "_norm")]][rownames(object@data[[paste0(main, "_norm")]]) %in% features,, drop = FALSE]
      }
    }
  }
  
  # spatialpoints
  if(!is.null(spatialpoints)){
    
    if(inherits(object, "vrAssay")){
      # if(nrow(object@rawdata) > 0){
      if(ncol(object@rawdata) > 0){
        object@rawdata  <- object@rawdata[,colnames(object@rawdata) %in% spatialpoints, drop = FALSE]
        object@normdata  <- object@normdata[,colnames(object@normdata) %in% spatialpoints, drop = FALSE]
      }
    } else {
      for(nm in vrFeatureTypeNames(object)){
        # if(nrow(object@data[[nm]]) > 0){
        if(ncol(object@data[[nm]]) > 0){
          object@data[[nm]] <- object@data[[nm]][,colnames(object@data[[nm]]) %in% spatialpoints, drop = FALSE]
          object@data[[paste0(nm, "_norm")]] <- object@data[[paste0(nm, "_norm")]][,colnames(object@data[[paste0(nm, "_norm")]]) %in% spatialpoints, drop = FALSE]
        }
      }
    }
  }
  
  # return
  return(object)
}

#' getData
#'
#' get data matrix
#'
#' @param object a vrAssay object
#'
#' @noRd
getData <- function(object){
  
  if(inherits(object, "vrAssay")){
    data <- object@rawdata
  } else {
    data <- object@data[[vrMainFeatureType(object)]]
  }
  
  return(data)
}

#' updateData
#'
#' update data matrix
#'
#' @param object a vrAssay object
#' @param value the new column names
#'
#' @noRd
updateData <- function(object, value){
  
  if(inherits(object, "vrAssay")){
    if(ncol(object@rawdata) > 0){
      colnames(object@rawdata) <- value
      colnames(object@normdata) <- value 
    }
  } else {
    for(nm in vrFeatureTypeNames(object)){
      if(ncol(object@data[[nm]] > 0)){
        colnames(object@data[[nm]]) <- value
        colnames(object@data[[paste0(nm, "_norm")]]) <- value
      }
    }
  }
  
  return(object)
}

### Feature Methods ####

vrMainFeatureTypevrAssayV2 <- function(object){
  if(inherits(object, "vrAssayV2")){
    return(object@main_featureset)
  } else {
    return(NULL)
  }
}

#' @rdname vrMainFeatureType
#' @order 3
#' @export
setMethod("vrMainFeatureType", "vrAssayV2", vrMainFeatureTypevrAssayV2)

#' @rdname vrMainFeatureType
#' @order 3
#' @export
setMethod("vrMainFeatureType", "vrAssay", vrMainFeatureTypevrAssayV2)

vrMainFeatureTypeReplacevrAssayV2 <- function(object, ignore = FALSE, value){
  if(value %in% names(object@data)){
    object@main_featureset <- value
  } else {
    if(ignore){
      warning("The feature type '", value, "' is not found in '", vrAssayNames(object),"'. Main feature type is still set to '", vrMainFeatureType(object), "'")
    } else {
      stop("The feature type '", value, "' is not found in '", vrAssayNames(object),"'. Use ignore = TRUE for ignoring this message")
    }
  }
  
  return(object)
}

#' @param ignore ignore if some assays dont have the feature set name
#' 
#' @rdname vrMainFeatureType
#' @order 5
#' @export
setMethod("vrMainFeatureType<-", "vrAssayV2", vrMainFeatureTypeReplacevrAssayV2)

#' @param ignore ignore if some assays dont have the feature set name
#' 
#' @rdname vrMainFeatureType
#' @order 5
#' @export
setMethod("vrMainFeatureType<-", "vrAssay", function(object, ignore = FALSE, value){
  stop("vrAssay V1 objects do not have multiple feature types!")
})

vrFeatureTypeNamesvrAssayV2 <- function(object){
  names_data <- names(object@data)
  return(names_data[!grepl("_norm$", names_data)])
}

#' @rdname vrFeatureTypeNames
#'
#' @export
setMethod("vrFeatureTypeNames", "vrAssayV2", vrFeatureTypeNamesvrAssayV2)

#' @rdname vrFeatureTypeNames
#'
#' @export
setMethod("vrFeatureTypeNames", "vrAssay", function(object){
  stop("vrAssay V1 objects do not have multiple feature types!")
})

addFeaturevrAssayV2 <- function(object, data, feature_name){
  
  # get feature name
  featuresets <- vrFeatureTypeNames(object)
  if(feature_name %in% featuresets){
    stop("Feature type '", feature_name, "' already exists in the assay.")
  }
  
  # check spatial point names in the object
  colnames_data <- colnames(data)
  colnames_data <- stringr::str_remove(colnames_data, pattern = "_Assay[0-9]+$")
  colnames(data) <- paste0(colnames_data, "_", vrAssayNames(object))
  
  # check spatial points
  spatialpoints <- vrSpatialPoints(object)
  if(length(setdiff(colnames(data), vrSpatialPoints(object))) > 0){
    stop("The number of spatial points is not matching with number of points in the input data")
  } 

  # add new features
  feature_list_name <- names(object@data)
  feature_list_name <- c(feature_list_name, feature_name, paste0(feature_name, "_norm"))
  object@data <- c(object@data, list(data,data))
  names(object@data) <- feature_list_name
  
  # return
  return(object)
}

#' @rdname addFeature
#' @method addFeature vrAssayV2
#' 
#' @importFrom stringr str_remove
#' 
#' @export
setMethod("addFeature", "vrAssayV2", addFeaturevrAssayV2)

### Other Methods ####

#' @rdname vrSpatialPoints
#' @order 4
#' 
#' @export
setMethod("vrSpatialPoints", "vrAssay", function(object) {
  return(rownames(vrCoordinates(object)))
})

#' @rdname vrSpatialPoints
#' @order 4
#' 
#' @export
setMethod("vrSpatialPoints", "vrAssayV2", function(object) {
  return(rownames(vrCoordinates(object)))
})

vrSpatialPointsReplacevrAssayV2 <- function(object, value) {
  
  # spatial points 
  spatialpoints <- vrSpatialPoints(object)
  
  # data
  if(length(vrSpatialPoints(object)) != length(value)){
    stop("The number of spatial points is not matching with the input")
  } else {
    if(ncol(getData(object)) > 0){
      object <- updateData(object, value)
    }
  }
  
  # images
  for(img in vrSpatialNames(object)){
    vrSpatialPoints(object@image[[img]]) <- value
  }
  
  # embeddings
  embeddings <- object@embeddings
  embed_names <- names(embeddings)
  if(length(embed_names) > 0){
    for(type in embed_names){
      if(nrow(embeddings[[type]]) > 0){
        rownames(embeddings[[type]]) <- value[match(rownames(embeddings[[type]]), spatialpoints)]
        object@embeddings[[type]] <- embeddings[[type]]
      }
    }
  }
  
  # return
  return(object)
}

#' @rdname vrSpatialPoints
#' @order 8
#' @export
setMethod("vrSpatialPoints<-", "vrAssay", vrSpatialPointsReplacevrAssayV2)

#' @rdname vrSpatialPoints
#' @order 8
#' @export
setMethod("vrSpatialPoints<-", "vrAssayV2", vrSpatialPointsReplacevrAssayV2)

vrFeaturesvrAssay <- function(object) {
  return(rownames(getData(object)))
}

#' @rdname vrFeatures
#' @order 3
#' @export
setMethod("vrFeatures", signature = "vrAssay", definition = vrFeaturesvrAssay)
 
#' @rdname vrFeatures
#' @method vrFeatures vrAssayV2
#' @order 3
#' @export
setMethod("vrFeatures", "vrAssayV2", vrFeaturesvrAssay)

vrFeatureDatavrAssay <- function(object) {
  return(object@featuredata)
}

#' @rdname vrFeatureData
#' @order 3
#' @export
setMethod("vrFeatureData", "vrAssay", vrFeatureDatavrAssay)

vrFeatureDatavrAssayV2 <- function(object, feat_type = NULL){
  if(is.null(feat_type))
    feat_type <- vrMainFeatureType(object)
  return(object@featuredata[[feat_type]])
}

#' @param feat_type the feature set type
#'
#' @rdname vrFeatureData
#' @order 3
#' @export
setMethod("vrFeatureData", "vrAssayV2", vrFeatureDatavrAssayV2)

vrFeatureDataRreplacevrAssay <- function(object, value) {
  object@featuredata <- value
  return(object)
}

#' @rdname vrFeatureData
#' @order 5
#' @export
setMethod("vrFeatureData<-", "vrAssay", vrFeatureDataRreplacevrAssay)

vrFeatureDataReplacevrAssayV2 <- function(object, feat_type = NULL, value) {
  if(is.null(feat_type))
    feat_type <- vrMainFeatureType(object)
  object@featuredata[[feat_type]] <- value
  return(object)
}

#' @rdname vrFeatureData
#' @order 5
#' @export
setMethod("vrFeatureData<-", "vrAssayV2", vrFeatureDataReplacevrAssayV2)

vrAssayNamesvrAssay <- function(object) {
  
  if(.hasSlot(object, name = "name")){
    if(grep("Assay", object@name)){
      return(object@name)
    } else {
      assay_ids <- stringr::str_extract(vrSpatialPoints(object), "Assay[0-9]+$")
      assay_id <- unique(assay_ids)
      return(assay_id)
    }
  } else {
    assay_ids <- stringr::str_extract(vrSpatialPoints(object), "Assay[0-9]+$")
    assay_id <- unique(assay_ids)
    return(assay_id)
  }
}

#' @rdname vrAssayNames
#' @order 4
#' @export
setMethod("vrAssayNames", "vrAssay", vrAssayNamesvrAssay)

#' @rdname vrAssayNames
#' @order 4
#' @export
setMethod("vrAssayNames", "vrAssayV2", vrAssayNamesvrAssay)

vrAssayNamesReplacevrAssay <- function(object, value){
  
  # get original assay name
  assayname <- vrAssayNames(object)
  
  # change assay names
  spatialpoints <- stringr::str_replace(vrSpatialPoints(object), assayname, value)
  
  # add assay name if missing
  if(vrAssayTypes(object) %in% c("ROI", "cell", "spot")){
    ind <- !grepl("Assay[0-9]+$", spatialpoints)
    spatialpoints[ind] <- stringr::str_replace(spatialpoints[ind], "$", paste0("_", value))
  }
  
  # replace spatial point names
  vrSpatialPoints(object) <- spatialpoints
  object@name <- value
  
  # return
  return(object)
}

#' @param value assay name
#' 
#' @rdname vrAssayNames
#' @order 5
#' @importFrom stringr str_replace
setMethod("vrAssayNames<-", "vrAssay", vrAssayNamesReplacevrAssay)

vrAssayNamesReplacevrAssayV2 <- function(object, value){
  
  # get original assay name
  assayname <- vrAssayNames(object)
  
  # change assay names
  spatialpoints <- stringr::str_replace(vrSpatialPoints(object), assayname, value)
  
  # add assay name if missing
  if(vrAssayTypes(object) %in% c("ROI", "cell", "spot")){
    ind <- !grepl("Assay[0-9]+$", spatialpoints)
    spatialpoints[ind] <- stringr::str_replace(spatialpoints[ind], "$", paste0("_", value))
  }
  
  # replace spatial point names
  vrSpatialPoints(object) <- spatialpoints
  object@name <- value
  
  # return
  return(object)
}

#' @param value assay name
#' 
#' @rdname vrAssayNames
#' @order 5
#' @importFrom stringr str_replace
setMethod("vrAssayNames<-", "vrAssayV2", vrAssayNamesReplacevrAssayV2)

vrAssayTypesvrAssay <- function(object) {
  return(object@type)
}

#' @rdname vrAssayTypes
#' @order 3
#' @export
setMethod("vrAssayTypes", "vrAssay", vrAssayTypesvrAssay)

#' @rdname vrAssayTypes
#' @order 3
#' @export
setMethod("vrAssayTypes", "vrAssayV2", vrAssayTypesvrAssay)

#' Get assay parameters
#'
#' Given a vrAssay object, if there are any, get a list of parameters of the assay(s)
#'
#' @param object a vrAssay object
#' @param param the parameter value to return
#'
#' @rdname vrAssayParams
#'
#' @export
vrAssayParams <- function(object, param = NULL) {
  if(!is.null(param)){
    if(param %in% names(object@params)){
      return(object@params[[param]])
    } else {
      message(param, " not found in the param list")
      return(NULL)
    }
  } else {
    return(object@params)
  }
}

vrDatavrAssay <- function(object, features = NULL, feat_type = NULL, norm = FALSE, ...) {
  
  # get assay types
  assay.type <- vrAssayTypes(object)
  
  # for ROIs, cells and spots
  if(assay.type %in% c("ROI", "cell", "spot")){
    
    # check if there are features
    if(!is.null(features)){
      if(!all(features %in% vrFeatures(object))){
        stop("Some features are not available in the assay!")
      }
      
      if(inherits(object, "vrAssay")){
        if(norm){
          return(object@normdata[features,,drop = FALSE])
        } else {
          return(object@rawdata[features,,drop = FALSE])
        }
      } else {
        if(is.null(feat_type))
          feat_type <- vrMainFeatureType(object)
        if(norm){
          return(object@data[[paste0(feat_type, "_norm")]][features,,drop = FALSE])
        } else {
          return(object@data[[feat_type]][features,,drop = FALSE])
        }
      }
      
      # if there are no features requested, return the data
    } else {
      
      if(inherits(object, "vrAssay")){
        if(norm){
          return(object@normdata)
        } else {
          return(object@rawdata)
        }
      } else {
        if(is.null(feat_type))
          feat_type <- vrMainFeatureType(object)
        if(norm){
          return(object@data[[paste0(feat_type, "_norm")]])
        } else {
          return(object@data[[feat_type]])
        }
      }
    }
    
    # for tiles and molecules
  } else {
    
    # check if features are requested
    if(!is.null(features)){
      stop("No features are available for tile and molecule assays!")
    } else{
      
      if(inherits(object, "vrAssay")){
        if(norm){
          return(object@normdata)
        } else {
          return(object@rawdata)
        }
      } else {
        if(is.null(feat_type))
          feat_type <- vrMainFeatureType(object)
        if(norm){
          return(object@data[[paste0(feat_type, "_norm")]])
        } else {
          return(object@data[[feat_type]])
        }
      }
    }
  }
}

#' @rdname vrData
#' @order 3
#'
#' @importFrom magick image_raster
#'
#' @export
setMethod("vrData", "vrAssay", vrDatavrAssay)

#' @rdname vrData
#' @order 3
#'
#' @export
setMethod("vrData", "vrAssayV2", vrDatavrAssay)

generateTileDatavrAssay <- function(object, name = NULL, reg = FALSE, channel = NULL) {
  
  if(vrAssayTypes(object) != "tile"){
    stop("generateTileData can only be used for tile-based assays")
  } else {
    image_data <- as.numeric(vrImages(object, name = name, reg = reg, channel = channel, as.raster = TRUE))
    image_data <- (0.299 * image_data[,,1] + 0.587 * image_data[,,2] + 0.114 * image_data[,,3])
    image_data <- split_into_tiles(image_data, tile_size = vrAssayParams(object, param = "tile.size"))
    image_data <- sapply(image_data, function(x) return(as.vector(x)))
    image_data <- image_data*255
    rownames(image_data) <- paste0("pixel", seq_len(nrow(image_data)))
    colnames(image_data) <- vrSpatialPoints(object)
    feat_type <- vrMainFeatureType(object)
    
    if(inherits(object, "vrAssay")){
      object@rawdata <- object@normdata <- image_data
    } else{
      object@data[[feat_type]] <- image_data
      object@data[[paste0(feat_type, "_norm")]] <- image_data
    }
  }
  return(object)
}

#' @param name the name of the main spatial system
#' @param reg TRUE if registered coordinates of the main image (\link{vrMainSpatial}) is requested
#' @param channel the name of the channel associated with the image
#' 
#' @rdname generateTileData
#' @order 3
#'
#' @export
setMethod("generateTileData", "vrAssay", generateTileDatavrAssay)

#' @rdname generateTileData
#' @order 3
#'
#' @export
setMethod("generateTileData", "vrAssayV2", generateTileDatavrAssay)

vrCoordinatesvrAssay <- function(object, image_name = NULL, spatial_name = NULL, reg = FALSE) {
  
  # get spatial name
  if(!is.null(spatial_name)) 
    image_name <- spatial_name
  
  # check main image
  if(is.null(image_name)){
    image_name <- vrMainSpatial(object)
  }
  
  # check registered coordinates
  if(reg){
    if(!paste0(image_name, "_reg") %in% vrSpatialNames(object)){
      warning("There are no registered spatial systems with name ", image_name, "!")
    } else {
      image_name <- paste0(image_name, "_reg")
    }
  }
  
  # check coordinates
  if(!image_name %in% vrSpatialNames(object)){
    stop(image_name, " is not among any spatial system in this vrAssay object")
  }
  
  # return coordinates
  return(vrCoordinates(object@image[[image_name]]))
}

#' @rdname vrCoordinates
#' @order 3
#' @export
#'
setMethod("vrCoordinates", "vrAssay", vrCoordinatesvrAssay)

#' @rdname vrCoordinates
#' @order 3
#' @export
#'
setMethod("vrCoordinates", "vrAssayV2", vrCoordinatesvrAssay)

vrCoordinatesReplacevrAssay <- function(object, image_name = NULL, spatial_name = NULL, reg = FALSE, value) {
  
  # get spatial name
  if(!is.null(spatial_name)) 
    image_name <- spatial_name
  
  # check main image
  if(is.null(image_name)){
    image_name <- vrMainSpatial(object)
  }
  
  # check registered coordinates
  if(reg){
    image_name <- paste0(image_name, "_reg")
  }
  
  # check coordinates
  if(!image_name %in% vrSpatialNames(object)){
    stop(image_name, " is not among any spatial system in this vrAssay object")
  }
  
  vrCoordinates(object@image[[image_name]]) <- value
  return(object)
}

#' @rdname vrCoordinates
#' @order 5
#' @importFrom methods slot
#'
#' @export
setMethod("vrCoordinates<-", "vrAssay", vrCoordinatesReplacevrAssay)

#' @rdname vrCoordinates
#' @order 5
#' @importFrom methods slot
#'
#' @export
setMethod("vrCoordinates<-", "vrAssayV2", vrCoordinatesReplacevrAssay)

flipCoordinatesvrAssay <- function(object, image_name = NULL, spatial_name = NULL, ...) {
  
  # get spatial name
  if(!is.null(spatial_name)) 
    image_name <- spatial_name
  
  # get coordinates
  coords <- vrCoordinates(object, image_name = image_name, ...)
  
  # get image info
  image <- vrImages(object, name = image_name)
  if(!is.null(image)){
    imageinfo <- magick::image_info(vrImages(object, name = image_name))
    height <- imageinfo$height
  } else{
    height <- max(coords[,"y"])
  }
  
  # flip coordinates
  coords[,"y"] <- height - coords[,"y"]
  vrCoordinates(object, image_name = image_name, ...) <- coords
  
  # flip segments
  segments <- vrSegments(object, image_name = image_name, ...)
  if(length(segments) > 0){
    name_segments <- names(segments)
    segments <- do.call("rbind", segments)
    segments[,"y"] <- height - segments[,"y"]
    segments <- split(segments, segments[,1])
    names(segments) <- name_segments
    vrSegments(object, image_name = image_name, ...) <- segments
  }
  
  # return
  return(object)
}

#' @rdname flipCoordinates
#' @order 3
#'
#' @importFrom magick image_info
#'
#' @export
setMethod("flipCoordinates", "vrAssay", flipCoordinatesvrAssay)

#' @rdname flipCoordinates
#' @order 3
#'
#' @export
setMethod("flipCoordinates", "vrAssayV2", flipCoordinatesvrAssay)

vrSegmentsvrAssay <- function(object, image_name = NULL, spatial_name = NULL, reg = FALSE) {
  
  # get spatial name
  if(!is.null(spatial_name)) 
    image_name <- spatial_name
  
  # check main image
  if(is.null(image_name)){
    image_name <- vrMainSpatial(object)
  }
  
  # check registered segments
  if(reg){
    if(!paste0(image_name, "_reg") %in% vrSpatialNames(object)){
      warning("There are no registered spatial systems with name ", image_name, "!")
    } else {
      image_name <- paste0(image_name, "_reg")
    }
  }
  
  # check coordinates
  if(!image_name %in% vrSpatialNames(object)){
    stop(image_name, " is not among any spatial system in this vrAssay object")
  }
  
  # return coordinates
  return(vrSegments(object@image[[image_name]]))
}

#' @rdname vrSegments
#' @order 3
#' @export
setMethod("vrSegments", "vrAssay", vrSegmentsvrAssay)

#' @rdname vrSegments
#' @order 3
#' @export
setMethod("vrSegments", "vrAssayV2", vrSegmentsvrAssay)

vrSegmentsReplacevrAssay <- function(object, image_name = NULL, spatial_name = NULL, reg = FALSE, value) {
  
  # get spatial name
  if(!is.null(spatial_name)) 
    image_name <- spatial_name
  
  # check main image
  if(is.null(image_name)){
    image_name <- vrMainSpatial(object)
  }
  
  # check registered segments
  if(reg){
    image_name <- paste0(image_name, "_reg")
  }
  
  # check coordinates
  if(!image_name %in% vrSpatialNames(object)){
    stop(image_name, " is not among any spatial system in this vrAssay object")
  }
  
  vrSegments(object@image[[image_name]]) <- value
  return(object)
}

#' @rdname vrSegments
#' @order 6
#' @importFrom methods slot
#' @export
setMethod("vrSegments<-", "vrAssay", vrSegmentsReplacevrAssay)

#' @rdname vrSegments
#' @order 6
#' @importFrom methods slot
#' @export
setMethod("vrSegments<-", "vrAssayV2", vrSegmentsReplacevrAssay)

vrEmbeddingsvrAssay <- function(object, type = "pca", dims = seq_len(30)) {
  
  # embeddings
  embeddings <- object@embeddings
  embedding_names <- names(embeddings)
  
  # check embeddings and return
  if(!type %in% embedding_names){
    stop("Embedding type ", type, " is not found!")
  } else{
    embedding <- object@embeddings[[type]]
    if(max(dims) > ncol(embedding)){
      dims <- seq_len(ncol(embedding))
    }
    return(embedding[,dims, drop = FALSE])
  }
}

#' @rdname vrEmbeddings
#' @order 3
#' @export
setMethod("vrEmbeddings", "vrAssay", vrEmbeddingsvrAssay)

#' @rdname vrEmbeddings
#' @order 3
#' @export
#'
setMethod("vrEmbeddings", "vrAssayV2", vrEmbeddingsvrAssay)

vrEmbeddingsReplacevrAssay <- function(object, type = "pca", value) {
  object@embeddings[[type]] <- value
  return(object)
}

#' @rdname vrEmbeddings
#' @order 4
#' @export
setMethod("vrEmbeddings<-", "vrAssay", vrEmbeddingsReplacevrAssay)

vrEmbeddingsReplacevrAssayV2 <- function(object, type = "pca", value) {
  object@embeddings[[type]] <- value
  return(object)
}

#' @rdname vrEmbeddings
#' @order 4
#' @export
setMethod("vrEmbeddings<-", "vrAssayV2", vrEmbeddingsReplacevrAssayV2)

vrEmbeddingNamesvrAssay <- function(object){
  return(names(object@embeddings))
}

#' @rdname vrEmbeddingNames
#' @order 3
#'
#' @export
setMethod("vrEmbeddingNames", "vrAssay", vrEmbeddingNamesvrAssay)

#' @rdname vrEmbeddingNames
#' @order 3
#'
#' @export
setMethod("vrEmbeddingNames", "vrAssayV2", vrEmbeddingNamesvrAssay)