MCA from dataframe - r

I have dataframe
name a b c d e f
1 220-volt 1 8 12 17 22 8
2 aliexpress 7 133 317 372 358 349
3 bonprix 0 3 14 13 21 11
4 citilink 1 20 40 31 29 30
5 dns 1 16 37 34 39 38
6 ebay 3 32 65 50 55 58
7 eldorado 0 19 76 44 42 56
8 kupivip 0 8 17 24 11 18
9 labirint 0 15 30 34 36 32
10 lamoda 3 25 66 73 68 55
and I try to build mca plot.
I use FactoMineR and use code
library(FactoMineR)
df <- read.table("info.csv", header = TRUE, sep=';')
row.names(df) = df$name
df = df[,-1]
res.mca <- MCA(df)
but it returns
Error in which(unlist(lapply(listModa, is.numeric))) : argument to 'which' is not logical
How can I avoid this error?

I downloaded the code an reproduced your data.frame ( please use dput, or an other reproducible example ) and got the same error.
When you ?MCA you will find that x has to be:
a data frame with n rows (individuals) and p columns (categorical variables)
After I changed the columns to factors the function runs.
Try this:
df[] <- lapply(df, factor)
Tip: use row.names = 1 to set the first column as row names for your data.frame when you read the data.
df <- read.table("info.csv", header = T, sep = ";", row.names = 1)

Related

Vectorizing lagged operations

How can I vectorize the following operation in R that involves modifying column Z recursively using lagged values of Z?
library(dplyr)
set.seed(5)
initial_Z=1000
df <- data.frame(X=round(100*runif(10),0), Y=round(100*runif(10),0))
df
X Y
1 20 27
2 69 49
3 92 32
4 28 56
5 10 26
6 70 20
7 53 39
8 81 89
9 96 55
10 11 84
df <- df %>% mutate(Z=if_else(row_number()==1, initial_Z-Y, NA_real_))
df
X Y Z
1 20 27 973
2 69 49 NA
3 92 32 NA
4 28 56 NA
5 10 26 NA
6 70 20 NA
7 53 39 NA
8 81 89 NA
9 96 55 NA
10 11 84 NA
for (i in 2:nrow(df)) {
df$Z[i] <- (df$Z[i-1]*df$X[i-1]/df$X[i])-df$Y[i]
}
df
X Y Z
1 20 27 973.000000
2 69 49 233.028986
3 92 32 142.771739
4 28 56 413.107143
5 10 26 1130.700000
6 70 20 141.528571
7 53 39 147.924528
8 81 89 7.790123
9 96 55 -48.427083
10 11 84 -506.636364
So the first value of Z is set first, based on initial_Z and first value of Y. Rest of the values of Z are calculated by using lagged values of X and Z, and current value of Y.
My actual df is large, and I need to repeat this operation thousands of times in a simulation. Using a for loop takes too much time. I prefer implementing this using dplyr, but other approaches are also welcome.
Many thanks in advance for any help.
I don't know that you can avoid the effect of for loops, but in general R should be pretty good at them. Given that, here is a Reduce variant that might suffice for you:
set.seed(5)
initial_Z=1000
df <- data.frame(X=round(100*runif(10),0), Y=round(100*runif(10),0))
df$Z <- with(df, Reduce(function(prevZ, i) {
if (i == 1) return(prevZ - Y[i])
prevZ*X[i-1]/X[i] - Y[i]
}, seq_len(nrow(df)), init = initial_Z, accumulate = TRUE))[-1]
df
# X Y Z
# 1 20 27 973.000000
# 2 69 49 233.028986
# 3 92 32 142.771739
# 4 28 56 413.107143
# 5 10 26 1130.700000
# 6 70 20 141.528571
# 7 53 39 147.924528
# 8 81 89 7.790123
# 9 96 55 -48.427083
# 10 11 84 -506.636364
To be clear, Reduce uses for loops internally to get through the data. I generally don't like using indices as the values for Reduce's x, but since Reduce only iterates over one value, and we need both X and Y, the indices (rows) are a required step.
The same can be accomplished using accumulate2. Note that these are just for-loops. You should consider writing the for loop in Rcpp if at all its causing a problem in R
df %>%
mutate(Z = accumulate2(Y, c(1, head(X, -1)/X[-1]), ~ ..1 * ..3 -..2, .init = 1000)[-1])
X Y Z
1 20 27 973
2 69 49 233.029
3 92 32 142.7717
4 28 56 413.1071
5 10 26 1130.7
6 70 20 141.5286
7 53 39 147.9245
8 81 89 7.790123
9 96 55 -48.42708
10 11 84 -506.6364
You could unlist(Z):
df %>%
mutate(Z = unlist(accumulate2(Y, c(1, head(X, -1)/X[-1]), ~ ..1 * ..3 -..2, .init = 1000))[-1])

Custom function to mutate a new column for row means using starts_with()

I have a data frame for which I want to create columns for row means. Each row mean column should be computed for a group of columns in the data. which are related to each other. I can differentiate between the groups of columns using dplyr's starts_with(). Since I have several groups of columns to calculate row means for, I'd like to build a function to do it. For some reason, I fail to get it to work.
Data
df <- data.frame("europe_paris" = 1:10,
"europe_london" = 11:20,
"europe_rome" = 21:30,
"asia_bangkok" = 31:40,
"asia_tokyo" = 41:50,
"asia_kathmandu" = 51:60)
set.seed(123)
df <- as.data.frame(lapply(df, function(cc) cc[ sample(c(TRUE, NA),
prob = c(0.70, 0.30),
size = length(cc),
replace = TRUE) ]))
df
europe_paris europe_london europe_rome asia_bangkok asia_tokyo asia_kathmandu
1 1 NA NA NA 41 51
2 NA 12 22 NA 42 52
3 3 13 23 33 43 NA
4 NA 14 NA NA 44 54
5 NA 15 25 35 45 55
6 6 NA NA 36 46 56
7 7 17 27 NA 47 57
8 NA 18 28 38 48 NA
9 9 19 29 39 49 NA
10 10 NA 30 40 NA 60
I want to create a new column for the row means of each continent, across cities. One column for Asia cities, and one for Europe. Each run of the function will be fed by the name of a continent, to guide which columns to pick.
My attempt to build the function
This attempt is based on this answer.
continent_mean <-
function(continent) {
df %>%
select(starts_with(as.character(continent))) %>%
mutate(., (!!as.name(continent)) == rowMeans(., na.rm = TRUE))
}
However, running this code results in a weird behavior, as it seemingly returns the same dataset, with just the selected columns according to starts_with(), but it doesn't generate a new column for row means.
continent_mean("asia")
asia_bangkok asia_tokyo asia_kathmandu
1 31 41 51
2 32 42 52
3 33 43 53
4 34 44 54
5 35 45 55
6 36 46 56
7 37 47 57
8 38 48 58
9 39 49 59
10 40 50 60
What am I missing here? I thought this could be due to the == rather than = in mutate(), but a single = throws an error, so it seems not to be the solution either.
Thanks!
We can use quo_name to assign column names
library(dplyr)
library(rlang)
continent_mean <- function(df, continent) {
df %>%
select(starts_with(continent)) %>%
mutate(!!quo_name(continent) := rowMeans(., na.rm = TRUE))
}
continent_mean(df, "asia")
# asia_bangkok asia_tokyo asia_kathmandu asia
#1 NA 41 51 46
#2 NA 42 52 47
#3 33 43 NA 38
#4 NA 44 54 49
#5 35 45 55 45
#6 36 46 56 46
#7 NA 47 57 52
#8 38 48 NA 43
#9 39 49 NA 44
#10 40 NA 60 50
Using base R, we can do similar thing by
continent_mean <- function(df, continent) {
df1 <- df[startsWith(names(df), "asia")]
df1[continent] <- rowMeans(df1, na.rm = TRUE)
df1
}
If we want rowMeans of all the continents together we can use split.default
sapply(split.default(df, sub("_.*", "", names(df))), rowMeans, na.rm = TRUE)
# asia europe
# [1,] 46 1
# [2,] 47 17
# [3,] 38 13
# [4,] 49 14
# [5,] 45 20
# [6,] 46 6
# [7,] 52 17
# [8,] 43 23
# [9,] 44 19
#[10,] 50 20

Resampling with a loop in R

Consider the following data:
library(Benchmarking)
d <- data.frame(x1=c(100,200,30,500), x2=c(300,200,10,50), y=c(75,100,3000,400))
So I have 4 observations.
Now I want to select 2 observations randomly out of d two times (without repetition). For each of these two times I want to calculate the following:
e <- dea(d[c('x1', 'x2')], d$y)
weighted.mean(eff(e), d$y)
That is, I will get two numbers, which I want to calculate an average of. Can someone show how to do this with a loop function in R?
Example:
Consider that observation 1 and 3 was selected the first time, and 2 and 3 was selected the second time (of course, this could be different). This will give me the following results:
0.9829268 0.9725806
Since (here I have written the observations manually):
> d1 <- data.frame(x1=c(100,30), x2=c(300,10), y=c(75,3000))
> e1 <- dea(d1[c('x1', 'x2')], d1$y)
> weighted.mean(eff(e1), d1$y)
[1] 0.9829268
>
> d2 <- data.frame(x1=c(200,30), x2=c(200,10), y=c(100,3000))
> e2 <- dea(d2[c('x1', 'x2')], d2$y)
> weighted.mean(eff(e2), d2$y)
[1] 0.9725806
And the mean of these two numbers is:
0.9777537
My suggestion:
I have tried with:
for (r in 1:2)
{
a <- (1:4)
s <- sample(a, 2, replace = FALSE)
es <- dea([s, c('x1', 'x2')], y[s])
esav[i] <- weighted.mean(eff(es), y[s])
}
mean(esav)
But this does not work. Can someone help me?
Here's a possible approach (if I understood you correctly) :
library(Benchmarking)
set.seed(123) # just to reproduce this case
d <- data.frame(x1=c(100,200,30,500), x2=c(300,200,10,50), y=c(75,100,3000,400))
# generate all possible couples of row indexes
allPossibleRowIndexes <- combn(1:nrow(d),2,simplify=FALSE)
# select the first maxcomb couples randomly (without repetition)
maxcomb <- 3 # I chose 3... you can also test all the possibilities
rowIndexesRand <- sample(allPossibleRowIndexes,min(maxcomb,length(allPossibleRowIndexes)))
esav <- NULL
for (rowIdxs in rowIndexesRand){
es <- dea(d[rowIdxs, c('x1', 'x2')], d$y[rowIdxs])
esav <- c(esav,weighted.mean(eff(es), d$y[rowIdxs]))
}
avg <- mean(esav)
# or alternatively using sapply instead of loop
avg <- mean(sapply(rowIndexesRand,function(rowIdxs){
es <- dea(d[rowIdxs, c('x1', 'x2')], d$y[rowIdxs])
esav <- weighted.mean(eff(es), d$y[rowIdxs])
return(esav)
}))
Results :
> esav
[1] 0.9829268 0.9725806 0.9058824
> avg
[1] 0.9537966
> rowIndexesRand
[[1]]
[1] 1 3
[[2]]
[1] 2 3
[[3]]
[1] 3 4
EDIT :
As per comment, you can generate unique random indexes without generating all combinations using the following function.
Of course this is not very efficient since it samples multiple times in case the combination has been already extracted before...
# function that (not very efficiently) returns n unique random samples
# of size=k, taken from the set : 1...size
getRandomSamples <- function(size,k,n){
# ensure n is <= than the number of combinations
n <- min(n,choose(size,k))
env <- new.env()
for(i in seq_len(n)){
# sample until it's not a duplicate
while(TRUE){
set <- sort(sample.int(size,k))
key <- paste(set,collapse=',')
if(is.null(env[[key]])){
env[[key]] <- set
break
}
}
}
unname(as.list(env))
}
# usage example
set.seed(1234) # for reproducibility
getRandomSamples(60,36,5)
[[1]]
[1] 1 2 4 7 8 10 11 12 13 14 15 16 17 18 20 21 22 23 24 26 30 31 32 33 34 35 36 37 42 43 44 46 47 55 58 59
[[2]]
[1] 3 4 5 8 10 11 12 13 14 16 17 18 19 20 22 23 24 25 26 29 32 33 35 38 40 43 44 45 47 48 49 50 51 55 56 58
[[3]]
[1] 1 2 4 5 6 7 8 9 10 11 14 18 19 22 25 27 28 30 36 37 38 39 40 43 46 47 49 50 51 53 54 55 57 58 59 60
[[4]]
[1] 1 2 5 7 8 9 10 12 13 14 18 19 27 29 30 31 35 36 37 38 42 43 44 46 47 48 49 51 52 53 55 56 57 58 59 60
[[5]]
[1] 3 5 6 7 9 11 12 13 15 16 19 20 21 22 24 26 27 30 31 32 35 36 37 39 40 42 43 44 45 46 49 50 51 54 55 60

R - Issues while calling a user-defined function

I have the following dataframe named "dataset"
> dataset
V1 V2 V3 V4 V5 V6 V7
1 A 29 27 0 14 21 163
2 W 70 40 93 63 44 1837
3 E 11 1 11 49 17 315
4 S 20 59 36 23 14 621
5 C 12 7 48 24 25 706
6 B 14 8 78 27 17 375
7 G 12 7 8 4 4 257
8 T 0 0 0 0 0 0
9 N 32 6 9 14 17 264
10 R 28 46 49 55 38 608
11 O 12 2 8 12 11 450
I have two helper functions as below
get_A <- function(p){
return(data.frame(Scorecard = p,
Results = dataset[nrow(dataset),(p+1)]))
} #Pulls the value from the last row for a given value of (p and offset by 1)
get_P <- function(p){
return(data.frame(Scorecard= p,
Results = dataset[p,ncol(dataset)]))
} #Pulls the value from the last column for a given value of p
I have the following dataframe on which I need to run the above helper functions. There will be NAs because I'm reading this "data_sub" dataframe from an excel file which can have unequal rows for the two columns.
> data_sub
Key_P Key_A
1 2 1
2 3 3
3 4 5
4 NA NA
When I call the helper functions, I get some strange results as shown below:
> get_P(data_sub[complete.cases(data_sub$Key_P),]$Key_P)
Scorecard Results
1 2 1837
2 3 315
3 4 621
> get_A(data_sub[complete.cases(data_sub$Key_A),]$Key_A)
Scorecard Results.V2 Results.V4 Results.V6
1 1 12 8 11
2 3 12 8 11
3 5 12 8 11
Warning message:
In data.frame(Scorecard = p, Results = dataset[nrow(dataset), (p + :
row names were found from a short variable and have been discarded
The call to the get_P() helper function is working the way I want. I'm getting the "Results" for each non-NA value in data_sub$Key_P as a dataframe.
But the call to the get_A() helper function is giving strange results and also a warning.I was expecting it to give a similar dataframe as given the call to get_P(). Why is this happening and how can I make get_A() to give the correct dataframe? Basically, the output of this should be
Scorecard Results
1 1 12
2 3 8
3 5 11
I found this link related to the warning but it's unhelpful in solving my issue.
The following works
get_P <- function(df, data_sub) {
data_sub <- data_sub[complete.cases(data_sub), ]
data.frame(
Scorecard = data_sub$Key_P,
Results = df[data_sub$Key_P, ncol(df)])
}
get_P(df, data_sub)
# Scorecard Results
#1 2 1837
#2 3 315
#3 4 621
get_A <- function(df, data_sub) {
data_sub <- data_sub[complete.cases(data_sub), ];
data.frame(
Scorecard = data_sub$Key_A,
Results = as.numeric(df[nrow(df), data_sub$Key_A + 1]))
}
get_A(df, data_sub)
# Scorecard Results
#1 1 12
#2 3 8
#3 5 11
To avoid the warning, we need to strip rownames with as.numeric in get_A.
Another tip: It's better coding practice to make get_P and get_A a function of both df and data_sub to avoid global variables.
Sample data
df <- read.table(text =
" V1 V2 V3 V4 V5 V6 V7
1 A 29 27 0 14 21 163
2 W 70 40 93 63 44 1837
3 E 11 1 11 49 17 315
4 S 20 59 36 23 14 621
5 C 12 7 48 24 25 706
6 B 14 8 78 27 17 375
7 G 12 7 8 4 4 257
8 T 0 0 0 0 0 0
9 N 32 6 9 14 17 264
10 R 28 46 49 55 38 608
11 O 12 2 8 12 11 450", header = T, row.names = 1)
data_sub <- read.table(text =
" Key_P Key_A
1 2 1
2 3 3
3 4 5
4 NA NA", header = T, row.names = 1)

Subset data frame where values are greater than another data frame

Say I have a data frame with 3 columns of data (a,b,c) and 1 column of categories with multiple instances of each category (class).
set.seed(273)
a <- floor(runif(20,0,100))
b <- floor(runif(20,0,100))
c <- floor(runif(20,0,100))
class <- floor(runif(20,0,6))
df1 <- data.frame(a,b,c,class)
print(df1)
a b c class
1 31 73 28 3
2 44 33 57 3
3 19 35 53 0
4 68 70 39 4
5 92 7 57 2
6 13 67 23 3
7 73 50 14 2
8 59 14 91 5
9 37 3 72 5
10 27 3 13 4
11 63 28 0 5
12 51 7 35 4
13 11 36 76 3
14 72 25 8 5
15 23 24 6 3
16 15 1 16 5
17 55 24 5 5
18 2 54 39 1
19 54 95 20 3
20 60 39 65 1
And I have another data frame with the same 3 columns of data and category column, however this only has one instance per category (class).
a <- floor(runif(6,0,20))
b <- floor(runif(6,0,20))
c <- floor(runif(6,0,20))
class <- seq(0,5)
df2 <- data.frame(a,b,c,class)
print(df2)
a b c class
1 8 15 13 0
2 0 3 6 1
3 14 4 0 2
4 7 10 6 3
5 18 18 16 4
6 17 17 11 5
How to I subset the first data frame so that only rows where a, b, and c are all greater than the value in the second data frame for each class? For example, I only want rows where class == 0 if a > 8 & b > 15 & c > 13.
Note that I don't want to join the data frames, as the second data frame is the lowest acceptable value for the the first data frame.
As commented by Frank this can be done with non-equi joins.
# coerce to data.table
tmp <- setDT(df1)[
# non-equi join to find which rows of df1 fulfill conditions in df2
setDT(df2), on = .(class, a > a, b > b, c > c), rn, nomatch = 0L, which = TRUE]
# return subset in original order of df1
df1[sort(tmp)]
a b c class
1: 31 73 28 3
2: 44 33 57 3
3: 19 35 53 0
4: 68 70 39 4
5: 92 7 57 2
6: 13 67 23 3
7: 73 50 14 2
8: 11 36 76 3
9: 2 54 39 1
10: 54 95 20 3
11: 60 39 65 1
The parameter which = TRUE returns a vector of the matching row numbers instead of the joined data set. This saves us from creating a row id column before the join. (Credit to #Frank for reminding me of the which parameter!)
Note that there is no row in df1 which fulfills the condition for class == 5 in df2. Therefore, the parameter nomatch = 0L is used to exclude non-matching rows from the result.
This can be put together in a "one-liner":
setDT(df1)[sort(df1[setDT(df2), on = .(class, a > a, b > b, c > c), nomatch = 0L, which = TRUE])]

Resources