Создать таблицу из векторов

[VistaSV30]

Добрый день!
У меня есть data.frame следующего содержания:

Код: Выделить всё

   a1 a2
1   3  3
2   4  5
3   2  3
4   5  1
5   1  1
6   3  2
7   3  4
8   4  5
9   1  3
10  4  2

На его основе мне нужно сформировать Таблицу следующего вида:
0 0 0 1 1 1 0 0 0 0
0 0 0 0 1 1 1 1 1 0
...

Т.е. сначала идут нули, их количество соответствует значению a1, потом единицы, их количество соответствует значению a2. И в конце вектор дополняется нулями, чтобы его длинна равнялась 10.
Для формирования вектора написал функцию

Код: Выделить всё

FF <- function(x, y){
  B <- rep(0, x)
  B <- append(B, rep(1, y))
  B <- append(B, rep(0, 10 - x - y))
  return(B)
}

Подскажите, пожалуйста, в каком формате лучше сделать Таблицу - data.frame, matrix или array? С учетом того, что реальная таблица будет размером 1440х2300000.

И второй вопрос - как написать код цикла для заполнения Таблицы? Пытался сделать это с помощью sapply(), но пока не получается.

Спасибо!

P.S.

Код: Выделить всё

a1 <- sample(1:5, 10, replace = TRUE)
a2 <- sample(1:5, 10, replace = TRUE)
A <- data.frame(a1, a2)

FF <- function(x, y){
  B <- rep(0, x)
  B <- append(B, rep(1, y))
  B <- append(B, rep(0, 10 - x - y))
  return(B)
}

[VistaSV30]

Если всё прописывать "вручную", то первые две строки таблицы получаются так:

Код: Выделить всё

D1 <- FF(A$a1[1], A$a2[1])
D2 <- FF(A$a1[2], A$a2[2])

D <- cbind(D1, D2)

И получается матрица:

Код: Выделить всё

> D
      D1 D2
 [1,]  0  0
 [2,]  0  0
 [3,]  0  0
 [4,]  1  0
 [5,]  1  1
 [6,]  1  1
 [7,]  0  1
 [8,]  0  1
 [9,]  0  1
[10,]  0  0
> class(D)
[1] "matrix"

Неужели прийдется использовать цикл for?

[nickleb]

Код: Выделить всё

library(purrr)

FF <- function(x, y){
  B <- rep(0, x)
  B <- append(B, rep(1, y))
  B <- append(B, rep(0, 10 - x - y))
  return(B)
}

a1 <- sample(1:5, 10, replace = TRUE)
a2 <- sample(1:5, 10, replace = TRUE)
A <- data.frame(a1, a2, stringsAsFactors = FALSE)

A$b <- purrr::map2(A$a1, A$a2, FF)
A$b <- lapply(A$b, as.integer)
str(A$b)

[gamm]

опять какие-то загогулины, проще надо

Код: Выделить всё

set.seed(123)
a1 <- sample(1:5, 10, replace = TRUE)
a2 <- sample(1:5, 10, replace = TRUE)
A1 <- data.frame(a1, a2)
FF1 <- function(x){
  B <- rep(0, 10)
  if(x[2] > 0) B[(x[1]+1):(sum(x))] <- 1
  return(B)
}
B1=t(apply(A1,1,FF1))
B1

[VistaSV30]

Спасибо большое!
Применил вариант, предложный gamm - всё работает!

[nickleb]

Пытался сделать это с помощью sapply(), но пока не получается.

вопрос у Вас уже решённый, но-таки без data.frame (ведь а1 и а2 - "параллельны" и длины одинаковой?) с несколько др. вариантом rep и через вопрошаемый Вами sapply:

Код: Выделить всё

a1 <- sample(1:5, 1440, replace = TRUE)
a2 <- sample(1:5, 1440, replace = TRUE)
b <- sapply(1:length(a1), 
            function(i) {
              rep(x = c(0,1,0), times = c(a1[i], a2[i], 10-a1[i]-a2[i]))
  }
)
b <- t(b)

[VistaSV30]

Подскажите ещё пожалуйста!

Сейчас только догадался. В итоге то мне будет нужна сумма векторов и видимо не стоит создавать Таблицу, а проще сразу делать вектор с суммами.

Код: Выделить всё

set.seed(123)
a1 <- sample(1:5, 10, replace = TRUE)
a2 <- sample(1:5, 10, replace = TRUE)
A1 <- data.frame(a1, a2)

FF2 <- function(x, y){
  B <- append(rep(0, 10), rep(1,y), after = x)[1:10]
  return(B)
}

# Итоговый вектор (только хотелось бы это сделать циклом)
B1 <- rep(0,10)
B1 <- B1 + FF2(A1$a1[1], A1$a2[1])
B1 <- B1 + FF2(A1$a1[2], A1$a2[2])

Подскажите, как правильно написать цикл суммирования векторов?

[gamm]

Код: Выделить всё

set.seed(123)
a1 <- sample(1:5, 10, replace = TRUE)
a2 <- sample(1:5, 10, replace = TRUE)
A1 <- data.frame(a1, a2)

global.sum=rep(0,10)
FF1 <- function(x){
  B <- rep(0, 10)
  if(x[2] > 0) B[(x[1]+1):(sum(x))] <- 1
  assign("global.sum", global.sum+B, envir = .GlobalEnv)  
  return(NULL)
}
apply(A1,1,FF1)
global.sum

[VistaSV30]

Спасибо громадное!
Работает!

Только изменил немного формулу B[(x[1]):(sum(x)-1)], а то диапазон единиц смещался вправо на одну позицию

Код: Выделить всё

set.seed(123)
a1 <- sample(1:3, 6, replace = TRUE)
a2 <- sample(1:3, 6, replace = TRUE)

A1 <- data.frame(a1, a2)

global.sum=rep(0,6)
FF1 <- function(x){
  B <- rep(0, 6)
  if(x[2] > 0) B[(x[1]):(sum(x)-1)] <- 1
  assign("global.sum", global.sum+B, envir = .GlobalEnv)  
  return(NULL)
}
apply(A1,1,FF1)
global.sum
barplot(global.sum)

[gamm]

диапазон единиц смещался вправо на одну позицию

нет. Сравните со своим же примером в первом посте ...

Код: Выделить всё

A1 <- data.frame(a1=c(3,4), a2=c(3,5))
FF1 <- function(x){
  B <- rep(0, 10)
  if(x[2] > 0) B[(x[1]+1):(sum(x))] <- 1
  return(B)
}
B1=t(apply(A1,1,FF1))
B1
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    0    0    0    1    1    1    0    0    0     0
[2,]    0    0    0    0    1    1    1    1    1     0

[nickleb]

В итоге то мне будет нужна сумма векторов и видимо не стоит создавать Таблицу, а проще сразу делать вектор с суммами.

- вариант через Reduce и lapply:

Код: Выделить всё

n = 5
N = 10
set.seed(123)
a1 <- sample(1:n, N, replace = TRUE)
a2 <- sample(1:n, N, replace = TRUE)

b <- lapply(1:length(a1), 
            function(i) {
              rep(x = c(0,1,0), times = c(a1[i], a2[i], N-a1[i]-a2[i]))
            }
)

B <- Reduce("+", b)
str(B)

[VistaSV30]

Спасибо еще раз!
Попробовал на реальных данных (почти реальных). Вроде бы получилось

Код: Выделить всё

ds <- sample(1577836800:1580515200, 100, replace = T)
df <- ds + sample(600:10800, 100, replace = T)
St <- as.POSIXct(ds, origin = "1970-01-01")
Fh <- as.POSIXct(df, origin = "1970-01-01")
Fr <- data.frame(St, Fh)

library(lubridate)
Tm <- data.frame(St = hour(Fr$St)*60 + minute(Fr$St),
                 Fh = hour(Fr$Fh)*60 + minute(Fr$Fh))
Tm$Fh <- Tm$Fh - Tm$St
Tm$Fh <- ifelse(Tm$Fh <0, 1440-Tm$St, Tm$Fh)
Tm$Fh <- ifelse((Tm$Fh + Tm$St)>1440, 1440-Tm$St, Tm$Fh)

G <- rep(0, 1440)
FF <- function(x){
   B <- rep(0, 1440)
   if(x[2] > 0) B[(x[1]):(sum(x)-1)] <- 1
   assign("G", G + B, envir = .GlobalEnv)  
   return(NULL)
}
apply(Tm,1,FF)
barplot(G)

Сейчас пробую разобраться почему не получается построить такую же диаграмму средствами ggplot2

Код: Выделить всё

D <- data.frame(Time = 1:1440, G)
library(ggplot2)
ggplot(D, aes(x = Time, y = G)) + geom_point() + geom_smooth()

[VistaSV30]

нет. Сравните со своим же примером в первом посте ...

Я там ошибался. Извиняюсь!

[VistaSV30]

Неожиданно возникла еще одна проблема.


На диаграмме представлено суммарное количество пожаров, которые происходили в данную минуту суток.

Оказалось, что происходит достаточно много переходящих пожаров, которые начинаются и заканчиваются в разные сутки. В данном случае я просто отбрасывал время превышающее 1440 минут. Но оказалось, что таких случаев достаточно много и поэтому значения G при X < 150 сильно так отличаются от среднего.

Сегодня уже пора спать. Завтра буду на свежую голову пытаться, что-то сделать.

Код: Выделить всё

ds <- sample(1577836800:1580515200, 1000, replace = T)
df <- ds + sample(600:10800, 1000, replace = T)
St <- as.POSIXct(ds, origin = "1970-01-01")
Fh <- as.POSIXct(df, origin = "1970-01-01")
Fr <- data.frame(St, Fh)

library(lubridate)
Tm <- data.frame(St = hour(Fr$St)*60 + minute(Fr$St),
                 Fh = hour(Fr$Fh)*60 + minute(Fr$Fh))
Tm$Fh <- Tm$Fh - Tm$St
Tm$Fh <- ifelse(Tm$Fh <0, 1440-Tm$St, Tm$Fh)
Tm$Fh <- ifelse((Tm$Fh + Tm$St)>1440, 1440-Tm$St, Tm$Fh)

G <- rep(0, 1440)
FF <- function(x){
   B <- rep(0, 1440)
   if(x[2] > 0) B[(x[1]):(sum(x)-1)] <- 1
   assign("G", G + B, envir = .GlobalEnv)  
   return(NULL)
}
apply(Tm,1,FF)

D <- data.frame(Time = 0:1439, G)
library(ggplot2)

D$Tm <- as.POSIXct(D$Time, origin = "1970-01-01", tz = "GMT")
ggplot(D, aes(x = Time, y = G)) + 
  geom_point(alpha = 0.2) + 
  geom_smooth() 

Попробую убрать ifelse и делать это в функции FF()

[gamm]

которые начинаются и заканчиваются в разные сутки

делается это так: определяется длительность пожара в целых сутках n.days (округляем вверх), строим на все сутки вектор tmp из нулей rep(0,1440*n.days), потом переводим позиции вектора во время tmp.time от начала первых суток пожара, и определяем индекс для интервал пожара, ind=fire.start<=tmp.time & tmp.time<=fire.end, ставим единицы tmp[ind]=1, и получаем суммарный вектор на весь пожар B=colSums(matrix(tmp,ncol=1440,byrow=TRUE)). И делаем цикл sapply по пожарам с суммированием (глобальных) этих самых В. Никакие матрицы не нужны. Дальше сами, все части уже писались ранее