Function returns a function within lapply  nested lapply?
I thought I was being elegant with the code until I ran into an issue with lapply function. I used dput to output sample. Note that I am using data.table not data.frame.
full_data < structure(list(FireplaceQu = c("Gd", "Gd", "TA", "TA", "Gd",
"None", "Gd", "Gd", "None", "None", "None", "None", "Gd", "Gd",
"Gd", "None"), BsmtQual = c("TA", "Gd", "Gd", "TA", "Gd", "TA",
"Ex", "TA", "TA", "TA", "TA", "Ex", "TA", "Ex", "Ex", "Gd"),
CentralAir = c("Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "N",
"N", "Y", "Y", "Y", "Y", "Y", "Y")), .Names = c("FireplaceQu",
"BsmtQual", "CentralAir"), class = "data.frame", row.names = c(NA,
16L))
library(data.table)
setDT(full_data)
cols = c('FireplaceQu', 'BsmtQual', 'CentralAir')
FireplaceQu=c('None','Po','Fa','TA','Gd','Ex')
BsmtQual=c('None','Po','Fa','TA','Gd','Ex')
CentralAir=NA
cust_levels < list(FireplaceQu, BsmtQual, CentralAir)
# I modified a function from SO to sort based on set levels instead of by using default sort function.
# https://stackoverflow.com/questions/38620424/labelencoderfunctionalityinr
# function which returns function which will encode vectors with values of 'vec'
lev_index = 1
label_encoder = function(vec){
levels = cust_levels[[lev_index]]
lev_index = lev_index + 1
function(x){
match(x, levels)
}
}
full_data[, (cols) := lapply(.SD, lapply(.SD, label_encoder)), .SDcols = cols]
I know I can get this to work in a for loop, but I thought I would try to use the lapply function. I'm confused on how to use this with a function that returns a function as the value and than needs to be evaluated.
I ultimately want to create integer values ordered based on the order of the cust_levels. Bonus if I can get rid of the lev_index!
Example input:
FireplaceQu BsmtQual CentralAir
None Gd Y
TA Gd Y
TA Gd Y
Gd TA Y
Example output:
FireplaceQu BsmtQual CentralAir
1 5 NA
4 5 NA
4 5 NA
5 4 NA
1 answer

You can do this with
mapply
:full_data[, (cols) := mapply(match, .SD, cust_levels, SIMPLIFY = FALSE), .SDcols = cols] # > full_data # FireplaceQu BsmtQual CentralAir # 1: 5 4 NA # 2: 5 5 NA # 3: 4 5 NA # 4: 4 4 NA # 5: 5 5 NA # 6: 1 4 NA # 7: 5 6 NA # 8: 5 4 NA # 9: 1 4 NA # 10: 1 4 NA # 11: 1 4 NA # 12: 1 6 NA # 13: 5 4 NA # 14: 5 6 NA # 15: 5 6 NA # 16: 1 5 NA
See also questions close to this topic

How to write for loop in R
Hello i need to calculate the following loop in R:
for (i in seq(0.004, 0.009, by=0.001)) { M[i] < mvdc(copula=tCopula(i,dim=2,df=df), margins=c("norm","norm"),paramMargins=list(list(mean=apple_mu, sd=apple_sd),list(mean=microsoft_mu, sd=microsoft_sd))) simulation [i]< rMvdc(3009,M[i]) error[i]<apple.returnssimulation[i]
}
I have the following error :
Error in M[i] < mvdc(copula = tCopula(i, dim = 2, df = df), margins = c("norm", : incompatible types (from S4 to logical) in subassignment type fix
Any ideas what i am doing wrong?
Thank you

unexpected symbol in copying a cURL  R
I am copying a cURL from the google chrome console, I paste it in my R script between "" and when I am trying to save it to an object, R says there is an unexpected symbol in it.
Can someone explain why this is and how to solve it?
httpbinrhcurl < "curl 'http://www.domainia.nl/quarantaine/2018/12/15' H 'Connection: keepalive' H 'CacheControl: maxage=0' H 'UpgradeInsecureRequests: 1' H 'UserAgent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10_14_1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.110 Safari/537.36' H 'Origin: http://www.domainia.nl' H 'ContentType: application/xwwwformurlencoded' H 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8' H 'Referer: http://www.domainia.nl/quarantaine/2018/12/15' H 'AcceptEncoding: gzip, deflate' H 'AcceptLanguage: enUS,en;q=0.9,nl;q=0.8' H 'Cookie: ASP.NET_SessionId=1rq1dcm2rxrxhejcv2apj1nz; _ga=GA1.2.1720697664.1544465383; cookieconsent_dismissed=yes; _gid=GA1.2.1174161929.1544888026; _gat=1' data '__EVENTTARGET=ctl00%24ContentPlaceHolder1%24gvDomain&__EVENTARGUMENT=Page%246&__VIEWSTATE=%2BfCpnCxB3CBeL3p0AJRxX709sVZd46FhL5m2WythvucpdaUpCnCyUxSa%2BEidpSc9wEzRF6wNxg8LpEQV8%2BzUZpzAPL8nX4hXXd282D77F%2BphaIBhktpf4j8Wj31S3LIC5QRM2V6lHEWuJEbAJbuk68wwOBwa2zOVseYwNs%2FQywJT2H5wWBPzxALrQo5Dui76GArI3RRCSyKUgrq97euwYy4zq5b1Y3NgFWi8nOyu4VWuih%2BRANxczyqirApMmInEpCVFHqbNYulM8iKpi5Ay1jU3k2fC8I87LhC8oFWOPglZXhMuMSxR66FM%2BMOk9T%2BUbSrESAFA9AIywFhk7gRy%2FGMTgmDA%2BdyCbmnnIzJbGy6sr02V0I08l8UxzxfiaRCTx1paJqN3Co7tgq4D%2FqPmkvzlU8w1sMEqpdDWrXnX2cDswYbcEmg01w3PfgD66f4yezNJb4PQdjURDLwYsb6BkPum9iwXzRMi9OHQoULpN%2BUGFZh2BqgJMcI6R9OLbTZXs%2B%2FiiIVwyO8zeYjw8gMIjLZeu2TTdduhgiVBLUbBRZOQ%2BZwAIL6rZNoKF7Vop0BeSXTuA%2F6bCf1Z5g9Yss4WC%2Bre81YbVKImtrnUoqBsRQLvt6EtDUYxxJ1NDfdWYC8HivFw1FHvzwf0EiH2wtKFQ0w7eBNa5Hhahs05UOaqo%2FLSNxZJCsbcJfSwAQlo2nIRAVLSEEibbqYfgFtsgxtvv7oRl0a6eci2OU2skCfXHsLCTBJhzGD3RfUALn9o9bwTx%2FYbYYrGtbCuty%2FFmFVVFQvNN9UGJntsNaxxB0SIjIwamTKL7H%2Bi1npGQbV%2B%2F%2BnPJbzHX8UPWgeT0qB1xBIOc59H7TCE%2BEcFyTDdCprQd7XYmeZ1yKySaDDCtrUc3sP38YUzgzP4R8ktyJg52ZVS7tN4o3lfLEmPb2gV29xxZlLs%2Ft7XuA7xeJei9AXlhZn8rZEsu0qvZwnmk2%2F7ArQYXv%2B2kk58H6223NwCwtoS53emfJuuOgn6x1AsWcIc4xavzYu4bhE5GBIe378PQMvav0GcXghx0YAmYnsQw5x%2BYkcU66e81XKGgDS0nXOOWabpnJwdG1%2B43wziuDsx9Yx%2Fy0FznCAWjdPbMf1uzFPk8yxErqzShuz2W3mX%2FeXmkcnP%2Fr41GUiYW4gfCfYYNSPDORY0gITK%2FZR9yq9eex2dJLanL0g9m7g2aaGrhCG%2FwDM72YP1HVkoOguF%2BFcNUoye%2BeVhi5cKavn9mt%2FjSrvctYV6exY0VqNhqJZBR9H0VaqZDO8X7EvMAeCBs822VOUgDHsKLWmINEDhx%2ByK0NpbHMv60U6ZDIUFMU7VQP%2BtK1d5XXzgPu6McG2pU3GuV%2FVbCowFjOX06cSSJy5PCfzvvW6t5nIDtz37p3pMKMZ3Bkbitmo9O88RAHtk5m1XvFG3U3XBb1wFDKEoB6g5P%2BfeLrVt26DP3XprYW4uvsPlWg3%2FlgiJAieljwQteNB6YP3dFIe6Jtpn0KCvOZvkD1TiHVxht9GBvKRPsQncAUAdk%2Bh0Es2U63UOl9BSiNvJHRXIeJtdwLCiB%2F09ymmGig%2BVzXkOs%2FJJA4toKUljFDNZA2c0eJO675v5flLrb9F53Hch%2B%2FJ8gEGWLCPJRj5UzKHnPV2Ln80lFQFmiI%2BKgvnGlDNXs2KzcbzL468kSziFOATaxHg2NRlTxcRi7eHW3WbWp3s7l804cLMutZP0S7jualsRRNCdwL0hnvAP3eYBBUiNGg%3D%3D&__VIEWSTATEGENERATOR=39107D5A&__VIEWSTATEENCRYPTED=&__EVENTVALIDATION=FVV2FXaDZFD8X3%2Faf1efOYoZkPsG5aGc%2FETy%2BPpSaJViSFwo08G2Z%2FD3oNgkB4gPg3vavcSK2z1GyI%2BWo9Nu12mjPGuSzGefVyonOnrV1Tx9nsqyOEhGinftQPWBa29BXIAnAhb3XxtTj7SEAeR0KYR%2FsPYpD3tPoUjMrLhmHmj4RM%2BOZGYZDj4B2LdpVg%2B1RIYBhs3rdEVxzuhlhAPlgiKvhO8v46wlweLVy47Y4ZOrzks2z2fm%2BHXNDVD8RXTPKl%2FnTUobsv9iZ9imVAs8DS7I8WkrPtH3TJS7jeFS1NGd3eJIXwCZmpsplMe5tY3wHjYLBPijk0dsH7%2B8DvuQ3byNcAz4H%2B92IH%2Fw%2BInvxjc52xdSrOCqKUFWUOIAGYsrG%2FtTphEc0XYuqujHxZAXFcP%2FhPDMSDUzTzoQc2VsHqqI9UthFCX9z9TpVX8Th4puc3pIiRS9%2BQHDlp%2FDiq81AI39IThV6W824NnY9uudiuizQmer8CA7DTts%2BVE5qYDsa%2BJKgyMmBP3YHOhsfPssFLhZ7sFhC%2FQwmf9s6X0rizu1aI%2FzRacJGyjm2C4PMtuT0ylmUvMu%2Bx%2FEOUrMNzKO2UXX07jTxwRByiJ13ud7JEW2U6s1Y7Dnvf3%2F0klDACBXPrTUQy0bnLgGypiv2grtCEyXHePltZkUddwM0eEbS3Kcl3fbDEgq97RaomGxCDpA2VRlOLHZZkLYOasMXCNtC9yo1gaXJcNE1ONwyTVn1%2Fi8gIDAo%2BPqNYLRS4fdEQC%2BDvrGoCvcfr5PlIwxyHn6zHAJGJJWsxunbWjhYX9yFDd8nFEVcIJEHiYHCvQBG%2Bxo6gUSwfza0L6v4k1wTa2SJhLoGQS4Slbl6hVaiawb8M8iOgLwnIYyBgRGoIOFsBhcauh0UO8dIMTNi6LRXiFpIK8VXEa4kG8enfIoJWlj2Yp06FL8mxpQXpQJkZrajseuQ5gtxk6vh3ZanVn3XDg5BrBxB2zUZNDmcVlSWOrw%2Fza6g9mm52q%2Ff%2FtdxrS4xYrTcJcavDkt%2Bhh4Y7Brhf3x0oDtyzk6WeLj5l13ZNjEcnqmhRlluY2Y1VCr9fQzrJFH8NZBiKa4pNVv2lfTKXqje1AogYX9LqUC4JoVfkXT1ip9%2BATWAApQpW7Z%2FjxXcUzN53xZopDP3UtpWQ8uPhBwaz2FRlNpQV7cv1QyoawOZDqIck88J9yEUiDKYDHczSkgK5AAeTENbJZSsxtMUJxIA97XyRWunk5WqmixcAQW8GV5QFT8c3yS35TafJ0bNW5U5vN6BByZiGAJg96r8sJrwZ6RkkFXHgPDGlivdxc594qqEDQTAaBo%2Fj2AJjk%2Frs793XMP61%2B6ahQIF9iAqoA8Iq6RaJSgs%2FOP%2BVrsONlNv%2BXCtndmE97M602%2F%2BVJmrQle%2F8ySQLlrmBdafdJGBSZBNrDeqhS4%2Bs9dbTarV7AvUwVjZUgTIhJ1JTgGGu09kgVOe5FDd89KJ6D9xFNUzAMJiyK7H%2BbX3Mf5KdZgmVnyehE%3D&ctl00%24ddlState=quarantaine&ctl00%24tbSearch=' compressed"

Interpreting uplift curve for treatment
I obtained the attached uplift plot for my data (using uplift R package) Basically i am looking at finding certain % of population for which the treatment is effective and will not have any chronic disorders after treatment. But i do not know how to interpret this plot? Does it mean i can select 40% of population for effective treatment without much risk when compared to including entire population?

Function with arrays as a parameter
how can I write a rubyfunction, that can calculate the average of an array? It should return the result. If the array hasn't got any elements the result should be 0. I should use a loop for the implementation! I started like this, but I'm not quite sure how to use the loop...
a = [1, 2, 3, 4, 5, 6] def average(a) sum = 0.0 result = 0.0 if array.length > 0 then array.each do item sum += item end result = sum / array.length end return result.to_f end

jQuery Form won't hide and function return undefined
I'm having a problem with one the buttons. It doens't work properly.
When I click "Add Run" button and then "Home" button almost nothing work. The form that is dynamically created doesn't hide and search input doesn't show, and function return undefined.$("#home").on("click", function () { $("#search").show(); $("#addForm").hide(); $("#noPrevious").hide(); complete() console.log(complete()) });
But on the other hand, some things work, they hide or show. For example, after refresh, when I click "All my Runs" it displays text, which will hide after clicking on "Home" button, and on top of that, search input field shows up. I don't understand this. Does anybody know what's wrong?
Thanks in advance.
Here is CodePen and GitHub. The problem is at the top of .js file. https://codepen.io/ovy1448/pen/gZrKOX
https://github.com/ovy1448/MyRun/blob/master/js/main.js 
Union between three arrays
I need to find the union of three arrays that get passed to the function
union
.It took me about 50lines to code to get the expected result. Apparently, the following code works but now I wonder what are the best ways (either in a functional and in a nonfunctional fashion) to do the same job.
function union(...arrays) { var array1 = arguments[0]; var array2 = arguments[1]; var array3 = arguments[2]; var unique = []; var intersaction = []; // find the unique values for(let i = 0; i < array1.length; i++) { if( (array2.includes(array1[i]) == false) && (array3.includes(array1[i])) == false ) { unique.push(array1[i]); } } for(let i = 0; i < array2.length; i++) { if( (array1.includes(array2[i]) == false) && (array3.includes(array2[i])) == false ) { unique.push(array2[i]); } } for(let i = 0; i < array3.length; i++) { if( (array1.includes(array3[i]) == false) && (array2.includes(array3[i])) == false ) { unique.push(array3[i]); } } // find the intersection for(let j = 0; j < array1.length; j++) { if(array2.includes(array1[j])  array3.includes(array1[j]) ) { if (intersaction.indexOf(array1[j]) == 1) { intersaction.push(array1[j]); } } } for(let j = 0; j < array2.length; j++) { if(array1.includes(array2[j])  array3.includes(array2[j]) ) { if (intersaction.indexOf(array2[j]) == 1) { intersaction.push(array2[j]); } } } for(let j = 0; j < array3.length; j++) { if(array1.includes(array3[j])  array2.includes(array3[j]) ) { if (intersaction.indexOf(array3[j]) == 1) { intersaction.push(array3[j]); } } } return union = [...intersaction, ...unique]; } console.log(union([5, 10, 15], [15, 88, 1, 5, 7], [100, 15, 10, 1, 5])); // should log: [5, 10, 15, 88, 1, 7, 100]

r data.table: apply function with vector and matrix as parameters
I have a data.table with the following columns:
OOSResults < as.data.table(structure( list( c("1", "1", "1"), structure(c(17873, 17876, 17877), class = "Date"), c(48, 47, 55), c(22, 25, 20), c(31, 29, 25) ), .Names = c("score", "Date", "probH", "probD", "probA"), row.names = c(NA,3L), class = c("data.table", "data.frame"), sorted = "score" ))

Now I'd like to apply mLogLoss from ModelMetrics. It asks for
Usage
mlogLoss(actual, predicted)
Arguments
actual A vector of the labels. Can be numeric, character, or factor
predicted matrix of predicted values. Can be matrix, data.frame
How can I apply this function to my data.table, still being able to use flexible ways of further analysing my data.table, i.e. LogLoss by date, any other column, without losing my data.table.
I tried:
OOSResults[, mapply(ModelMetrics::mlogLoss, score, as.matrix(probA/100,probD/100,probH/100))]
Best regards, Christian

How to transform r data.table object based on function parameter
I would like to create r function which takes 2 parameters:
 data.table object
 instruction on how to add new columns to the data table. These new columns are a transformation of already existing columns.
Without the wrapping function i could do:
# load data.table library library(data.table) # the exsample data set dt < data.table(mtcars) # adding some new columns dt[, `:=`(disp_plus_hp = disp + hp, drat_plus_wt = drat + wt)]
I know i can use
eval + parse
combo to solve my problem like this:# load the exsample data set dt < data.table(mtcars) # character vector of length 1 specifying the transformation column_transformation = '`:=`(disp_plus_hp = disp + hp, drat_plus_wt = drat + wt)' # define a function that takes data table and the above character # to transform the data table dt_transformer < function(data_table, add_columns) { data_table[, eval(parse(text = add_columns))] } # equivalent to dt[, `:=`(disp_plus_hp = disp + hp,drat_plus_wt = drat + wt)] dt_transformer(data_table = dt, add_columns = column_transformation)
Now, there are two reasons i would like to improve the solution:
 I do not like to have all the transformations specified in one string, because it then becomes very difficult to read (a list or a character vector with one element for each transformation would be nice)
 I am not too excited about the use of parse function

Change data.table column classes to integer64, double respectively
Given data.table dt:
dt < structure(list(V1 = c("1544018118438041139", "1544018118466235879", "1544018118586849680", "1544018118601169211", "1544018118612947335", "1544018118614422179"), V2 = c("162", "162", "161.05167", "158.01309", "157", "157"), V3 = c("38", "38", "36.051697", "33.01306", "32", "32"), V4 = c("0.023529414", "0.025490198", "0.023529414", "0.027450982", "0.03137255", "0.03137255"), V5 = c("1", "1", "1", "1", "1", "1"), V6 = c("2131230815", "2131230815", "2131230815", "2131230815", "2131230815", "2131230815"), V7 = c("1", "0", "0", "0", "0", "1")), class = c("data.table", "data.frame"), row.names = c(NA, 6L), .internal.selfref = <pointer: 0x2715f60>)
I want the first column to be
bit64::as.integer64()
and the rest of the columnsas.numeric()
I am trying to do this:
dt < dt[ ,V1 := bit64::as.integer64(V1)] dt[, lapply(.SD, as.numeric), .SDcols = c("V1")]
But it doesn't seem to do what I want, please advise how to change specific columns to class A(
integer64
) and the rest to another class B (sayas.numeric()
)? 
How can I replace specific values of all elements in a list
I have a list
cluster_list
of 11 elements, each element of the same length.> class(cluster_list) [1] "list"
Each element looks like the example element 2:
head(cluster_list[[2]][,1:15]) X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 765 t t t c t t a a a a c a t a a 7319                8335 t t t c t t a a a a c a t a a 7162            t c t a 7382                7244               
I want to remove/change all
""
to""
for all 11 elements in the listI know how to do it in a matrix:
matrix_new < matrix_old[matrix_old==""] < ""
Or how to remove a column of a element in a list:
cluster_list < lapply(cluster_list, function(x) x[!(names(x) %in% c("X1"))])
But I´m unable to remove
""
from the list. (I´m new to usinglist
and thelapply
function) Any suggestions to make it look like:> head(cluster_list[[2]][,1:15]) X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 765 "t" "t" "t" "c" "t" "t" "a" "a" "a" "a" "c" "a" "t" "a" "a" 7319 "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" 8335 "t" "t" "t" "c" "t" "t" "a" "a" "a" "a" "c" "a" "t" "a" "a" 7162 "" "" "" "" "" "" "" "" "" "" "" "t" "c" "t" "a" 7382 "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" 7244 "" "" "" "" "" "" "" "" "" "" "" "" "" "" ""
thx K

Weighted Mean Error when Looping multiple listed data frames into a single function
I posted the question at the link below yesterday, to which, Emil Bode had a great answer! Looping multiple listed data frames into a single function
I however, forgot to transform one of the sample lists, thus throwing an error when I tried to run it on the transformed data.
####################################### library(parallel) library(ade4) # testing functions ... d1 < data.frame(y1 = c(1, 2, 3), y2 = c(4, 5, 6)) d2 < data.frame(y1 = c(3, 2, 1), y2 = c(6, 5, 4)) d3 < data.frame(y1 = c(2, 1, 2), y2 = c(5, 6, 4)) spec.list < list(d1, d2, d3) d1 < data.frame(y1 = c(20, 87, 39,7,8,1,1), y2 = c(46, 51, 8,20, 87, 39,0)) d2 < data.frame(y1 = c(30, 21, 12,1,0,0,2), y2 = c(61, 51, 33,30, 21, 12,21)) d3 < data.frame(y1 = c(2, 11, 14,10,2,3,5), y2 = c(52, 16, 1,2, 11, 14,66)) env.list < list(d1, d2, d3) d1 < data.frame(y1 = c(0.15, 0.1, 0.9,30, 21), y2 = c(0.46, 0.51, 0.82,30,1)) d2 < data.frame(y1 = c(0.13, 0.31, 0.9,2, 11), y2 = c(0.11, 0.51, 0.38,1,0.1)) d3 < data.frame(y1 = c(0.52, 0.11, 0.14,1,5), y2 = c(0.52, 0.36, 0.11,0.7,2)) spat.list < list(d1, d2, d3) spec.dudi < mclapply(spec.list, function(x){ dudi.pca(x, scale = F, scannf = F) }) # had to transform these data, like this. output_varpart < mclapply(1:3, function(x){ varipart(spec.dudi[[x]], env.list[[x]], spat.list[[x]], type = "parametric") }) # the [mc]lapply function results in failure ( Error in weighted.mean.default(newX[, i], ...) : 'x' and 'w' must have the same length). # I also checked and the lengths are all the same!! > length(spec.dudi) [1] 3 > length(env.list) [1] 3 > length(spat.list) [1] 3
This works on single data frames so I am not sure why this is happening! Is it something to do with it being a list? Either way, how can I fix this?

Using lapply within mutate in R for calculating with different lengths of calculation
I have a df on which I performed PCA and FA. Now I want to use my FAmodel to calculate my new factor values. So I have a df with measured values to calculate on, and a separate df with the name of a variable, the size of the loading to use in calculation and the number of the factor it belongs. Here some dummy data:
set.seed(4711) df < data.frame(matrix(sample(0:6, 120, replace = TRUE), ncol = 15, nrow = 8)) var < colnames(df) load_val < rnorm(length(var), mean = .5, sd = .2) fac_nr < c(2,2,1,3,5,4,1,1,3,2,4,2,5,2,2) fa_dat < data.frame(var, load_val, fac_nr) fa_dat[fac_nr == 1, "var"]`
So now I have to calculate 5 new variables, F1 till F5. In hard coding it would be something like:
#Creating and calculating F1 (on 3 variables) f1_var < as.character(fa_dat[fac_nr == 1, "var"]) #The variables to use f1_load < fa_dat[fac_nr == 1, "load_val"] #The loadings to use df$F1 < df[f1_var[1]] * f1_load[1] + df[f1_var[2]] * f1_load[2] + df[f1_var[3]] * f1_load[3] #Creating and calculating F2 (on 6 variables) f2_var < as.character(fa_dat[fac_nr == 2, "var"]) f2_load < fa_dat[fac_nr == 2, "load_val"] df$F2 < df[f2_var[1]] * f2_load[1] + df[f2_var[2]] * f2_load[2] + df[f2_var[3]] * f2_load[3] + df[f2_var[4]] * f2_load[4] + df[f2_var[5]] * f2_load[5] + df[f2_var[6]] * f2_load[6] #Creating and calculating F3 (on 2 variables) f3_var < as.character(fa_dat[fac_nr == 3, "var"]) f3_load < fa_dat[fac_nr == 3, "load_val"] df$F3 < df[f3_var[1]] * f3_load[1] + df[f3_var[2]] * f3_load[2] #Creating and calculating F4 (on 2 variables) f4_var < as.character(fa_dat[fac_nr == 4, "var"]) f4_load < fa_dat[fac_nr == 4, "load_val"] df$F4 < df[f4_var[1]] * f4_load[1] + df[f4_var[2]] * f4_load[2] #Creating and calculating F5 (on 2 variables) f5_var < as.character(fa_dat[fac_nr == 5, "var"]) f5_load < fa_dat[fac_nr == 5, "load_val"] df$F5 < df[f5_var[1]] * f5_load[1] + df[f5_var[2]] * f5_load[2]`
So this is the desired result (don't mind the colnames):
I know how to make new variables in a loop, but I don't know  and really could't find  how to calculate the value in this new variable, where the length of the calculations varies and where I obtain variablenames from another object and selecting them based on the Fnumber. I think the solution could be in using the
mutate
function combined withlapply
. I tried, but failed desperately.I hope someone can help me a bit? Thank you in advance :)

Build multiple regression model with Y as a Factor in R
I have a data set that rates customer satisfaction based on three options:
 Recommend
 Neutral
 Not satisfied
I understand those may not be the best options but that's what I have to work with.
Another caveat is that I must build the model in R so I'm trying to determine how to build a multiple regression model when y is a factor.
Once I understand that I want to use a stepwise approach to determine the variables I should use based on the code below:
install.packages("MASS") library("MASS") model < lm(y~x1+x2+x3+x4, data=DATASET) step < stepAIC(model, direction = "both") summary(step)
I don't have any issues when y is numeric, but I don't think I can just arbitrarily assign values to the customer satisfaction by making Recommend == 1, Neutral == 2, and Not Satisfied == 3.
I was thinking about creating three new variables called Recommend, Neutral and Not Satisfied and assigning 1s under columns where the feedback applies to a customer and a 0 when it doesn't.
For example: Recommend Neutral NotSatisfied 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1
If that is an acceptable approach I'm stuck trying to determine how to incorporate all three variables into my model since all of them represent the output I'm trying to predict.
Thank you for any help you are able to provide.

R shiny treemap  error ‘range’ not meaningful for factors
Greatly appreciate if anyone could assist on this error. I am new to R and R shiny. This error appears after adding the treemap into the shiny app code. May I know which of the variable is causing the error: ‘range’ not meaningful for factors.
Also, attached the screenshot of the tm data. Range is NA.
Any help or comment will be greatly appreciated.
library(shiny) # for shiny apps library(leaflet) # renderLeaflet function library(ggplot2) library(plotly) server = function(input, output) { Cookedfood_R < readRDS("~/hawkermaster.rds") linechart < readRDS("~/line.rds") linechart2 < readRDS("~/linechart2.rds") exploratory < readRDS("~/exploratory.rds") tm < readRDS("~/tm.rds") #getColor < function(Cookedfood_R) { # sapply(Cookedfood_R$TYPE, function(TYPE) { # if(TYPE == 1) {"blue"} # else {"orange"} }) #} icons < awesomeIcons( icon = 'ionclose', iconColor = 'black', library = 'ion' #markerColor = getColor(Cookedfood_R) ) output$map = renderLeaflet({ leaflet() %>% addTiles() %>% addMarkers(data = Cookedfood_R, lat = ~ LATITUDE, lng = ~ LONGITUDE, icon = icons, layerId =~HAWKER, popup = paste(Cookedfood_R$HAWKER, "<br>", "No. of cooked food stalls:", Cookedfood_R$Cook, "<br>", "No. of Market stalls:", Cookedfood_R$market,"<br>"))}) # generate data in reactive ggplot_data < reactive({ site < input$map_marker_click$id linechart[linechart$NEWNAME %in% site,] }) ggplot_data2 < reactive({ site < input$map_marker_click$id linechart2[linechart2$NEWNAME %in% site,] }) output$plot < renderPlotly({ ggplotly( ggplot(data = ggplot_data(), aes(x = YEAR, y = AVGSQM, color = TYPE))+ geom_line()+theme_bw()) #geom_point(aes(shape=TYPE, size=1)) }) output$plot2 < renderPlotly({ ggplotly( ggplot(data = ggplot_data2(), aes(x = YEAR, y = AVG, color = TYPE))+ geom_line()+theme_bw()) #geom_point(aes(shape=TYPE, size=1)) }) output$plot3 < renderPlotly({ plot_ly(exploratory, x = ~TYPE_OF_STALL, y = ~AVERAGE_BID_PRICE, type = "box", text = rownames(exploratory), hoverinfo = 'text', mode = 'markers', transforms = list( list( type = 'filter', target = 'HAWKER_CENTRE', operation = '>', value = unique(exploratory$HAWKER_CENTRE) ))) }) output$plot4 < renderPlotly({ plot_ly(Main, y = ~BID_PRICE_PER_SQM, x = ~AGE_OF_HAWKER, color = ~TYPE_OF_STALL, type= "scatter") }) output$plot5 < renderHighchart({ tm< treemap( tm ,index=c("TYPE_OF_STALL","TRADE") ,vSize="avg_sqm" ,vColor = "TYPE_OF_STALL" ,type="value" , title = "Treemap of Bid Price Per Sqm Across Trade") hctreemap(tm, allowDrillToNode = TRUE) %>% hc_title(text = "Treemap of Bid Price Per Sqm Across Trade") %>% hc_tooltip(pointFormat = "<b>{point.name}</b>:<br> Bid Price Per SQM: {point.value:,.0f}") %>% hc_exporting(enabled = TRUE) # enable export }) } ui < fluidPage( titlePanel("Visualising Hawkers in Singapore"), tabsetPanel( tabPanel("Map", column(8,leafletOutput("map", height="900px")),column(4,br(),br(), plotlyOutput("plot", height="400px")),column(4,br(),br(),plotlyOutput("plot2", height="400px"))), tabPanel("Exploratory", column(6,br(),br(), plotlyOutput("plot3", height="400px")), column(6,br(),br(), plotlyOutput("plot4", height="400px")), column(6,br(),br(), plotlyOutput("plot5", height="400px")))), br() ) shinyApp(ui = ui, server = server)

Rpy2 conversion of categorical data containing nulls to R factors
I have a pandas dataframe with a categorical column containing NaN values, e.g.:
g = pd.Series(["A", "B", "C", np.nan], dtype="category") g 0 A 1 B 2 C 3 NaN dtype: category Categories (3, object): [A, B, C]
In pandas NaN is not a category but you can have NaN values in your categorical data. I want to pass this dataframe through to R using %%R in a Jupyter notebook . The categorical column is successfully recognised by R as a factor, but the factor is malformed, presumably because of the Nan values:
%%R i g str(g) Factor w/ 3 levels "A","B","C": 1 2 3 0  attr(*, "names")= chr [1:4] "0" "1" "2" "3" print(g) Error in as.character.factor(x) : malformed factor
Is there any way to make sure that the factor is not malformed  e.g. to have an NA factor level created automatically?
R: 3.5.1, rpy2: 2.9.4, Python  3