utilities [pin.ifz.ru]

Эта страница только для чтения. Вы можете посмотреть её исходный текст, но не можете его изменить. Сообщите администратору, если считаете, что это неправильно.

====== Утилиты для упрощения работы с данными ======

<code>

rowApply <- function(fun,tbl,vec) data.frame(mapply(fun, tbl, vec, SIMPLIFY = F));

selectNames <- function(tbl, namevec, saveNamesColumn = TRUE) {
    rtbl <- tbl;
    for ( n in namevec ) if (!n %in% names(rtbl)) rtbl[[n]] <- 0.0;
    for ( n in names(rtbl) ) if (!n %in% namevec) rtbl[[n]] <- NULL;
    if ((!saveNamesColumn) || ('Name' %in% namevec) || (!'Name' %in% names(rtbl))){
        return(rtbl[,namevec]);
    } else { 
        rtbl <- rtbl[,namevec];
        rtbl <- cbind(data.frame(Name = rtbl$Name), rtbl);
        return(rtbl);
    }
}

occupation_r <- function(row, target_col, target_max, source_cols)
{
  for (c in source_cols)
  {
    if(as.numeric(row[[target_col]]) >= as.numeric(target_max)) break;
    
    row[[target_col]] =  as.numeric(row[[target_col]]) + as.numeric(row[[c]]);
    
    if(as.numeric(row[[target_col]]) >= as.numeric(target_max))
    {
      row[[c]] =  as.numeric(row[[target_col]]) - as.numeric(target_max);
      row[[target_col]] = as.numeric(target_max);
      break;
    }
    else
    {
      row[[c]] = as.numeric(0.0);
    }
  }
  return (row)
}

occupation <- function(data, target_col, target_max, source_cols)
{
  v = apply(data, 1, occupation_r, target_col=target_col, target_max=target_max, source_cols=source_cols);
  return(data.frame(t(v)));
}
</code>