Управление подматрицами в R

Nh<-matrix(c(17,26,30,17,23, 17 ,24, 23), nrow=2, ncol=4); Nh
Sh<-matrix(c(8.290133, 6.241174, 6.096808, 7.4449672, 6.894924, 7.692115, 
             4.540521, 7.409122), nrow=2, ncol=4); Sh
NhSh<-as.matrix(Nh*Sh); NhSh
rh<-c( 0.70710678, 0.40824829, 0.28867513, 0.22360680, 0.18257419, 
       0.15430335, 0.13363062, 0.11785113, 0.10540926, 0.09534626); rh

pv <- c()
for (j in 1:2) {
  for (i in 1:4) {

    pv <- rbind(pv, NhSh[j,i]*rh)
  }
}
pv

row.names(pv) <- rep(c(1:2), each = 4)
lst<-lapply(split(seq_len(nrow(pv)), as.numeric(row.names(pv))), function(i) 
pv[i,])

data<-40
nlargest <- function(x, data) 
{
  res <- order(x)[seq_len(data)];
  pos <- arrayInd(res, dim(x), useNames = TRUE);
  list(values = pv[res], position = pos)
}
out <- lapply(lst, nlargest, data = 40)

В продолжение приведенного выше кода. Есть ли какой-нибудь краткий способ повторить следующие шаги для каждой позиции out$’k’$ для k в соотношении 1:2?

s1<-c(1,1,1,1); ch<-c(5,7,10,5); C<-150; a<-out$'1'$position 
for (j in a[40:1, "row"] ) 
{
 s1[j] <- s1[j]+1;
 cost1 <- sum(ch*s1);
 if (cost1>=C) break
}
s1; cost1
#Output [1] 5 6 6 5  

#       [1] 152

Мне нужно получить 2 значения для «s» и «стоимость» для out$k$position. Я попытался

mat = replicate (2,{x = matrix(data = rep(NA, 80), ncol = 2)}); mat
for (k in 1:2)
{
  mat[,,k]<-out$'k'$position
}
mat

Ошибка в mat[, , k] ‹- out$k$position : количество элементов для замены не кратно длине замены

for (k in 1:2)
{
for (j in mat[,,k][40:1] ) {
  s[j] <- s[j]+1  
  cost <- sum(ch*s)
  if (cost>=C) break

}
}
s; cost

Ошибка: ошибка в s[j] ‹- s[j] + 1: NA не разрешены в назначениях с индексами.

Пожалуйста, помогите кто-нибудь в решении этих ошибок.


r submatrix
person Sam    schedule 14.05.2018    source источник
comment
Я предполагаю, что 2-й последний код исправлен, и вы хотите, чтобы последний блок кода был исправлен, верно?   -  person akrun    schedule 16.05.2018
comment
Я хочу, чтобы он возвращал значение s и стоимость отдельно для мата [,,1] и мата [,,2]   -  person Sam    schedule 16.05.2018
comment
Где вы определили s? Это то же самое s1?   -  person akrun    schedule 16.05.2018
comment
Извините, это моя ошибка. Это s1 определяется как s1<-c(1,1,1,1)   -  person Sam    schedule 16.05.2018
comment
Кроме того, что такое C в сравнении?   -  person akrun    schedule 16.05.2018
comment
C<-150 определено в коде   -  person Sam    schedule 16.05.2018
comment
Можете ли вы проверить обновленное решение   -  person akrun    schedule 16.05.2018
comment
Я понял. да, это прекрасно. Можно ли увидеть значение s, для которого стоимость остается меньше 150? Результат показывает те значения s, для которых стоимость превышает 150. Когда я пишу «n‹-print (s1)» после условия разрыва, он возвращает желаемый результат, но для цикла k я не знаю   -  person Sam    schedule 16.05.2018
comment
Наверное, тогда логику надо менять   -  person akrun    schedule 16.05.2018
comment
Я пробовал для if (cost<=C) break но потом возвращает начальное первое значение s1 для которого стоимость была меньше C и не учитывал другие значения s1 для которых стоимость осталась меньше C   -  person Sam    schedule 16.05.2018

Ответы (1)


arrow_upward
2
arrow_downward

Мы могли бы применить функцию напрямую, зациклившись на list. Обратите внимание, что каждый элемент list является matrix

sapply(lst, is.matrix)
#  1    2 
#TRUE TRUE

поэтому нет необходимости unlist и создавать matrix

out <- lapply(lst, nlargest, data = 40)

-проверка результатов ОП

out1 <- nlargest(sub1, 40)
identical(out[[1]], out1)
#[1] TRUE

Обновление2

Основываясь на втором обновлении, нам нужно инициализировать 'cost' и 'sl' с той же длиной, что и элементы 'k'. Здесь мы инициализируем 'sl' как list из vectors

sl <- rep(list(c(1, 1, 1, 1)), 2)
C <- 150
cost <- numeric(2)
for (k in 1:2){

for (j in mat[,,k][40:1, 1] ) {
    sl[[k]][j] <- sl[[k]][j]+1  
    cost[k] <- sum(ch*sl[[k]])
    if (cost[k] >=C) break


    }
   }   


sl
#[[1]]
#[1] 5 7 6 4

#[[2]]
#[1] 6 5 5 7

cost
#[1] 154 150
person akrun    schedule 14.05.2018
comment
Проблема решена. Я очень ценю вашу помощь @akrun - person Sam; 14.05.2018
comment
@akrun- Извините за неудобства, но я должен спросить. В продолжение приведенного выше кода есть ли какой-нибудь краткий способ повторить следующие шаги для каждой позиции out$’k’$ для k в 1:100? s1<-c(1,1,1,1); ch<-c(5,7,10,5); a<-out$1$position; for (j in a[40:1, "row"] ) { s1[j] <- s1[j]+1; cost1 <- sum(ch*s1); if (cost1>=C) break } s1; cost1Мне нужно получить 100 значений для 's' и 'cost' для out$k$position. - person Sam; 15.05.2018
comment
@Sam Не могли бы вы обновить свой вопрос. Трудно читать комментарии - person akrun; 15.05.2018