I need to write this data to a .csv file - r

I'm using the following query and trying to write the results to a .csv file:
.libPaths("G:/R/R-3.6.1/library")
library(mongolite)
library(data.table)
library(dplyr)
###Path to list of search terms
#------------------------------------------------------------------------------------------------------------#
#Input the words you want to search in a text file, and call the text file below in place of ".txt"
#-------------------------------------------------------------------------------------------------------------#
searchStrings = readLines("//int/elm/Work/Text Analytics/Opportunities/New Folder/terms.txt")
searchCounts = data.table(searchString = searchStrings, count = 0)
db <- mongo(collection = "2020Emails", db = "textAnalytics", verbose = TRUE,
url = "mongodb://user:m0ng0b0ng0#interactionsprojection:7999/textAnalytics")
firstQuery = TRUE
#Update this JSON if if you want different fields returned
fieldsjson = '{"DocEid" : true,
"RequestType" : true,
"FromEmailAddress" : true,
"ReceiptTime" : true,
"RawBodyText" : true,
"CMF" : true,
"ReplyTo" : true,
"InboundMode" : true,
"PartNumbers" : true,
"_id": false}'
for (term in searchStrings) {
queryString = paste0('{"$text" : { "$search" : "\\"',term,'\\"" }}')
if (firstQuery == TRUE) {
results = NULL
results = data.table(db$find(query = queryString, fields = fieldsjson))
if (nrow(results) > 0) {
results[, searchString := term]
searchCounts[searchString == term, count := nrow(results)]
firstQuery = FALSE
}
} else {
tempdt = data.table(db$find(query = queryString, fields = fieldsjson))
if (nrow(tempdt) > 0) {
tempdt[, searchString := term]
results = rbind(results,tempdt, fill= TRUE)
searchCounts[searchString == term, count := nrow(tempdt)]
}
}
}
View(results)
#------------------------------------------------------------------------------#
# Specify the location and new file name where the results will be stored below
#------------------------------------------------------------------------------#
fwrite(results, "C:/Results/terms.csv")
I am getting the following error when trying to write this to a .csv. file.
Error in fwrite(results, "C:/Results/terms.csv") :
Row 1 of list column is type 'list' - not yet implemented. fwrite() can write list columns containing items which are atomic vectors of type logical, integer, integer64, double, complex and character.

Related

terraform nested dynamic block with nested map

I'm trying to get tf 0.12.x new dynamic feature to work with a nested map, config is below.
As you can see below (simplified for this) I'm defining all the variables and adding variable required_resource_access which contains a map.
I was hoping to use new dynamic feature to create read this map in a nested dyanmic block.
variable prefix {
description = "Prefix to applied to all top level resources"
default = "abx"
}
variable suffix {
description = "Suffix to applied to all valid top level resources, usually this is 2 letter region code such as we (westeurope), ne (northeurope)."
default = "we"
}
variable env {
description = "3 letter environment code appied to all top level resources"
default = "dev"
}
variable location {
description = "Where to create all resources in Azure"
default = "westeurope"
}
variable available_to_other_tenants {
default = false
}
variable oauth2_allow_implicit_flow {
default = true
}
variable public_client {
default = false
}
# other option is native
variable application_type {
default = "webapp/api"
}
variable required_resource_access {
type = list(object({
resource_app_id = string
resource_access = object({
id = string
type = string
})
}))
default = [{
resource_app_id = "00000003-0000-0000-c000-000000000000"
resource_access = {
id = "7ab1d382-f21e-4acd-a863-ba3e13f7da61"
type = "Role"
}
}]
}
variable reply_urls {
default = []
}
variable group_membership_claims {
default = "All"
}
resource "azuread_application" "bootstrap" {
name = "${var.prefix}-${var.env}-spn"
homepage = "http://${var.prefix}-${var.env}-spn"
identifier_uris = ["http://${var.prefix}-${var.env}-spn"]
reply_urls = var.reply_urls
available_to_other_tenants = var.available_to_other_tenants
oauth2_allow_implicit_flow = var.oauth2_allow_implicit_flow
type = var.application_type
group_membership_claims = var.group_membership_claims
dynamic "required_resource_access" {
for_each = var.required_resource_access
content {
resource_app_id = required_resource_access.value["resource_app_id"]
dynamic "resource_access" {
for_each = required_resource_access.value["resource_access"]
content {
id = resource_access.value["id"]
type = resource_access.value["type"]
}
}
}
}
}
But for reasons beyond my knowledge it keeps giving me this error (notice it's priting it twice as well), I've tried a few other options but this is the closest I managed to get where it would at least give me a meaningful error.
------------------------------------------------------------------------
Error: Invalid index
on pe_kubernetes.tf line 24, in resource "azuread_application" "bootstrap":
24: id = resource_access.value["id"]
|----------------
| resource_access.value is "7ab1d382-f21e-4acd-a863-ba3e13f7da61"
This value does not have any indices.
Error: Invalid index
on pe_kubernetes.tf line 24, in resource "azuread_application" "bootstrap":
24: id = resource_access.value["id"]
|----------------
| resource_access.value is "Role"
This value does not have any indices.
Error: Invalid index
on pe_kubernetes.tf line 25, in resource "azuread_application" "bootstrap":
25: type = resource_access.value["type"]
|----------------
| resource_access.value is "7ab1d382-f21e-4acd-a863-ba3e13f7da61"
This value does not have any indices.
Error: Invalid index
on pe_kubernetes.tf line 25, in resource "azuread_application" "bootstrap":
25: type = resource_access.value["type"]
|----------------
| resource_access.value is "Role"
This value does not have any indices.
Spent the best part of 2 days on this with no luck so any help or pointers would be much appreciated!
I had some time to test my comment...
If I change the resource_access to a list it works.
See code below:
variable required_resource_access {
type = list(object({
resource_app_id = string
resource_access = list(object({
id = string
type = string
}))
}))
default = [{
resource_app_id = "00000003-0000-0000-c000-000000000000"
resource_access = [{
id = "7ab1d382-f21e-4acd-a863-ba3e13f7da61"
type = "Role"
}]
}]
}
resource "azuread_application" "bootstrap" {
name = "test"
type = "webapp/api"
group_membership_claims = "All"
dynamic "required_resource_access" {
for_each = var.required_resource_access
content {
resource_app_id = required_resource_access.value["resource_app_id"]
dynamic "resource_access" {
for_each = required_resource_access.value["resource_access"]
content {
id = resource_access.value["id"]
type = resource_access.value["type"]
}
}
}
}
}
And the plan shows:
Terraform will perform the following actions:
# azuread_application.bootstrap will be created
+ resource "azuread_application" "bootstrap" {
+ application_id = (known after apply)
+ available_to_other_tenants = false
+ group_membership_claims = "All"
+ homepage = (known after apply)
+ id = (known after apply)
+ identifier_uris = (known after apply)
+ name = "test"
+ oauth2_allow_implicit_flow = true
+ object_id = (known after apply)
+ owners = (known after apply)
+ public_client = (known after apply)
+ reply_urls = (known after apply)
+ type = "webapp/api"
+ oauth2_permissions {
+ admin_consent_description = (known after apply)
...
}
+ required_resource_access {
+ resource_app_id = "00000003-0000-0000-c000-000000000000"
+ resource_access {
+ id = "7ab1d382-f21e-4acd-a863-ba3e13f7da61"
+ type = "Role"
}
}
}
Plan: 1 to add, 0 to change, 0 to destroy.
I removed a lot of your variables an some of the optional Arguments for azuread_application to keep the code as small as possible, but the same principle applies to your code, use lists on for_each or it will loop on the object properties.

How to include / exclude filter statement in R httr query for Localytics

I can successfully query data from Localytics using R, such as the following example:
r <- POST(url = "https://api.localytics.com/v1/query,
body=list(app_id=<APP_ID>,
metrics=c("occurrences","users"),
dimensions=c('a:URI'),
conditions=list(day = c("between", "2020-02-11", "2020-03-12"),
event_name = "Content Viewed",
"a:Item URI" = "testing")
),
encode="json",
authenticate(Key,Secret),
accept("application/json"),
content_type("application/json"))
stop_for_status(r)
But what I would like to do is create a function so I can do this quickly and not have to copy/paste data.
The issue I am running into is with the line "a:Item URI" = "testing", where I am filtering all searches by the Item URI where they all equal "testing", but sometimes, I don't want to include the filter statement, so I just remove that line entirely.
When I wrote my function, I tried something like the following:
get_localytics <- function(appID, metrics, dimensions, from = Sys.Date()-30,
to = Sys.Date(), eventName = "Content Viewed",
Key, Secret, filterDim = NULL, filterCriteria = NULL){
r <- httr::POST(url = "https://api.localytics.com/v1/query",
body = list(app_id = appID,
metrics = metrics,
dimensions = dimensions,
conditions = list(day = c("between", as.character(from), as.character(to)),
event_name = eventName,
filterDim = filterCriteria)
),
encode="json",
authenticate(Key, Secret),
accept("application/json"),
content_type("application/json"))
stop_for_status(r)
result <- paste(rawToChar(r$content),collapse = "")
document <- fromJSON(result)
df <- document$results
return(df)
}
But my attempt at adding filterDim and filterCriteria only produce the error Unprocessable Entity. (Keep in mind, there are lots of variables I can filter by, not just "a:Item URI" so I need to be able to manipulate that as well.
How can I include a statement, where if I need to filter, I can incorporate that line, but if I don't need to filter, that line isn't included?
conditions is just a list, so you can conditionally add elements to it. Here we just use an if statement to test of the values are passed and if so, add them in.
get_localytics <- function(appID, metrics, dimensions, from = Sys.Date()-30,
to = Sys.Date(), eventName = "Content Viewed",
Key, Secret, filterDim = NULL, filterCriteria = NULL){
conditions <- list(day = c("between", as.character(from), as.character(to)),
event_name = eventName)
if (!is.null(filterDim) & !is.null(filterCriteria)) {
conditions[[filterDim]] <- filterCriteria)
}
r <- httr::POST(url = "https://api.localytics.com/v1/query",
body = list(app_id = appID,
metrics = metrics,
dimensions = dimensions,
conditions = conditions),
encode="json",
authenticate(Key, Secret),
accept("application/json"),
content_type("application/json"))
stop_for_status(r)
result <- paste(rawToChar(r$content),collapse = "")
document <- fromJSON(result)
df <- document$results
return(df)
}

Modify cell in a R DT::datatable based on previous row

I have a shiny app where I would like to modify the data displayed and/or the attributes of a cell based on the value of the same cell in the previous row.
In my code I have formatted whole rows based on the value of data[0] in rowCallback.
output$result <- DT::renderDataTable(tabledata(),
class = c('compact'),
rownames = FALSE,
server = FALSE,
escape = TRUE,
extensions = options = list(
rowCallback=JS("
function (row, data, index) {
var string=data[1], substring = 'sub total';
if (data[0]=='Grand Total') {
$(row).css('background-color', '#DEDEDE'), $(row).css('font-weight', 'bold') ;
}
else if (data[0].includes('sub total')) {
$(row).css('font-weight', 'bold');
}
}"
)
)
)
Can I achieve a modification of the data[0] cell based on the value of the same cell in the previous row using one of the callback functions?
So I changed tack and used the following drawCallback call
drawCallback=JS(" function ( settings ) {
var api = this.api();
var mydata = api.rows( {page:'current'} ).data();
var last=null;
api.column(0,{page:'current'}).data().each( function ( value, index ) {
if ( value == last) {
mydata[index][0] = ''
api.rows({ page: 'current' }).invalidate();
}
last=value;
});
}"
)

R : Updating an entry in mongodb using mongolite

I have a mongo database with information that I am passing to some R scripts for analysis. I am currently using the mongolite package to pass the information from mongo to R.
I have a field in each mongo entry called checkedByR, which is a binary that indicates whether the entry has been analysed by the R scripts already. Specifically, I am collecting a mongo entry by its respective mongo ID, running the scripts on the entry, assigning the checkedByR field with a 1, and then moving on.
For completeness, I am querying the database with the following request:
library(mongolite)
mongoID <- "1234abcd1234abcd1234"
m <- mongolite::mongo(url = "mongodb://localhost:27017",
collection = "collection",
db = "database")
rawData <- m$find(query = paste0('{"_id": { "$oid" : "',mongoID,'" }}'),
fields = '{"_id" : 1,
"checkedByR" : 1,
"somethingToCheck" : 1}')
checkedByR <- 1
However, I am having trouble successfully updating the mongo entry with the new checkedByR field.
I realise that an update function exists in the mongolite package (please consider : https://cran.r-project.org/web/packages/mongolite/mongolite.pdf), but I am having trouble gathering relevant examples to help me complete the updating process.
Any help would be greatly appreciated.
the mongo$update() function takes a query and a update argument. You use the query to find the data you want to update, and the update to tell it which field to update.
Consider this example
library(mongolite)
## create some dummy data and insert into mongodb
df <- data.frame(id = 1:10,
value = letters[1:10]
)
mongo <- mongo(collection = "another_test",
db = "test",
url = "mongodb://localhost")
mongo$insert(df)
## the 'id' of the document I want to update
mongoID <- "575556825dabbf2aea1d7cc1"
## find some data
rawData <- mongo$find(query = paste0('{"_id": { "$oid" : "',mongoID,'" }}'),
fields = '{"_id" : 1,
"id" : 1,
"value" : 1}'
)
## ...
## do whatever you want to do in R...
## ...
## use update to query on your ID, then 'set' to set the 'checkedByR' value to 1
mongo$update(
query = paste0('{"_id": { "$oid" : "', mongoID, '" } }'),
update = '{ "$set" : { "checkedByR" : 1} }'
)
## in my original data I didn't have a 'checkedByR' value, but it's added anyway
Update
the rmongodb library is no longer on CRAN, so the below code won't work
And for more complex structures & updates you can do things like
library(mongolite)
library(jsonlite)
library(rmongodb) ## used to insert a non-data.frame into mongodb
## create some dummy data and insert into mongodb
lst <- list(id = 1,
value_doc = data.frame(id = 1:5,
value = letters[1:5],
stringsAsFactors = FALSE),
value_array = c(letters[6:10])
)
## using rmongodb
mongo <- mongo.create(db = "test")
coll <- "test.another_test"
mongo.insert(mongo,
ns = coll,
b = mongo.bson.from.list(lst)
)
mongo.destroy(mongo)
## update document with specific ID
mongoID <- "5755f646ceeb7846c87afd90"
## using mongolite
mongo <- mongo(db = "test",
coll = "another_test",
url = "mongodb://localhost"
)
## to add a single value to an array
mongo$update(
query = paste0('{"_id": { "$oid" : "', mongoID, '" } }'),
update = '{ "$addToSet" : { "value_array" : "checkedByR" } }'
)
## To add a document to the value_array
mongo$update(
query = paste0('{"_id": { "$oid" : "', mongoID, '" } }'),
update = '{ "$addToSet" : { "value_array" : { "checkedByR" : 1} } }'
)
## To add to a nested array
mongo$update(
query = paste0('{"_id": { "$oid" : "', mongoID, '" } }'),
update = '{ "$addToSet" : { "value_doc.value" : "checkedByR" } }'
)
rm(mongo); gc()
see mongodb update documemtation for further details

How to patch an S4 method in an R package?

If you find a bug in a package, it's usually possible to patch the problem with fixInNamespace, e.g. fixInNamespace("mean.default", "base").
For S4 methods, I'm not sure how to do it though. The method I'm looking at is in the gWidgetstcltk package. You can see the source code with
getMethod(".svalue", c("gTabletcltk", "guiWidgetsToolkittcltk"))
I can't find the methods with fixInNamespace.
fixInNamespace(".svalue", "gWidgetstcltk")
Error in get(subx, envir = ns, inherits = FALSE) :
object '.svalue' not found
I thought setMethod might do the trick, but
setMethod(".svalue", c("gTabletcltk", "guiWidgetsToolkittcltk"),
definition = function (obj, toolkit, index = NULL, drop = NULL, ...)
{
widget = getWidget(obj)
sel <- unlist(strsplit(tclvalue(tcl(widget, "selection")),
" "))
if (length(sel) == 0) {
return(NA)
}
theChildren <- .allChildren(widget)
indices <- sapply(sel, function(i) match(i, theChildren))
inds <- which(visible(obj))[indices]
if (!is.null(index) && index == TRUE) {
return(inds)
}
if (missing(drop) || is.null(drop))
drop = TRUE
chosencol <- tag(obj, "chosencol")
if (drop)
return(obj[inds, chosencol, drop = drop])
else return(obj[inds, ])
},
where = "package:gWidgetstcltk"
)
Error in setMethod(".svalue", c("gTabletcltk", "guiWidgetsToolkittcltk"), :
the environment "gWidgetstcltk" is locked; cannot assign methods for function ".svalue"
Any ideas?
How about the old-school way of getting the source, applying the change and rebuilding?
you can first get the generic out, and then fix the generic by setMethod in your global environment, and then assign it back to that namespace
.svalue <- gWidgetstcltk:::.svalue
setMethod(".svalue", c("gTabletcltk", "guiWidgetsToolkittcltk"),
definition = function (obj, toolkit, index = NULL, drop = NULL, ...)
{
widget = getWidget(obj)
sel <- unlist(strsplit(tclvalue(tcl(widget, "selection")),
" "))
if (length(sel) == 0) {
return(NA)
}
theChildren <- .allChildren(widget)
indices <- sapply(sel, function(i) match(i, theChildren))
inds <- which(visible(obj))[indices]
if (!is.null(index) && index == TRUE) {
return(inds)
}
if (missing(drop) || is.null(drop))
drop = TRUE
chosencol <- tag(obj, "chosencol")
if (drop)
return(obj[inds, chosencol, drop = drop])
else return(obj[inds, ])
}#,
#where = "package:gWidgetstcltk"
)
assignInNamespace(".svalue", .svalue, ns = "gWidgetstcltk")

Resources