I'm creating a struct which will show a list of floors in a hotel (e.g. floor 1, floor 2) and the number of rooms which are empty on each floor. I have created a vector which allows the user to edit if a room is "empty" or "full". The only problem I have is I can't work out how to create code which shows the number of rooms free in each floor that I can enter into my struct. I'm guessing using a cond will work but I really don't know how to write it.
This is what I've done so far:
#lang racket
(define floor-one (make-vector 10))
(vector-set! floor-one 0 "empty")
(vector-set! floor-one 1 "full")
(vector-set! floor-one 2 "empty")
(vector-set! floor-one 3 "empty")
(vector-set! floor-one 4 "empty")
(vector-set! floor-one 5 "full")
(vector-set! floor-one 6 "full")
(vector-set! floor-one 7 "empty")
(vector-set! floor-one 8 "full")
(vector-set! floor-one 9 "full")
(define floor-two (make-vector 10))
(vector-set! floor-two 0 "empty")
(vector-set! floor-two 1 "full")
(vector-set! floor-two 2 "empty")
(vector-set! floor-two 3 "empty")
(vector-set! floor-two 4 "empty")
(vector-set! floor-two 5 "full")
(vector-set! floor-two 6 "full")
(vector-set! floor-two 7 "empty")
(vector-set! floor-two 8 "full")
(vector-set! floor-two 9 "full")
(struct hotel-rooms (floor rooms-empty))
(define empty-rooms1 (λ (any->vector x)
(cond
())))
There's a perfect function for the task: vector-count. Try this:
(define empty-rooms
(λ (vec)
(vector-count (λ (floor) (string=? floor "empty"))
vec)))
Or even simpler:
(define (empty-rooms vec)
(vector-count (curry string=? "empty") vec))
For example:
(empty-rooms floor-one)
=> 5
Related
Given the coordinates of any hexagon in the image below, I want to return the 6 sets coordinates of the adjacent hexagons. What is the best approach to this? I have figured out that the coordinates adjacent to (x,y) consist of all combinations of x-1,x,x+1,y-1,y,y+1 but I'm not sure the best way to approach this programmatically.
The coordinates adjacent to (x,y) are not all combinations of those expressions because there are 9 such combinations and only 6 adjacent hexes ((1, 1), (-1, -1) and (0, 0) are not adjacent to (0, 0)).
An R function to list the correct coords needn't be any more complicated than this:
adjacent_coords = function(x) {
list(c(x[1], x[2]+1),
c(x[1]+1, x[2]),
c(x[1]+1, x[2]-1),
c(x[1], x[2]-1),
c(x[1]-1, x[2]),
c(x[1]-1, x[2]+1))
}
adjacent_coords(c(1, -1))
[[1]]
[1] 1 0
[[2]]
[1] 2 -1
[[3]]
[1] 2 -2
[[4]]
[1] 1 -2
[[5]]
[1] 0 -1
[[6]]
[1] 0 0
something like this?
library(tibble)
neighbours <- function(x,y) {
center <- c(x,y)
n1 <- c(x, y + 1)
n2 <- c(x + 1, y)
n3 <- c(x + 1, y - 1)
n4 <- c(x, y - 1)
n5 <- c(x - 1, y)
n6 <- c(x - 1, y + 1)
return(tibble::lst(center, n1, n2, n3, n4, n5, n6))
}
neighbours(1,1)
$center
[1] 1 1
$n1
[1] 1 2
$n2
[1] 2 1
$n3
[1] 2 0
$n4
[1] 1 0
$n5
[1] 0 1
$n6
[1] 0 2
Given is the list below. This list contains character vectors of variable length.
l1 <- list("a" = c("x1", "x2", "x3"),
"b" = c("x4", "x5"),
"c" = c("x6", "x7", "x8", "x9"))
> l1
$a
[1] "x1" "x2" "x3"
$b
[1] "x4" "x5"
$c
[1] "x6" "x7" "x8" "x9"
The desired output, let's call it l2, is the following:
$a
[1] 1 1 1
$b
[1] 2 2
$c
[1] 3 3 3 3
This output has the following characteristics:
l2 is a named list in which the names of the original list l1 are preserved.
The length of list l2 is the same as list l1.
The order of list elements in l1 is preserved in l2.
l2 contains vectors with repeating integers. The length of each vector in l2 is the same as the corresponding character vector in l1.
Part of solution
I found this post in which the statement below helped me to construct a partial solution.
The usual work-around is to pass it the names or indices of the vector instead of the vector itself.
l2 <- lapply(X = seq_along(l1),
FUN = function(x) rep(x, times = length(l1[[x]])))
l2
[[1]]
[1] 1 1 1
[[2]]
[1] 2 2
[[3]]
[1] 3 3 3 3
All criteria are met, except that the names are not preserved in l2.
How can I fix this in one go (not using a seperate statement after the lapply statement)?
After you run your above code,, just add the code below:-
names(l2) <- names(l1)
This will assign the names of l1 to l2, and hence, you will have the same names.
Edit: You can't achieve this with lapply, but you can do it with sapply by doing the following the following:-
l2 <- sapply(X = names(l1),
FUN = function(x) rep(which(names(l1) == x), times = length(l1[[x]])))
l2
$a
[1] 1 1 1
$b
[1] 2 2
$c
[1] 3 3 3 3
Turns out, if X argument of sapply is character vector, it will return the list by using X as names of the returned list.
You can try the following base R option, using lengths + rep + relist like below
> relist(rep(seq_along(l1), lengths(l1)), l1)
$a
[1] 1 1 1
$b
[1] 2 2
$c
[1] 3 3 3 3
You can use [] to preserve the names the list.
l1[] <- lapply(seq_along(l1), function(x) rep(x, times = length(l1[[x]])))
l1
#$a
#[1] 1 1 1
#$b
#[1] 2 2
#$c
#[1] 3 3 3 3
Another solution with Map.
l1[] <- Map(rep, seq_along(l1), lengths(l1))
In case you want to have another objects l2 keeping l1 as it is, create a copy of l1 in l2 by doing l2 <- l1.
I wrote a function that perfectly replaces custom values of a matrix with NA.
NAfun <- function (x, z) {
x[x %in% z] <- NA
x
}
M <- matrix(1:12, 3, 4)
M[1, 2] <- -77
M[2, 1] <- -99
> M
[,1] [,2] [,3] [,4]
[1,] 1 -77 7 10
[2,] -99 5 8 11
[3,] 3 6 9 12
z <- c(-77, -99)
> NAfun(M, z)
[,1] [,2] [,3] [,4]
[1,] 1 NA 7 10
[2,] NA 5 8 11
[3,] 3 6 9 12
But this won't work with data frames.
D <- as.data.frame(matrix(LETTERS[1:12], 3, 4))
> D
V1 V2 V3 V4
1 A D G J
2 B E H K
3 C F I L
z <- c("B", "D")
> NAfun(D, z)
V1 V2 V3 V4
1 A D G J
2 B E H K
3 C F I L
D[] <- lapply(D, function(x) as.character(x)) # same with character vectors
> NAfun(D, z)
V1 V2 V3 V4
1 A D G J
2 B E H K
3 C F I L
If I convert the data frame to a matrix it works, though.
> NAfun(as.matrix(D), z)
V1 V2 V3 V4
[1,] "A" NA "G" "J"
[2,] NA "E" "H" "K"
[3,] "C" "F" "I" "L"
But I can't in my case.
I don't understand why this won't work as it is. And which way to adapt the function so that it works with a data frame, or preferably both types, thanks.
You can probably make this more elegant but here's a solution using purrr that works in both cases.
NAfun <- function (x, z) {
f1 <- function(x, z){
x[x %in% z] <- NA
x
}
purrr::modify(x, ~f1(., z))
}
As #Lyngbakr has correctly mentioned that behavior is consistent between D and M. The NAfun function worked on D as it was already converted to matrix by line D <- sapply(D, as.character).
Now, question is why behavior is inconsistent between matrix and data.frame? The actual reason is %in% operator.
The %in% operator compares each value of matrix in vector z as:
D %in% z
#[1] FALSE TRUE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
whereas %in% operator on data.frame compares for matching columns. Hence,
M %in% c(-99,-77)
#[1] FALSE FALSE FALSE FALSE
But
M %in% M[1:2]
#[1] TRUE TRUE FALSE FALSE
M %in% list(c(1,-99,3))
[1] TRUE FALSE FALSE FALSE
Modification needed in function NAfun to handle both data.frame and matrix:
NAfun <- function (x, z) {
x <- as.matrix(x)
x[x %in% z] <- NA
x
}
I'm new on this forum. I work in R.
I have a matrix (k x n) and I have to considere all combinations of the rows vectors (1 x n) taken 2, 3, 4 at a time.
Example:
Consider a matrix m = diag(c(rep(1, 3))),
I want the combinations of the three rows vectors (1 x n) taken 2 at a time:
first: (1,0,0) and (0,1,0)
second: (1,0,0) and (0,0,1)
third: (0,1,0) and (0,0,1)
In a second moment, for each couple, I need to compute the sum on the columns.
Any suggestion?
Thanks!
m <- diag(c(rep(1, 3)))
tmp <- combn(nrow(m), 2)
array(t(m[tmp,]), c(ncol(m), 2, ncol(tmp)))
#, , 1
#
# [,1] [,2]
#[1,] 1 0
#[2,] 0 1
#[3,] 0 0
#
#, , 2
#
# [,1] [,2]
#[1,] 1 0
#[2,] 0 0
#[3,] 0 1
#
#, , 3
#
# [,1] [,2]
#[1,] 0 0
#[2,] 1 0
#[3,] 0 1
Sorry, again in for some basic question.
I have six lists of categorical data:
[1] A,B,C,D
[2] C,D,B,A
In the end, i would like to have a matrix, that looks like
[1],[2]
[A] 1,4
[B] 2,3
[C] 3,1
[D] 4,2
So that each column contains a list of the ranks of the categorical data. Thank you very much again!
It is not clear about your input dataset
l1 <- list(LETTERS[1:4], LETTERS[c(3:4, 2:1)])
library(reshape2)
dat1 <- transform(melt(l1), indx=ave(seq_along(value), L1, FUN=seq_along))[,-2]
split(dat1$indx, dat1$value)
# $A
#[1] 1 4
# $B
#[1] 2 3
# $C
#[1] 3 1
# $D
#[1] 4 2
If you need a matrix output
do.call(rbind,split(dat1$indx, dat1$value))
Update
Or you could use mapply
res2 <- mapply(match, rep(list(LETTERS[1:4]),length(l1)), l1)
rownames(res2) <- LETTERS[1:4]
res2
# [,1] [,2]
#A 1 4
#B 2 3
#C 3 1
#D 4 2
Or using sapply contributed by #alexis_laz
res3 <- sapply(l1, function(x) match(LETTERS[1:4], x))
rownames(res3) <- rownames(res2)
Or, in this case:
sapply(l1, order)
# [,1] [,2]
#[1,] 1 4
#[2,] 2 3
#[3,] 3 1
#[4,] 4 2
This should work for you:
a <- c(toupper(letters[1:4]))
b <- c("C","D","B","A")
n <- length(a)
dfs <- list(a, b)
ranks <- rep(list(seq(n)), length(dfs))
for(i in 1:length(ranks)){
names(ranks[[i]]) <- dfs[[i]]
ranks[[i]] <- ranks[[i]][order(names(ranks[[i]]))]
}
sapply(ranks, FUN = function(x) x)