Related
I need to just a simple log in the webpage login page and how do I check that login is successful or not?
library(httr)
library(jsonlite)
library(tictoc)
library(data.table)
library(properties)
library(futile.logger)
library(crayon)
library(XML)
library(methods)
library(compare)
library(tictoc)
args = commandArgs(trailingOnly=TRUE)
server.name <- "lgloz050.lss.emc.com"
port.no <- "58443"
default.path <- "/APG/lookup/"
set_config(config(ssl_verifypeer = 0L))
config.s3 <- fread("Configuration_modify.csv")
config.s3$bc <- config.s3$testReport
config.s3$testReport <- gsub(">>","/", config.s3$testReport)
config.s3$testReport <- gsub(" ","%20", config.s3$testReport)
config.s3$link <- paste("https://",server.name,":",port.no,default.path,config.s3$testReport,"/report.csv", sep = "")
properties = read.csv2("Configuration.properties",sep = "=", blank.lines.skip = TRUE,header = FALSE,stringsAsFactors = FALSE )
colnames(properties) <- c("key", "value")
config.s3$link <- gsub("$","PH_", config.s3$link)
#config.s3$link
for(i in 1:nrow(properties)){
if(startsWith(properties[i,1],"$")){
print(properties[i,1])
for (j in 1: nrow(config.s3)) {
config.s3[j]$link = gsub(paste("PH_",substring(trimws(properties[i,1]),2),sep = "")
,trimws(properties[i,2]),config.s3[j]$link,ignore.case = TRUE)
}
}
}
result <- config.s3[, list(bc,TestCaseID,link),]
auth <- function(link,user.name="*****", password="******"){
res <- GET(link,add_headers("accept"="text/json"))
res <- POST('https://lgloz050.lss.emc.com:58443/APG/j_security_check'
,set_cookies=res$cookies
,body = "j_username=*****&j_password=******"
,add_headers("Content-Type" ="application/x-www-form-linkencoded" ))
return(res)
}
fetch <- function(link,save.location,cookies){
fetch.success = TRUE
res <- GET(link
,add_headers("Authorization"="Basic **************")
,set_cookies=cookies)
tryCatch({repot_data <- fread(content(res,"text"),header = TRUE);
fwrite(data.frame(repot_data),save.location,row.names = FALSE);
flog.info(green("'\u2713' - Fetch Completed successfully ..."))
flog.info(paste("link : ",link))},
error = function(e){fetch.success= FALSE; flog.error(paste("\u2715 - Not able to fetch data,file not created "))})
return(fetch.success)
}
config.s3$save.location = sub("TruthData","testData",config.s3$truthReport,ignore.case = T)
response = auth(config.s3[1]$link)
# Function Call - fetch all the report data
result[,fetch:=FALSE]
result[,fetch.time:=0]
pb <- winProgressBar(title="Fetching Reports... ", label="0%", min=0, max=100, initial=0,width = 500)
for (i in 1:nrow(config.s3)) {
tic()
getWinProgressBar(pb)
setWinProgressBar(pb, i*(100/nrow(config.s3)), label =paste(round(i*(100/nrow(config.s3)))," % \n",config.s3[i]$testReport))
flog.info(paste("report",i,"started",config.s3[i]$link))
fetch.success = fetch(config.s3[i]$link,config.s3[i]$save.location,response$cookies)
t <- toc()
t$toc
result[i]$fetch <- fetch.success
result[i]$fetch.time <- t$toc / 10000
}
close(pb)
result[,-c("link"),with=FALSE]
this is the code to fetch the CSV file but the file has HTML content of login page. please tell me where I am doing mistak and what i have to correct and modify to get the correct data.
suggest some procedure. Thanks in advance.
I got the solution which is as follows:
library(httr)
library(rvest)
url <- "https://lgloz050.lss.emc.com:58443/APG/"
dn_url <- "https://lgloz050.lss.emc.com:58443/APG/lookup/Report%20Library/Amazon%20S3/Inventory/Accounts/report.csv"
session <- html_session(url)
form <- html_form(session)[[1]]
fl_fm <- set_values(form,
j_username = "*****",
j_password = "********")
main_page <- submit_form(session, fl_fm)
downlaod <- jump_to(main_page,dn_url)
writeBin(downlaod$response$content, basename(dn_url))
on the execution of this code it will successfully log in and download the report and the downloaded report has the same content which is required. I do this for one file next I am trying to download the multiple files in one execution.
Thanks to you all for your support. let me know if there any other solution possible or any kind of modification is required in the above code.
first post and I hope I'm doing everything correctly.
I'm using RStudio: Version 1.1.423; R-Version: 3.4.2, OS: Windows 10
Short problem summary: I start a gwidgets based GUI and the text shows in the desired font size, but when I click the save button, it suddenly changes to a smaller font.
Context: I'm currently doing a systematic literature review and I use the Metagear package by mjlajeunesse (https://github.com/cran/metagear) to screen the abstracts and decide if I shuold include them. Here's a picture of the original GUI:
Original Abstract Screener GUI
Short description of functionality: I just click on one of the buttons (Yes, No, Maybe) and the abstract screener moves on to the next abstract in the file. I then click save to save my progress.
Changes I made to the code: However, I added some additional fields so I had to change that behaviour, so that it doesn't immediately jump to the next entry as soon as I click one of the buttons. So I merged that part of the function with the save function.
Now I get the following behaviour: When I first open the abstract screener the fontsize is as desired as seen in this picture:
Adapted Abstract Screener before clicking Save & Next
As soon as I click Save & Next it shows me the next abstract (as desired), but suddenly the font changes to a much smaller one, making it rather unpleasant to read, because it's so small, as seen here
Adapted Abstract Screener after clicking Save & Next
Here's the code that I use/adapted to override the original functions of the metagear package. I iteratively adapted the code so I only included the functions of the metagear package that I needed to make things work.
Here's the code I'm using(I included the code I use to execute the different functions at the bottom, including some sample data frame, instead of my CSV file):
# Load libraries
library(metagear)
library(EBImage)
library(cairoDevice)
library(gWidgets)
library(gWidgetsRGtk2)
library(gWidgets2)
library(gWidgets2RGtk2)
library(RGtk2)
library(utils)
##############################
# dirty adaptations for the METAGEAR package start here
##############################
##########################
# better_effort_utils (important for effort_save)
##########################
effort_save <- function (aDataFrame,
column_name = "REVIEWERS",
directory = getwd(),
quiet = FALSE) {
split_List <- split(aDataFrame, f = aDataFrame[, column_name])
lapply(split_List, function(x, column_name) {
fileName <- paste0("effort_", x[1, column_name], ".csv")
if(file.exists(file.path(directory, fileName))) {
while (file.exists(file.path(directory, fileName)) != FALSE) fileName <- renameFile(fileName)
if(!quiet) message(paste0("File already existed, renamed: ", fileName))
}
fileName <- file.path(directory, fileName)
write.csv(x, file = fileName, na = "NA", row.names = FALSE)
}, column_name = column_name)
if(!quiet) message(paste0(length(split_List), " files saved in: ", directory))
}
######################
# better_effort_initialize
######################
better_effort_initialize <- function(aDataFrame,
study_ID = TRUE,
unscreenedValue = "not vetted",
unscreenedCommentValue = "Please paste text here",
studyTypeValue = "not vetted",
studyTypeCommentValue = "Please paste text here",
dual = FALSE,
front = TRUE) {
# adding new columns start, add the new columns as part of the "if" statement as well as the "else" statement
if(dual == TRUE) {
new_cols <- data.frame(REVIEWERS_A = NA,
INCLUDE_A = unscreenedValue,
REVIEWERS_B = NA,
INCLUDE_B = unscreenedValue,
INCLUDE_COMMENT = unscreenedCommentValue,
TYPE_OF_STUDY = studyTypeValue,
TYPE_OF_STUDY_COMMENT = studyTypeCommentValue) # There will have to be a version A and version B, just like with the reviewers
}
else new_cols <- data.frame(REVIEWERS = NA,
INCLUDE = unscreenedValue,
INCLUDE_COMMENT = unscreenedCommentValue,
TYPE_OF_STUDY = studyTypeValue,
TYPE_OF_STUDY_COMMENT = studyTypeCommentValue)
if(study_ID == TRUE) new_cols <- cbind(data.frame(STUDY_ID = 1:nrow(aDataFrame)),
new_cols)
if(front == TRUE) newDataFrame <- cbind(new_cols, aDataFrame)
else newDataFrame <- cbind(aDataFrame, new_cols)
return(newDataFrame)
}
#################################
# better_effort_distribute
#################################
better_effort_distribute <- function (aDataFrame = NULL,
dual = FALSE,
reviewers = theTeam,
column_name = "REVIEWERS",
effort = NULL,
initialize = FALSE,
save_split = FALSE,
directory = getwd() ) {
if(is.null(reviewers)) .metagearPROBLEM("error",
"no reviewers were assigned")
if(is.null(aDataFrame)) .metagearPROBLEM("error",
"a dataframe with refs was not specified")
number_REFS <- nrow(aDataFrame)
number_reviewers <- length(reviewers)
# add REVIEWER, STUDY_ID, and INCLUDE columns to reference library
if(initialize == TRUE) aDataFrame <- better_effort_initialize(aDataFrame,
dual = dual)
if(dual == TRUE) {
if(!is.null(effort)) .metagearPROBLEM("error",
"can only assign dual effort evenly among reviewers")
if(number_reviewers %% 2 == 1) .metagearPROBLEM("error",
"can only assign dual effort with an even number of reviewers")
reviewers_A <- reviewers[1:number_reviewers %% 2 == 1]
theEffort_A <- gl(length(reviewers_A),
ceiling(number_REFS / length(reviewers_A)),
number_REFS,
labels = reviewers_A)
reviewers_B <- reviewers[1:number_reviewers %% 2 == 0]
theEffort_B <- gl(length(reviewers_B),
ceiling(number_REFS / length(reviewers_B)),
number_REFS,
labels = reviewers_B)
dualEffort <- data.frame(A = theEffort_A, B = theEffort_B)
theEffort <- dualEffort[sample(nrow(dualEffort),
nrow(dualEffort), replace = FALSE), ]
aDataFrame["REVIEWERS_A"] <- theEffort["A"]
aDataFrame["REVIEWERS_B"] <- theEffort["B"]
}
else {
# generate reviewers tasks evenly or via custom 'effort'
if(is.vector(effort) && length(unique(effort)) != 1) {
if(sum(effort) != 100) .metagearPROBLEM("error",
"Effort does not sum to 100.")
theEffort <- rep(reviewers, round((number_REFS * (effort / 100))))
} else {
theEffort <- gl(number_REFS,
ceiling(number_REFS / number_reviewers),
number_REFS,
labels = reviewers)
}
# randomly populate REVIEWERS column with tasks
aDataFrame[, column_name] <- sample(theEffort,
length(theEffort),
replace = FALSE)
}
# splits reference library into seperate reviewer csv files and
# hides teams if dual reviewing
if(save_split == TRUE) {
if(dual == TRUE) {
removeVars <- names(aDataFrame) %in% c("REVIEWERS_B", "INCLUDE_B")
effort_save(aDataFrame[!removeVars],
column_name = "REVIEWERS_A", directory)
removeVars <- names(aDataFrame) %in% c("REVIEWERS_A", "INCLUDE_A")
effort_save(aDataFrame[!removeVars],
column_name = "REVIEWERS_B", directory)
}
else effort_save(aDataFrame, column_name, directory)
}
return(aDataFrame)
}
#######################################
# better_abstract_screener
#######################################
#' #param file The file name and location of a .csv file containing the
#' abstracts and titles. The .csv file should have been initialized with
#' \code{effort_initialize} and populated with screeners (reviewers) using
#' \code{better_effort_distribute}.
#' #param aReviewer The name (a string) of the reviewer to screen abstracts.
#' It is used when there are multiple reviewers assigned to screen abstracts.
#' The default column label is "REVIEWERS" as initialized with
#' \code{better_effort_distribute}.
#' #param reviewerColumnName The name of the column heading in the .csv file
#' that contains the reviewer names that will screen abstracts. The default
#' column label is "REVIEWERS".
#' #param unscreenedColumnName The name of the column heading in the .csv file
#' that contains the screening outcomes (i.e. vetting outcomes by a reviewer).
#' Unscreened references are by default labeled as "not vetted". The
#' reviewer then can code to "YES" (is a relevant study), "NO" is not relevant
#' and should be excluded, or "MAYBE" if the title/abstract is missing or
#' does not contains enough information to fully assess inclusivity.
#' The default label of this column is "INCLUDE".
#' #param unscreenedValue Changes the default coding (a string) of "not vetted"
#' that designates whether an abstract remains to be screened or vetted.
#' #param abstractColumnName The name of the column heading in the .csv file
#' that contains the abstracts. The default label of this column is
#' "ABSTRACT".
#' #param titleColumnName The name of the column heading in the .csv file
#' that contains the titles. The default label of this column is "TITLE".
#' #param browserSearch Change the url for the browser title search; the
#' default is Google.
#' #param protect When \code{"TRUE"}, prevents the title and abstract from being
#' clicked, selected or edited.
#' #param fontSize Change the font size of the title and abstract text.
#' #param windowWidth Change the default width of the GUI window.
#' #param windowHeight Change the default height of the GUI window.
#' #param buttonSize Change the default size of the "YES" and "NO" buttons.
#'
#'
#' #return NULL
#'
#' #examples \dontrun{
#'
#' data(example_references_metagear)
#' better_effort_distribute(example_references_metagear,
#' initialize = TRUE, reviewers = "marc", save_split = TRUE)
#' abstract_screener("effort_marc.csv", aReviewer = "marc")
#'}
#'
#' #note \strong{Installation and troubleshooting}\cr\cr Upon first use,
#' \code{abstract_screener} will download the gWidgets package
#' and associated toolkits needed to build GUI interfaces. A small window will
#' also prompt you to download GTK+ asking "Need GTK+ ?". From the listed
#' options answer: "Install GTK+" and click 'OK'. Once installed these will
#' not be downloaded again. Sometimes there is an issue with the installation
#' of GTK+, see \url{http://www.learnanalytics.in/blog/?p=31} for advice based
#' on the \code{Rattle} R Package (both \code{Rattle} and \code{metagear} use
#' the same GUI dependencies). \cr\cr \strong{How to use the screener}
#' \cr\cr The GUI itself will appear as a single window with the first
#' title/abstract listed in the .csv file. If abstracts have already been
#' screened/coded, it will begin at the nearest reference labeled as
#' "not vetted". The SEARCH WEB button opens the default browser and
#' searches Google with the title of the reference. The YES, MAYBE, NO
#' buttons, which also have shortcuts ALT-Y and ALT-N, are used to code the
#' inclusion/exclusion of the reference. Once clicked/coded the next
#' reference is loaded. The SAVE button is used to save the coding progress
#' of screening tasks. It will save coding progress directly to the
#' loaded .csv file. \strong{Closing the GUI and not saving will result in
#' the loss of screening efforts relative to last save.} \cr\cr There is
#' also an ISSUE FIXES menu bar with quick corrections to screening errors.
#' These include ISSUE FIXES: REFRESH TITLE AND ABSTRACT TEXT which reloads
#' the text of the current abstract in case portions were deleted when
#' copying and pasting sections (this can be avoided if
#' \code{protect = TRUE} is enabled), ISSUE FIXES: STATUS OF CURRENT ABSTRACT
#' which provides information on whether or not the abstract was previously
#' screened, and ISSUE FIXES: RETURN TO PREVIOUS ABSTRACT that
#' backtracks to the previous abstract if a selection error occurred (note a
#' warning will appear of there is a change to its inclusion/exclusion
#' coding).
#'
#' #import gWidgets
#' #import gWidgetsRGtk2
#' #importFrom utils browseURL read.csv write.csv
#' #export abstract_screener
############################
better_abstract_screener <- function(file = file.choose(),
aReviewer = NULL,
reviewerColumnName = "REVIEWERS",
unscreenedColumnName = "INCLUDE",
unscreenedValue = "not vetted",
unscreenedCommentColumnName = "INCLUDE_COMMENT",
unscreenedCommentValue = "",
studyTypeColumnName = "TYPE_OF_STUDY",
studyTypeValue = "not vetted",
studyTypeCommentColumnName = "TYPE_OF_STUDY_COMMENT",
studyTypeCommentValue = "",
abstractColumnName = "Abstract",
titleColumnName = "Title",
browserSearch = "https://scholar.google.de/scholar?hl=de&as_sdt=0%2C5&q=",
protect = FALSE,
fontSize = 13,
windowWidth = 700,
windowHeight = 400,
buttonSize = 30) {
# get file with abstract
aDataFrame <- read.csv(file, header = TRUE)
# subset abstracts based on the current screener (aka 'reviewer')
subData <- subset(aDataFrame, aDataFrame[reviewerColumnName] == aReviewer)
subData <- data.frame(lapply(subData, as.character), stringsAsFactors = FALSE)
# check if all abstracts have been already vetted
if(unscreenedValue %in% subData[, unscreenedColumnName] ) {
# start screener at first unvetted abstract
currentItem <- max.col(t(subData[unscreenedColumnName] == unscreenedValue),
"first")
} else {
.metagearPROBLEM("error",
paste("all abstracts have already been screened,
no more abstracts coded as:", unscreenedValue))
}
options("guiToolkit" = "RGtk2")
# used to update the reference list
theAnswer <- function(theValue, ...) {
updateAll(theValue, ...)
}
theAnswer_INCLUDE_COMMENT <- function(theValue_INCLUDE_COMMENT, ...) {
updateAll_INCLUDE_COMMENT(theValue_INCLUDE_COMMENT, ...)
}
theAnswer_ToS <- function(theValue_ToS, ...) {
updateAll_ToS(theValue_ToS, ...)
}
theAnswer_ToS_COMMENT <- function(theValue_ToS_COMMENT, ...) {
updateAll_ToS_COMMENT(theValue_ToS_COMMENT, ...)
}
# helper function used to update and keep track of screened abstracts
updateAll <- function(theValue, ...) {
if(currentItem <= nrow(subData)) {
subData[[currentItem, unscreenedColumnName]] <<- theValue
}
}
updateAll_INCLUDE_COMMENT <- function(theValue_INCLUDE_COMMENT, ...) { ################### EXPERIMENTAL
if(currentItem <= nrow(subData)) {
subData[[currentItem, unscreenedCommentColumnName]] <<- theValue_INCLUDE_COMMENT
}
}
updateAll_ToS <- function(theValue_ToS, ...) {
if(currentItem <= nrow(subData)) {
subData[[currentItem, studyTypeColumnName]] <<- theValue_ToS
}
}
updateAll_ToS_COMMENT <- function(theValue_ToS_COMMENT, ...) {
if(currentItem <= nrow(subData)) {
subData[[currentItem, studyTypeCommentColumnName]] <<- theValue_ToS_COMMENT
}
}
####################
# START of SCREENER GUI
####################
win <- gwindow("metagear: Abstract Screener", visible = TRUE)
paned <- ggroup(container = win, horizontal = FALSE)
# Frame(s) for title, abstract and websearch button
#####
#beginnig frame_TITLE
frame_TITLE <- gframe("Title", container = paned, horizontal = TRUE)
text_TITLE <- gtext(subData[currentItem, titleColumnName],
container = frame_TITLE,
expand = TRUE,
font.attr = list(style = "normal", size = fontSize))
size(text_TITLE) <- c(windowWidth, 50)
if(protect == TRUE) enabled(text_TITLE) <- FALSE
addSpace(frame_TITLE, 2)
aButton_webSearch <- gbutton("Search\n Web",
container = frame_TITLE,
handler = function(h, ...)
browseURL(paste0(browserSearch,
subData[currentItem, titleColumnName])))
size(aButton_webSearch) <- c(50, 40)
addSpace(frame_TITLE, 5)
# end of frame_TITLE
# beginning frame_Abstract
frame_ABSTRACT <- gframe("Abstract", container = paned, horizontal = FALSE)
text_ABSTRACT <- gtext(subData[currentItem, abstractColumnName],
container = frame_ABSTRACT,
expand = TRUE,
font.attr = list(style = "normal", size = fontSize)
)
size(text_ABSTRACT) <- c(windowWidth + 50, 300)
if(protect == TRUE) enabled(text_ABSTRACT) <- FALSE
# end of frame_ABSTRACT
# beginning: Type of Study (ToS), buttons and comment
frame_TYPE_OF_STUDY <- gframe("Type of Study", container = paned, horizontal = TRUE)
addSpace(frame_TYPE_OF_STUDY, 20)
radioButtonNames_ToS <- c("not vetted", "empirical", "conceptual", "review")
radioButtons_ToS <- gradio(radioButtonNames_ToS, selected = which(radioButtonNames_ToS == subData[currentItem, studyTypeColumnName]), horizontal = FALSE, container = frame_TYPE_OF_STUDY,
handler = function(h,...){
svalue(h) <- subData[currentItem, studyTypeColumnName]
theAnswer_ToS(theValue_ToS = radioButtonNames_ToS[svalue(radioButtons_ToS, index = TRUE)], ...) # EXPERIMENTAL: Need to find a way t make the 3 a dynamic option that shows current selection (Current solution seems to be working)
}
)
frame_TYPE_OF_STUDY_COMMENT <- gframe("Please copy the text snippet upon which you base your decision",
container = frame_TYPE_OF_STUDY, horizontal = TRUE)
text_TYPE_OF_STUDY_COMMENT <- gtext(subData[currentItem, studyTypeCommentColumnName],
container = frame_TYPE_OF_STUDY_COMMENT,
#container = frame_TYPE_OF_STUDY, ### change to this frame and disable frame_TYPE_OF_STUDY_COMMENT, if you want the text field width to be expandable
expand = TRUE,
font.attr = list(style = "normal", size = fontSize),
handler = function(h, ...) {
theAnswer_ToS_COMMENT(theValue_ToS_COMMENT = svalue(text_TYPE_OF_STUDY_COMMENT))
}
)
size(text_TYPE_OF_STUDY_COMMENT) <- c(windowWidth, 70)
# end: Type of Study (ToS), buttons and comment
# beginning: Include/Exclude (YES/NO), buttons and comment
frame_INCLUDE <- gframe("Should the Abstract be included?", container = paned, horizontal = TRUE)
addSpace(frame_INCLUDE, 20)
radioButtonNames_INCLUDE <- c("not vetted", "YES", "NO", "MAYBE")
radioButtons_INCLUDE <- gradio(radioButtonNames_INCLUDE, selected = which(radioButtonNames_INCLUDE == subData[currentItem, unscreenedColumnName]),
horizontal = FALSE, container = frame_INCLUDE,
handler = function(h,...){
svalue(h) <- subData[currentItem, unscreenedColumnName]
theAnswer(theValue = radioButtonNames_INCLUDE[svalue(radioButtons_INCLUDE, index = TRUE)], ...)
}
)
frame_INCLUDE_COMMENT <- gframe("Please copy the text snippet upon which you base your decision", container = frame_INCLUDE,
horizontal = TRUE)
text_INCLUDE_COMMENT <- gtext(subData[currentItem, unscreenedCommentColumnName],
container = frame_INCLUDE_COMMENT,
# container = frame_INCLUDE, ### change to this frame and disable frame_INCLUDE_COMMENT, if you want the text field width to be expandable
expand = TRUE,
font.attr = list(style = "normal", size = fontSize),
handler = function(h, ...) {
theAnswer_INCLUDE_COMMENT(theValue_INCLUDE_COMMENT = svalue(text_INCLUDE_COMMENT))
}
)
size(text_INCLUDE_COMMENT) <- c(windowWidth, 70)
#end: Include/Exclude (YES/NO), buttons and comment
#beginning: Progress and Save
buttons_paned <- ggroup(container = paned)
addSpace(buttons_paned, 50)
frame_PROGRESS <- gframe("Progress", container = buttons_paned, expand = TRUE)
addSpace(frame_PROGRESS, 10)
text_progress <- glabel(paste0("Reviewer: ",
aReviewer,
" | ",
round(((currentItem - 1.0)/nrow(subData)) * 100, digits = 1),
"% complete (", currentItem, " of ",
nrow(subData) , ")"),
container = frame_PROGRESS)
aButton_save <- gbutton("SAVE & CONTINUE",
container = frame_PROGRESS,
handler = function(h, ...)
{
{
write.csv(subData,
file = file, #file was dataFilename
row.names = FALSE)
svalue(text_lastSaved) <- paste("last saved: ", Sys.time())
}
currentItem <<- currentItem + 1
if(currentItem > nrow(subData))
{svalue(text_ABSTRACT) <- "You have screened all the Abstracts!"
svalue(text_TITLE) <- ""
} else
{svalue(text_ABSTRACT) <- subData[currentItem, abstractColumnName]
svalue(text_TITLE) <- subData[currentItem, titleColumnName]
svalue(text_progress) <- paste0(
round(((currentItem - 1.0)/nrow(subData)) * 100, digits = 1),
"% complete (", currentItem, " of ", nrow(subData), ")")
svalue(text_TYPE_OF_STUDY_COMMENT) <- subData[currentItem, studyTypeCommentColumnName]
svalue(radioButtons_ToS) <- subData[currentItem, studyTypeColumnName]
svalue(radioButtons_INCLUDE) <- subData[currentItem, unscreenedColumnName]
svalue(text_INCLUDE_COMMENT) <- subData[currentItem, unscreenedCommentColumnName]
}
}
)
size(aButton_save) <- c(130, 40)
text_lastSaved <- glabel(paste(" last saved: not this session"), # empty space at beginning on purpose to leave some distance to button, as addSpace() screwed things up
container = frame_PROGRESS)
#end of Progress and Save
#end of buttons_paned
#end of paned
visible(win) <- TRUE
# end of win
}
###############
# Preparation of the files and starting of the GUI
###############
# Set working directory
setwd("C:/Users/Hilser/Documents/R")
# Add team member(s)
theTeam <- c("Stefan")
#import .csv-file and name it review" ##### REPLACED BY SAMPLE DATA BELOW
# review <- read.csv("C:/Users/Hilser/Documents/R/Metagear/Better_Metagear/review_duplicates_removed.csv", header = TRUE, sep = ",")
# Create Sample Data instead of importing .csv-file
Title <- c("Title 1", "Title 2", "Title 3", "Title 4")
Abstract <- c( "Abstract 1", "Abstract 2", "Abstract 3", "Abstract 4")
review <- data.frame(Title, Abstract)
# Prepare file: Adding columns "STUDY_ID", "REVIEWERS", "INCLUDE" (and fill with "not vetted"), "INCLUDE_COMMENT", "TYPE_OF_STUDY"
review_initialized <- better_effort_initialize(review, study_ID = TRUE, unscreenedValue = "not vetted", dual = FALSE, front = TRUE)
# distribute effort amongst Reviewers, adding their name (reviewers = ) to the column "REVIEWERS"
review_distributed <- better_effort_distribute(review_initialized, dual = FALSE, reviewers = theTeam, column_name = "REVIEWERS",
effort = 100, initialize = FALSE, save_split = TRUE)
# opens a graphical user interface (GUI) that allows for abstract screening
better_abstract_screener("effort_Stefan.csv", aReviewer = "Stefan")
From the described behaviour, I assume that the error lies somewhere in one of the following functions:
aButton_save # The button that saves the file and moves to the next abstract
the theAnswer functions # used to update the reference list
the updateAll functions # helper function used to update and keep track of screened abstracts
Sorry, my guess is that the font.attribute you specify for text_TITLE isn't being preserved after you call svalue(text_TITLE) <-. The easy solution would be to call font(text_TITLE)<- ... after setting the text. The proper solution would be to fix this method: https://github.com/jverzani/gWidgets2RGtk2/blob/master/R/gtext.R#L84 (this should use the method insert_text https://github.com/jverzani/gWidgets2RGtk2/blob/master/R/gtext.R#L160 which does adjust for the font attribute.
With that in mind, you might try this 1-2 punch to set text:
svalue(text_TITLE) <- ""
text_TITLE$insert_text(new_text, "beginning")
I am looking for the ability to start R processes Asynchronously from within R.
Something like the below function
startFunctionInAsynchMode<-function(workingDir,filesToSource, functionName, ...){
#workingdir - the dir that should be set as wd
#filesToSource - vector of fileNames to be sourced
#functionName - the actual function to be run asynchrously
#... - other parameters to be passed to the function
#Return Value - should be the System Process Id Started
}
Would anyone have quick ideas? I checked packages like parallel etc. but doesn't seem to fit.
Thanks in advance
Here is an implementation using R CMD. Basic version tested. And with some open items.
startFunctionInAsynchMode<-function(workingDir,filesToSource, functionName, ...){
wd<-getwd()
setwd(workingDir)
fs<-makeFiles()
scriptFile<-fs$ScriptFile
cat(file=scriptFile,paste0("source(\"",filesToSource,"\")", collapse = "\n"))
cat(file=scriptFile,"\n",append = T)
functionCall<-getFunctionCall(functionName,as.list(match.call()), startIndex=5)
cat(file=scriptFile,functionCall,append = T)
commandsToRun <- paste0("(R CMD BATCH ", scriptFile, " ",fs$LogFile , " --slave ) &")
print(commandsToRun)
system(commandsToRun)
Sys.sleep(5)
pids<-getPids(scriptFile, "--restore")
cat(file=fs$KillScript,paste0("kill -9 ",pids$PID[1]))
setwd(wd)
return(as.character(pids$PID[1]))
}
makeFiles<-function(){
res<-list()
dir.create("./temp/tempRgen", recursive=T,showWarnings = F)
tf<-tempfile("rGen-","./temp/tempRgen", fileext = "")
res$ScriptFile<-paste0(tf,".R")
res$LogFile<-paste0(tf,".log")
res$KillScript<-paste0(tf,"-kill.sh")
file.create(res$KillScript,showWarnings = F)
file.create(res$ScriptFile,showWarnings = F)
res
}
#Open Items to be handled
#1. Named Arguments
#2. Non String Arguments
getFunctionCall<-function(functionName,argList,startIndex){
res<-paste0(functionName,"(")
if(!is.null(argList)){
if(length(argList)>=startIndex){
first=T
for(i in startIndex:length(argList)){
if(first){
first=F
} else {
res<-paste0(res,",")
}
res<-paste0(res,"\"",argList[[i]],"\"")
}
}
}
res<-paste0(res,")")
}
getPids <- function(grepFor, refineWith){
numCols <- length(unlist(str_split(system("ps aux", intern=T)[1], "\\s+")))
psOutput <- system(paste0("ps auxww | grep ", grepFor), intern=T)
psOutput <- psOutput[str_detect(psOutput, refineWith)]
pidDf <- ldply(psOutput, parseEachPsLine)
# Remove the process that actually grep-ed for my search string
pidDf <- pidDf[!str_detect(pidDf$COMMAND, "grep"),]
return(pidDf)
}
parseEachPsLine <- function(line){
tabular <- read.table(textConnection(line), header=F, sep=" ")
tabular <- tabular[!is.na(tabular)]
psTitles <- c("USER", "PID", "CPU", "MEM", "VSZ", "RSS", "TTY", "STAT", "START", "TIME", "COMMAND")
psColNames <- setNames(seq(1, length(psTitles)), psTitles)
COMMAND <- paste0(tabular[(psColNames["COMMAND"]):length(tabular)], collapse=" ")
return(data.frame("PID"=tabular[psColNames["PID"]], "STARTED"=tabular[psColNames["START"]], "COMMAND"=COMMAND, "STATUS"=tabular[psColNames["STAT"]]))
}
I have a question similar to the below link in stackoverflow
R+Hadoop: How to read CSV file from HDFS and execute mapreduce?
I am tring to read a file from location "/somnath/logreg_data/ds1.10.csv" in HDFS, reduce its number of columns from 10 to 5 and then write to another location "/somnath/logreg_data/reduced/ds1.10.reduced.csv" in HDFS using the below
transfer.csvfile.hdfs.to.hdfs.reduced function.
transfer.csvfile.hdfs.to.hdfs.reduced("hdfs://10.5.5.82:8020/somnath/logreg_data/ds1.10.csv", "hdfs://10.5.5.82:8020/somnath/logreg_data/reduced/ds1.10.reduced.csv", 5)
The function definition is
transfer.csvfile.hdfs.to.hdfs.reduced =
function(hdfsFilePath, hdfsWritePath, reducedCols=1) {
#local.df = data.frame()
#hdfs.get(hdfsFilePath, local.df)
#to.dfs(local.df)
#r.file <- hdfs.file(hdfsFilePath,"r")
transfer.reduced.map =
function(.,M) {
label <- M[,dim(M)[2]]
reduced.predictors <- M[,1:reducedCols]
reduced.M <- cbind(reduced.predictors, label)
keyval(
1,
as.numeric(reduced.M))
}
reduced.values =
values(
from.dfs(
mapreduce(
input = from.dfs(hdfsFilePath),
input.format = "native",
map = function(.,M) {
label <- M[,dim(M)[2]]
print(label)
reduced.predictors <- M[,1:reducedCols]
reduced.M <- cbind(reduced.predictors, label)
keyval(
1,
as.numeric(reduced.M))}
)))
write.table(reduced.values, file="/root/somnath/reduced.values.csv")
w.file <- hdfs.file(hdfsWritePath,"w")
hdfs.write(reduced.values,w.file)
#to.dfs(reduced.values)
}
But I am receiving an error
Error in file(fname, paste(if (is.read) "r" else "w", if (format$mode == :
cannot open the connection
Calls: transfer.csvfile.hdfs.to.hdfs.reduced ... make.keyval.reader -> do.call -> <Anonymous> -> file
In addition: Warning message:
In file(fname, paste(if (is.read) "r" else "w", if (format$mode == :
cannot open file 'hdfs://10.5.5.82:8020/somnath/logreg_data/ds1.10.csv': No such file or directory
Execution halted
OR
When I am trying to load a file from hdfs using the below commands, I am getting the below error:
> x <- hdfs.file(path="hdfs://10.5.5.82:8020/somnath/logreg_data/ds1.10.csv",mode="r")
Error in hdfs.file(path = "hdfs://10.5.5.82:8020/somnath/logreg_data/ds1.10.csv", :
attempt to apply non-function
Any help will be highly appreciated
Thanks
Basically found a solution to the problem that I stated above.
r.file <- hdfs.file(hdfsFilePath,"r")
from.dfs(
mapreduce(
input = as.matrix(hdfs.read.text.file(r.file)),
input.format = "csv",
map = ...
))
Below is the entire modified function:
transfer.csvfile.hdfs.to.hdfs.reduced =
function(hdfsFilePath, hdfsWritePath, reducedCols=1) {
hdfs.init()
#local.df = data.frame()
#hdfs.get(hdfsFilePath, local.df)
#to.dfs(local.df)
r.file <- hdfs.file(hdfsFilePath,"r")
transfer.reduced.map =
function(.,M) {
numRows <- length(M)
M.vec.elems <-unlist(lapply(M,
function(x) strsplit(x, ",")))
M.matrix <- matrix(M.vec.elems, nrow=numRows, byrow=TRUE)
label <- M.matrix[,dim(M.matrix)[2]]
reduced.predictors <- M.matrix[,1:reducedCols]
reduced.M <- cbind(reduced.predictors, label)
keyval(
1,
as.numeric(reduced.M))
}
reduced.values =
values(
from.dfs(
mapreduce(
input = as.matrix(hdfs.read.text.file(r.file)),
input.format = "csv",
map = function(.,M) {
numRows <- length(M)
M.vec.elems <-unlist(lapply(M,
function(x) strsplit(x, ",")))
M.matrix <- matrix(M.vec.elems, nrow=numRows, byrow=TRUE)
label <- M.matrix[,dim(M.matrix)[2]]
reduced.predictors <- M.matrix[,1:reducedCols]
reduced.M <- cbind(reduced.predictors, label)
keyval(
1,
as.numeric(reduced.M)) }
)))
write.table(reduced.values, file="/root/somnath/reduced.values.csv")
w.file <- hdfs.file(hdfsWritePath,"w")
hdfs.write(reduced.values,w.file)
hdfs.close(r.file)
hdfs.close(w.file)
#to.dfs(reduced.values)
}
Hope this helps and don't forget to give points if you find it useful. Thanks ahead
I am new to R , I am trying to run example which is given in "rebmix-help pdf". It use galaxy dataset and here is the code
library(rebmix)
devAskNewPage(ask = TRUE)
data("galaxy")
write.table(galaxy, file = "galaxy.txt", sep = "\t",eol = "\n", row.names = FALSE, col.names = FALSE)
REBMIX <- array(list(NULL), c(3, 3, 3))
Table <- NULL
Preprocessing <- c("histogram", "Parzen window", "k-nearest neighbour")
InformationCriterion <- c("AIC", "BIC", "CLC")
pdf <- c("normal", "lognormal", "Weibull")
K <- list(7:20, 7:20, 2:10)
for (i in 1:3) {
for (j in 1:3) {
for (k in 1:3) {
REBMIX[[i, j, k]] <- REBMIX(Dataset = "galaxy.txt",
Preprocessing = Preprocessing[k], D = 0.0025,
cmax = 12, InformationCriterion = InformationCriterion[j],
pdf = pdf[i], K = K[[k]])
if (is.null(Table))
Table <- REBMIX[[i, j, k]]$summary
else Table <- merge(Table, REBMIX[[i, j,k]]$summary, all = TRUE, sort = FALSE)
}
}
}
It is giving me error ERROR:
unused argument (InformationCriterion = InformationCriterion[j])
Plz help
I'm running R 3.0.2 (Windows) and the library rebmix defines a function REBMIX where InformationCriterion is not listed as a named argument, but Criterion.
Brief invoke REBMIX as :
REBMIX[[i, j, k]] <- REBMIX(Dataset = "galaxy.txt",
Preprocessing = Preprocessing[k], D = 0.0025,
cmax = 12, Criterion = InformationCriterion[j],
pdf = pdf[i], K = K[[k]])
It looks as though there have been substantial changes to the rebmix package since the example mentioned in the OP was created. Among the most noticable changes is the use of S4 classes.
There's also an updated demo in the rebmix package using the galaxy data (see demo("rebmix.galaxy"))
To get the above example to produce results (Note: I am not familiar with this package or the rebmix algorithm!!!):
Change the argument to Criterion as mentioned by #Giupo
Use the S4 slot access operator # instead of $
Don't name the results object REDMIX because that's already the function name
library(rebmix)
data("galaxy")
## Don't re-name the REBMIX object!
myREBMIX <- array(list(NULL), c(3, 3, 3))
Table <- NULL
Preprocessing <- c("histogram", "Parzen window", "k-nearest neighbour")
InformationCriterion <- c("AIC", "BIC", "CLC")
pdf <- c("normal", "lognormal", "Weibull")
K <- list(7:20, 7:20, 2:10)
for (i in 1:3) {
for (j in 1:3) {
for (k in 1:3) {
myREBMIX[[i, j, k]] <- REBMIX(Dataset = list(galaxy),
Preprocessing = Preprocessing[k], D = 0.0025,
cmax = 12, Criterion = InformationCriterion[j],
pdf = pdf[i], K = K[[k]])
if (is.null(Table)) {
Table <- myREBMIX[[i, j, k]]#summary
} else {
Table <- merge(Table, myREBMIX[[i, j,k]]#summary, all = TRUE, sort = FALSE)
}
}
}
}
I guess this is late. But I encountered a similar problem just a few minutes ago. And I realized the real scenario that you may face when you got this kind of error msg... It's just the version conflict.
You may use a different version of the R package from the tutorial, thus the argument names could be different between what you are running and what the real code use.
So please check the version first before you try to manually edit the file. Also, it happens that your old version package is still in the path and it overrides the new one. This was exactly what I had... since I manually installed the old and new version separately...