Added arguments to limit user interaction

This commit is contained in:
Waldir Leoncio 2020-06-08 13:42:36 +02:00
parent b622375062
commit 3fcd4affcb
2 changed files with 83 additions and 35 deletions

View file

@ -1,7 +1,14 @@
#' @title Clustering of individuals #' @title Clustering of individuals
#' @param tietue Record #' @param tietue Record
#' @param format Format of the data ("BAPS", "GenePop" or "Preprocessed")
#' @param savePreProcessed Save the pre-processed data?
#' @export #' @export
greedyMix <- function(tietue) { greedyMix <- function(
tietue,
format = NULL,
savePreProcessed = NULL,
filePreProcessed = NULL
) {
# ASK: graphical components. Remove? # ASK: graphical components. Remove?
# check whether fixed k mode is selected # check whether fixed k mode is selected
# h0 <- findobj('Tag','fixk_menu') # h0 <- findobj('Tag','fixk_menu')
@ -17,32 +24,46 @@ greedyMix <- function(tietue) {
# h1 = findobj('Tag','partitioncompare_menu'); # h1 = findobj('Tag','partitioncompare_menu');
# partitionCompare = get(h1, 'userdata'); # partitionCompare = get(h1, 'userdata');
if (identical(tietue, -1)) { if (is(tietue, "list") | is(tietue, "character")) {
input_type <- inputdlg( # ----------------------------------------------------------------------
paste( # Defining type of file
'Specify the format of your data:\n', # ----------------------------------------------------------------------
'1) BAPS-format\n', if (is.null(format)) {
'2) GenePop-format\n', input_type <- inputdlg(
'3) Preprocessed data\n' paste(
'Specify the format of your data:\n',
'1) BAPS-format\n',
'2) GenePop-format\n',
'3) Preprocessed data\n'
)
) )
) # Converting from number into name
# Converting from number into name input_type_name <- switch(
input_type_name <- switch( input_type, 'BAPS-format', 'GenePop-format', 'Preprocessed data'
input_type, 'BAPS-format', 'GenePop-format', 'Preprocessed data' )
) } else {
input_type_name <- paste0(format, "-format")
}
# ----------------------------------------------------------------------
# Treating BAPS-formatted files
# ----------------------------------------------------------------------
if (length(input_type_name) == 0) { if (length(input_type_name) == 0) {
stop('Invalid alternative') stop('Invalid alternative')
} else if (input_type_name == 'BAPS-format') { } else if (input_type_name == 'BAPS-format') {
pathname_filename <- uigetfile("*.txt", "Loaddata in BAPS-format") if (!is(tietue, "character")) {
pathname_filename <- uigetfile("*.txt", "Loaddata in BAPS-format")
} else {
pathname_filename <- tietue
}
# ASK: remove? # ASK: remove?
# if ~isempty(partitionCompare) # if ~isempty(partitionCompare)
# fprintf(1,'Data: %s\n',[pathname filename]); # fprintf(1,'Data: %s\n',[pathname filename]);
# end # end
data <- load(pathname_filename) data <- read.delim(pathname_filename) # ASK: what is the delimiter?
# ninds <- testaaOnkoKunnollinenBapsData(data) #TESTAUS # TODO: trans # ninds <- testaaOnkoKunnollinenBapsData(data) #TESTAUS # TODO: trans
if (ninds == 0) stop('Incorrect Data-file') # if (ninds == 0) stop('Incorrect Data-file')
# ASK: remove? # ASK: remove?
# h0 = findobj('Tag','filename1_text'); # h0 = findobj('Tag','filename1_text');
@ -78,13 +99,16 @@ greedyMix <- function(tietue) {
# [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO: translate this function # [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO: translate this function
# [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: translate # [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: translate
if (is.null(savePreProcessed)) {
save_preproc <- questdlg( save_preproc <- questdlg(
quest = 'Do you wish to save pre-processed data?', quest = 'Do you wish to save pre-processed data?',
dlgtitle = 'Save pre-processed data?', dlgtitle = 'Save pre-processed data?',
defbtn = 'y' defbtn = 'y'
) )
if (save_preproc %in% c('y', 'yes')) { } else {
save_preproc <- savePreProcessed
}
if (save_preproc %in% c('y', 'yes', TRUE)) {
file_out <- uiputfile('.rda','Save pre-processed data as') file_out <- uiputfile('.rda','Save pre-processed data as')
kokonimi <- paste0(file_out$path, file_out$name) kokonimi <- paste0(file_out$path, file_out$name)
c <- list() c <- list()
@ -100,12 +124,19 @@ greedyMix <- function(tietue) {
save(c, file = kokonimi) save(c, file = kokonimi)
rm(c) rm(c)
} }
# ----------------------------------------------------------------------
# Treating GenePop-formatted files
# ----------------------------------------------------------------------
} else if (input_type_name == 'GenePop-format') { } else if (input_type_name == 'GenePop-format') {
filename_pathname <- uigetfile( if (!is(tietue, "character")) {
filter = '*.txt', filename_pathname <- uigetfile(
title = 'Load data in GenePop-format' filter = '*.txt',
) title = 'Load data in GenePop-format'
if (filename_pathname$name == 0) stop("No name provided") )
if (filename_pathname$name == 0) stop("No name provided")
} else {
filename_pathname <- tietue
}
# ASK: remove? # ASK: remove?
# if ~isempty(partitionCompare) # if ~isempty(partitionCompare)
@ -121,14 +152,19 @@ greedyMix <- function(tietue) {
# [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO:trans # [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO:trans
# [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: trans # [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: trans
save_preproc <- questdlg( if (is.null(savePreProcessed)) {
quest = 'Do you wish to save pre-processed data?', save_preproc <- questdlg(
dlgtitle = 'Save pre-processed data?', quest = 'Do you wish to save pre-processed data?',
defbtn = 'y' dlgtitle = 'Save pre-processed data?',
) defbtn = 'y'
if (save_preproc %in% c('y', 'Yes')) { )
} else {
save_preproc <- savePreProcessed
}
if (save_preproc %in% c('y', 'Yes', TRUE)) {
file_out <- uiputfile('.rda','Save pre-processed data as') file_out <- uiputfile('.rda','Save pre-processed data as')
kokonimi <- paste0(file_out$path, file_out$name) kokonimi <- paste0(file_out$path, file_out$name)
# FIXME: translate functions above so the objects below exist
c$data <- data c$data <- data
c$rowsFromInd <- rowsFromInd c$rowsFromInd <- rowsFromInd
c$alleleCodes <- alleleCodes c$alleleCodes <- alleleCodes
@ -141,6 +177,9 @@ greedyMix <- function(tietue) {
save(c, file = kokonimi) save(c, file = kokonimi)
rm(c) rm(c)
} }
# ----------------------------------------------------------------------
# Handling Pre-processed data
# ----------------------------------------------------------------------
} else if (input_type_name == 'Preprocessed data') { } else if (input_type_name == 'Preprocessed data') {
file_in <- uigetfile( file_in <- uigetfile(
filter = '*.txt', filter = '*.txt',

View file

@ -4,10 +4,19 @@
\alias{greedyMix} \alias{greedyMix}
\title{Clustering of individuals} \title{Clustering of individuals}
\usage{ \usage{
greedyMix(tietue) greedyMix(
tietue,
format = NULL,
savePreProcessed = NULL,
filePreProcessed = NULL
)
} }
\arguments{ \arguments{
\item{tietue}{Record} \item{tietue}{Record}
\item{format}{Format of the data ("BAPS", "GenePop" or "Preprocessed")}
\item{savePreProcessed}{Save the pre-processed data?}
} }
\description{ \description{
Clustering of individuals Clustering of individuals