Re: [R] How to save output of multiple loops in a matrix

2020-03-23 Thread PIKAL Petr
Hi

What about instead of using split inside several cycles prepare new data
frame and perform required calculation on it
E.g. for the first row you get from second ant fourth column following
(26,2) matrix.

cbind(d1[1,3],unlist(strsplit(d1[1,4],",")))
  [,1]   [,2] 
 [1,] "Collapse" "0"  
 [2,] "Collapse" "6.49e-45"   
 [3,] "Collapse" "1.29e-29"   
 [4,] "Collapse" "3.35e-22"   
 [5,]


you could easily cycle through rows by

lll <- vector("list", 12)
for (i in 1:12) {

lll[[i]] <- cbind(d1[i,3],unlist(strsplit(d1[i,4],",")))
}

str(lll)
List of 12
 $ : chr [1:26, 1:2] "Collapse" "Collapse" "Collapse" "Collapse" ...
 $ : chr [1:26, 1:2] "Extensive" "Extensive" "Extensive" "Extensive" ...
 $ : chr [1:26, 1:2] "Moderate" "Moderate" "Moderate" "Moderate" ...

by do call you could change it to matrix and/or data.frame
> ddd <- data.frame(do.call(rbind, lll))
> head(ddd)
X1   X2
1 Collapse0
2 Collapse 6.49e-45
3 Collapse 1.29e-29
4 Collapse 3.35e-22
5 Collapse 1.25e-17
6 Collapse  1.8e-14
> str(data.frame(ddd))
'data.frame':   312 obs. of  2 variables:
 $ X1: chr  "Collapse" "Collapse" "Collapse" "Collapse" ...
 $ X2: chr  "0" "6.49e-45" "1.29e-29" "3.35e-22" ...
> dim(ddd)
[1] 312   2
>

I am not sure if this is what you want but my feeling is that it makes
further calculation easier.

S pozdravem | Best Regards
RNDr. Petr PIKAL
Vedoucí Výzkumu a vývoje | Research Manager
PRECHEZA a.s.
nábř. Dr. Edvarda Beneše 1170/24 | 750 02 Přerov | Czech Republic
Tel: +420 581 252 256 | GSM: +420 724 008 364
petr.pi...@precheza.cz | www.precheza.cz

Osobní údaje: Informace o zpracování a ochraně osobních údajů obchodních
partnerů PRECHEZA a.s. jsou zveřejněny na:
https://www.precheza.cz/zasady-ochrany-osobnich-udaju/ | Information about
processing and protection of business partner's personal data are available
on website: https://www.precheza.cz/en/personal-data-protection-principles/
Důvěrnost: Tento e-mail a jakékoliv k němu připojené dokumenty jsou důvěrné
a podléhají tomuto právně závaznému prohlášení o vyloučení odpovědnosti:
https://www.precheza.cz/01-dovetek/ | This email and any documents attached
to it may be confidential and are subject to the legally binding disclaimer:
https://www.precheza.cz/en/01-disclaimer/

> -Original Message-
> From: R-help  On Behalf Of Ioanna Ioannou
> Sent: Saturday, March 21, 2020 5:54 PM
> To: r-help@r-project.org
> Subject: Re: [R] How to save output of multiple loops in a matrix
> 
> Hello again,
> 
> Here is the reproducible example:
> 
> rm(list = ls())
> library(plyr)
> library(dplyr)
> library( data.table)
> library(stringr)
> 
> 
> d1 <- data.frame( Name = rep(c('Hancilar et. al (2014) - CR/LDUAL school -
> Case V (Sd)',
>'Rojas(2010) - CR/LFM/DNO 2storey',
>'Rojas(2010) - CR/LFM/DNO 3storey'), each =
4),
>   Taxonomy =
> rep(c('CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1/
> /',
>'CR/LFM/DNO/H:2/EDU2',
>'CR/LFM/DNO/H:3'), each = 4),
>   Damage_State =rep(c('Collapse', 'Extensive', 'Moderate',
'Slight'),
> times =3),
>   Y_vals =
c('0,6.49e-45,1.29e-29,3.35e-22,1.25e-17,1.8e-14,3.81e-
> 12,2.35e-10,6.18e-09,8.78e-08,7.86e-07,4.92e-06,2.32e-05,8.76e-
> 05,0.000274154,0.000736426,0.001740046,0.003688955,0.007130224,0.012730
> 071,0.021221055,0.0333283,0.049687895,0.070771949,0.096832412,0.1278710
> 6',
>  '5.02e-182,3.52e-10,8.81e-07,3.62e-
> 05,0.000346166,0.001608096,0.004916965,0.01150426,0.022416772,0.0383110
> 15,0.059392175,0.085458446,0.115998702,0.150303282,0.187564259,0.226954
> 808,0.267685669,0.309041053,0.35039806,0.391233913,0.431124831,0.469739
> 614,0.506830242,0.542221151,0.575798268,0.607498531',
>  '0,1.05e-10,4.75e-
> 06,0.000479751,0.006156253,0.02983369,0.084284357,0.171401809,0.2817210
> 77,0.401071017,0.516782184,0.620508952,0.708327468,0.779597953,0.835636
> 781,0.87866127,0.911104254,0.935237852,0.95300803,0.965993954,0.9754315
> 4,0.982263787,0.987197155,0.990753887,0.993316294,0.99516227',
>  '4.61e-
> 149,0.007234459,0.158482316,0.438164341,0.671470035,0.818341464,0.90131
> 2438,0.946339742,0.970531767,0.983584997,0.990707537,0.994650876,0.9968
> 69188,0.998137671,0.998874868,0.9993101,0.999570978,0.999729626,0.99982
> 7443,0.999888548,0.27197,0.51931,0.67938,0.78407,0.
> 85325,0.89939',
> 
>
'0,4.91e-109,2.88e-47,3.32e-23,1.65e-11,1.78e-
> 05,0.018162775,0.356628282,0.870224163,0.992779045,0.999855873,0.98
> 652,0.3,1,1,1,1,1,1,1,1,1,1,1,1,1',
>  '0,1.21e-32,1.78e-
>
05,0.645821244,0.999823159,0.9,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1'
> ,
>
'0,0.077161367,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1',
>

Re: [R] How to save output of multiple loops in a matrix

2020-03-21 Thread Jeff Newmiller
You really need to pick small problems and build solutions for them as 
functions rather than copy-pasting code. Then you can build more 
complicated solutions using those small solutions that can actually be 
understood. I suspect that in a few days you would not understand your own 
code because it is so complicated... but that is not inevitable... you 
_can_ avoid creating write-only code.


library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(tidyr)

damage_states <- c( 'Collapse', 'Extensive', 'Moderate', 'Slight')
# the following re-definition of d1 uses the stringsAsFactors parameter to
# prevent the character data from automatically being converted to
# factors, which is much better than having to use as.character later 
# throughout your code.

d3 <- data.frame( Name = rep(c( 'Hancilar et. al (2014) - CR/LDUAL school - 
Case V (Sd)'
  , 'Rojas(2010) - CR/LFM/DNO 2storey'
  , 'Rojas(2010) - CR/LFM/DNO 3storey'
  )
, each = 4
)
, Taxonomy = rep(c( 
'CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//'
  , 'CR/LFM/DNO/H:2/EDU2'
  , 'CR/LFM/DNO/H:3'
  )
, each = 4
)
, Damage_State = rep( damage_states, times = 3 )
, Y_vals = c( 
'0,6.49e-45,1.29e-29,3.35e-22,1.25e-17,1.8e-14,3.81e-12,2.35e-10,6.18e-09,8.78e-08,7.86e-07,4.92e-06,2.32e-05,8.76e-05,0.000274154,0.000736426,0.001740046,0.003688955,0.007130224,0.012730071,0.021221055,0.0333283,0.049687895,0.070771949,0.096832412,0.12787106'
, 
'5.02e-182,3.52e-10,8.81e-07,3.62e-05,0.000346166,0.001608096,0.004916965,0.01150426,0.022416772,0.038311015,0.059392175,0.085458446,0.115998702,0.150303282,0.187564259,0.226954808,0.267685669,0.309041053,0.35039806,0.391233913,0.431124831,0.469739614,0.506830242,0.542221151,0.575798268,0.607498531'
, 
'0,1.05e-10,4.75e-06,0.000479751,0.006156253,0.02983369,0.084284357,0.171401809,0.281721077,0.401071017,0.516782184,0.620508952,0.708327468,0.779597953,0.835636781,0.87866127,0.911104254,0.935237852,0.95300803,0.965993954,0.97543154,0.982263787,0.987197155,0.990753887,0.993316294,0.99516227'
, 
'4.61e-149,0.007234459,0.158482316,0.438164341,0.671470035,0.818341464,0.901312438,0.946339742,0.970531767,0.983584997,0.990707537,0.994650876,0.996869188,0.998137671,0.998874868,0.9993101,0.999570978,0.999729626,0.999827443,0.999888548,0.27197,0.51931,0.67938,0.78407,0.85325,0.89939'
, 
'0,4.91e-109,2.88e-47,3.32e-23,1.65e-11,1.78e-05,0.018162775,0.356628282,0.870224163,0.992779045,0.999855873,0.98652,0.3,1,1,1,1,1,1,1,1,1,1,1,1,1'
, 
'0,1.21e-32,1.78e-05,0.645821244,0.999823159,0.9,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1'
, 
'0,0.077161367,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1'
, 
'0,0.996409276,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1'
, 
'0,1.29e-144,1.99e-71,1.16e-40,3.23e-24,1.59e-14,1.41e-08,6.42e-05,0.00971775,0.153727719,0.562404795,0.889217735,0.985915683,0.998997836,0.55341,0.98628,0.99969,0.9,1,1,1,1,1,1,1,1'
, 
'0,2.12e-51,4.89e-14,0.001339285,0.559153268,0.995244295,0.97786,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1'
, 
'0,3.22e-07,0.992496021,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1'
, 
'0,0.368907496,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1'
)
, stringsAsFactors = FALSE
)
# convert Damage_State to a factor using the desired sequence of levels
# This is useful when spread'ing the values to create columns in the 
# desired order

d3$Damage_State = factor( d3$Damage_State, levels = damage_states )
d3long <- (   d3
  %>% separate_rows( Y_vals, sep="," )
  %>% mutate( Y_vals = as.numeric( Y_vals ) )
  )
str( d3long )
#> 'data.frame':312 obs. of  4 variables:
#>  $ Name: chr  "Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)" "Hancilar et. al 
(2014) - CR/LDUAL school - Case V (Sd)" "Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)" 
"Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)" ...
#>  $ Taxonomy: chr  "CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//" 
"CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//" 

Re: [R] How to save output of multiple loops in a matrix

2020-03-21 Thread Ioanna Ioannou
Hello again,

Here is the reproducible example:

rm(list = ls())
library(plyr)
library(dplyr)
library( data.table)
library(stringr)


d1 <- data.frame( Name = rep(c('Hancilar et. al (2014) - CR/LDUAL school - Case 
V (Sd)',
   'Rojas(2010) - CR/LFM/DNO 2storey',
   'Rojas(2010) - CR/LFM/DNO 3storey'), each = 4),
  Taxonomy = 
rep(c('CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//',
   'CR/LFM/DNO/H:2/EDU2',
   'CR/LFM/DNO/H:3'), each = 4),
  Damage_State =rep(c('Collapse', 'Extensive', 'Moderate', 
'Slight'), times =3),
  Y_vals = 
c('0,6.49e-45,1.29e-29,3.35e-22,1.25e-17,1.8e-14,3.81e-12,2.35e-10,6.18e-09,8.78e-08,7.86e-07,4.92e-06,2.32e-05,8.76e-05,0.000274154,0.000736426,0.001740046,0.003688955,0.007130224,0.012730071,0.021221055,0.0333283,0.049687895,0.070771949,0.096832412,0.12787106',
 
'5.02e-182,3.52e-10,8.81e-07,3.62e-05,0.000346166,0.001608096,0.004916965,0.01150426,0.022416772,0.038311015,0.059392175,0.085458446,0.115998702,0.150303282,0.187564259,0.226954808,0.267685669,0.309041053,0.35039806,0.391233913,0.431124831,0.469739614,0.506830242,0.542221151,0.575798268,0.607498531',
 
'0,1.05e-10,4.75e-06,0.000479751,0.006156253,0.02983369,0.084284357,0.171401809,0.281721077,0.401071017,0.516782184,0.620508952,0.708327468,0.779597953,0.835636781,0.87866127,0.911104254,0.935237852,0.95300803,0.965993954,0.97543154,0.982263787,0.987197155,0.990753887,0.993316294,0.99516227',
 
'4.61e-149,0.007234459,0.158482316,0.438164341,0.671470035,0.818341464,0.901312438,0.946339742,0.970531767,0.983584997,0.990707537,0.994650876,0.996869188,0.998137671,0.998874868,0.9993101,0.999570978,0.999729626,0.999827443,0.999888548,0.27197,0.51931,0.67938,0.78407,0.85325,0.89939',

 
'0,4.91e-109,2.88e-47,3.32e-23,1.65e-11,1.78e-05,0.018162775,0.356628282,0.870224163,0.992779045,0.999855873,0.98652,0.3,1,1,1,1,1,1,1,1,1,1,1,1,1',
 
'0,1.21e-32,1.78e-05,0.645821244,0.999823159,0.9,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1',
 
'0,0.077161367,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1',
 
'0,0.996409276,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1',

 
'0,1.29e-144,1.99e-71,1.16e-40,3.23e-24,1.59e-14,1.41e-08,6.42e-05,0.00971775,0.153727719,0.562404795,0.889217735,0.985915683,0.998997836,0.55341,0.98628,0.99969,0.9,1,1,1,1,1,1,1,1',
 
'0,2.12e-51,4.89e-14,0.001339285,0.559153268,0.995244295,0.97786,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1',
 
'0,3.22e-07,0.992496021,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1',
 
'0,0.368907496,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1')
 )




D2L <- c(0, 2, 10, 50, 100)

VC_final <- array(NA, length(distinct(d1[,c(1,2)])$Name) )

# get the rows for the four damage states
DS1_rows <- d1$Damage_State ==  unique(d1$Damage_State)[4]
DS2_rows <- d1$Damage_State ==  unique(d1$Damage_State)[3]
DS3_rows <- d1$Damage_State ==  unique(d1$Damage_State)[2]
DS4_rows <- d1$Damage_State ==  unique(d1$Damage_State)[1]

# step through all possible values of IM.type and Taxonomy and Name
 This is true for this subset not generalibale needs to be checked first ##
VC   <- matrix(NA, 3,26)
  for(Tax in unique(d1$Taxonomy)) {
for(Name in unique(d1$Name)) {
  # get a logical vector of the rows to be use DS5 in this calculation
  calc_rows <-  d1$Taxonomy == Tax & d1$Name == Name


  # check that there are any such rows in the DS5ata frame
  if(sum(calc_rows)) {

cat(Tax,Name,"\n")
# if so, fill in the four values for these rows
VC[calc_rows]  <- D2L[1] * (1- 
as.numeric(unlist(str_split(as.character(d1[calc_rows & DS1_rows,]$Y_vals), 
pattern = ","))) ) +
  D2L[2]* (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS1_rows,]$Y_vals), pattern = ","))) -
 as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS2_rows,]$Y_vals), pattern = "," +
  D2L[3]* (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS2_rows,]$Y_vals), pattern = ","))) -
 as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS3_rows,]$Y_vals), pattern = "," +
  D2L[4] * (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS3_rows,]$Y_vals), pattern = ","))) -
  as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS4_rows,]$Y_vals), pattern = "," +
  D2L[5]*as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS4_rows,]$Y_vals), pattern = ",")))

Re: [R] How to save output of multiple loops in a matrix

2020-03-21 Thread Jeff Newmiller
You have again posted using HTML  and the result is unreadable. Please post a 
reproducible example using dput instead of assuming we can read your formatted 
code or table.

On March 21, 2020 8:59:58 AM PDT, Ioanna Ioannou  wrote:
>Hello everyone,
>
>I am having this data.frame. For each row you have 26 values aggregated
>in a cell and separated by a comma. I want to do some calculations for
>all unique names and taxonomy which include the four different damage
>states. I can estimate the results but i am struggling to save them in
>a data.frame and assign next to them the unique combination of the
>name, taxonomy. Any help much appreciated.
>
>
>d1 <- read.csv('test.csv')
>
>D2L <- c(0, 2, 10, 50, 100)
>
>VC_final <- array(NA, length(distinct(d1[,c(65,4,3)])$Name) )
>VC   <- matrix(NA,
>length(distinct(d1[,c(65,4,3)])$Name),length(unlist(str_split(as.character(d1[1,]$Y_vals),
>pattern = ","
>
># get the rows for the four damage states
>DS1_rows <- d1$Damage_State ==  unique(d1$Damage_State)[4]
>DS2_rows <- d1$Damage_State ==  unique(d1$Damage_State)[3]
>DS3_rows <- d1$Damage_State ==  unique(d1$Damage_State)[2]
>DS4_rows <- d1$Damage_State ==  unique(d1$Damage_State)[1]
>
># step through all possible values of IM.type and Taxonomy and Name
> This is true for this subset not generalibale needs to be checked
>first ##
>
>for(IM in unique(d1$IM_type)) {
>  for(Tax in unique(d1$Taxonomy)) {
>for(Name in unique(d1$Name)) {
>   # get a logical vector of the rows to be use DS5 in this calculation
>   calc_rows <- d1$IM_type == IM & d1$Taxonomy == Tax & d1$Name == Name
>
>
>  # check that there are any such rows in the DS5ata frame
>  if(sum(calc_rows)) {
>cat(IM,Tax,Name,"\n")
># if so, fill in the four values for these rows
>VC[calc_rows]  <- D2L[1] * (1-
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS1_rows,]$Y_vals), pattern = ","))) ) +
>D2L[2]* (as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS1_rows,]$Y_vals), pattern = ","))) -
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS2_rows,]$Y_vals), pattern = "," +
>D2L[3]* (as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS2_rows,]$Y_vals), pattern = ","))) -
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS3_rows,]$Y_vals), pattern = "," +
>D2L[4] * (as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS3_rows,]$Y_vals), pattern = ","))) -
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS4_rows,]$Y_vals), pattern = "," +
>D2L[5]*as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS4_rows,]$Y_vals), pattern = ",")))
>print(VC[calc_rows] )
>  }
>}
>  }
>}
>
>  for(Tax in unique(d1$Taxonomy)) {
>for(Name in unique(d1$Name)) {
>   # get a logical vector of the rows to be use DS5 in this calculation
>   calc_rows <- d1$IM_type == IM & d1$Taxonomy == Tax & d1$Name == Name
>
>
>  # check that there are any such rows in the DS5ata frame
>  if(sum(calc_rows)) {
>cat(IM,Tax,Name,"\n")
># if so, fill in the four values for these rows
>VC[calc_rows]  <- D2L[1] * (1-
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS1_rows,]$Y_vals), pattern = ","))) ) +
>D2L[2]* (as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS1_rows,]$Y_vals), pattern = ","))) -
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS2_rows,]$Y_vals), pattern = "," +
>D2L[3]* (as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS2_rows,]$Y_vals), pattern = ","))) -
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS3_rows,]$Y_vals), pattern = "," +
>D2L[4] * (as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS3_rows,]$Y_vals), pattern = ","))) -
>as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS4_rows,]$Y_vals), pattern = "," +
>D2L[5]*as.numeric(unlist(str_split(as.character(d1[calc_rows &
>DS4_rows,]$Y_vals), pattern = ",")))
>print(unique(VC ))
>  }
>}
>  }
>
>Vul <- distinct(d1[,c(65,4,3)])
>
>dim(VC) <- c(length(unlist(str_split(as.character(d1[1,]$Y_vals),
>pattern = ","))),length(distinct(d1[,c(65,4,3)])$Name))  ## (rows,
>cols)
>VC
>VC_t <- t(VC)
>Vulnerability <- matrix(apply(VC_t, 1, function(x) paste(x, collapse =
>',')))
>
>Vul$Y_vals <- Vulnerability
>
>
>
>
>Best,
>ioanna
>
>
>
>
>
>
>
>
>
>
>NameTaxonomyDamage_StateY_vals
>Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd) 
>CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1// Slight 
>4.61e-149,0.007234459,0.158482316,0.438164341,0.671470035,0.818341464,0.901312438,0.946339742,0.970531767,0.983584997,0.990707537,0.994650876,0.996869188,0.998137671,0.998874868,0.9993101,0.999570978,0.999729626,0.999827443,0.999888548,0.27197,0.51931,0.67938,0.78407,0.85325,0.89939
>Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd) 
>CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1// 
>Collapse  

[R] How to save output of multiple loops in a matrix

2020-03-21 Thread Ioanna Ioannou
Hello everyone,

I am having this data.frame. For each row you have 26 values aggregated in a 
cell and separated by a comma. I want to do some calculations for all unique 
names and taxonomy which include the four different damage states. I can 
estimate the results but i am struggling to save them in a data.frame and 
assign next to them the unique combination of the name, taxonomy. Any help much 
appreciated.


d1 <- read.csv('test.csv')

D2L <- c(0, 2, 10, 50, 100)

VC_final <- array(NA, length(distinct(d1[,c(65,4,3)])$Name) )
VC   <- matrix(NA, 
length(distinct(d1[,c(65,4,3)])$Name),length(unlist(str_split(as.character(d1[1,]$Y_vals),
 pattern = ","

# get the rows for the four damage states
DS1_rows <- d1$Damage_State ==  unique(d1$Damage_State)[4]
DS2_rows <- d1$Damage_State ==  unique(d1$Damage_State)[3]
DS3_rows <- d1$Damage_State ==  unique(d1$Damage_State)[2]
DS4_rows <- d1$Damage_State ==  unique(d1$Damage_State)[1]

# step through all possible values of IM.type and Taxonomy and Name
 This is true for this subset not generalibale needs to be checked first ##

for(IM in unique(d1$IM_type)) {
  for(Tax in unique(d1$Taxonomy)) {
for(Name in unique(d1$Name)) {
  # get a logical vector of the rows to be use DS5 in this calculation
  calc_rows <- d1$IM_type == IM & d1$Taxonomy == Tax & d1$Name == Name


  # check that there are any such rows in the DS5ata frame
  if(sum(calc_rows)) {
cat(IM,Tax,Name,"\n")
# if so, fill in the four values for these rows
VC[calc_rows]  <- D2L[1] * (1- 
as.numeric(unlist(str_split(as.character(d1[calc_rows & DS1_rows,]$Y_vals), 
pattern = ","))) ) +
  D2L[2]* (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS1_rows,]$Y_vals), pattern = ","))) -
 as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS2_rows,]$Y_vals), pattern = "," +
  D2L[3]* (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS2_rows,]$Y_vals), pattern = ","))) -
 as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS3_rows,]$Y_vals), pattern = "," +
  D2L[4] * (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS3_rows,]$Y_vals), pattern = ","))) -
  as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS4_rows,]$Y_vals), pattern = "," +
  D2L[5]*as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS4_rows,]$Y_vals), pattern = ",")))
print(VC[calc_rows] )
  }
}
  }
}

  for(Tax in unique(d1$Taxonomy)) {
for(Name in unique(d1$Name)) {
  # get a logical vector of the rows to be use DS5 in this calculation
  calc_rows <- d1$IM_type == IM & d1$Taxonomy == Tax & d1$Name == Name


  # check that there are any such rows in the DS5ata frame
  if(sum(calc_rows)) {
cat(IM,Tax,Name,"\n")
# if so, fill in the four values for these rows
VC[calc_rows]  <- D2L[1] * (1- 
as.numeric(unlist(str_split(as.character(d1[calc_rows & DS1_rows,]$Y_vals), 
pattern = ","))) ) +
  D2L[2]* (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS1_rows,]$Y_vals), pattern = ","))) -
 as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS2_rows,]$Y_vals), pattern = "," +
  D2L[3]* (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS2_rows,]$Y_vals), pattern = ","))) -
 as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS3_rows,]$Y_vals), pattern = "," +
  D2L[4] * (as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS3_rows,]$Y_vals), pattern = ","))) -
  as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS4_rows,]$Y_vals), pattern = "," +
  D2L[5]*as.numeric(unlist(str_split(as.character(d1[calc_rows & 
DS4_rows,]$Y_vals), pattern = ",")))
print(unique(VC ))
  }
}
  }

Vul <- distinct(d1[,c(65,4,3)])

dim(VC) <- c(length(unlist(str_split(as.character(d1[1,]$Y_vals), pattern = 
","))),length(distinct(d1[,c(65,4,3)])$Name))  ## (rows, cols)
VC
VC_t <- t(VC)
Vulnerability <- matrix(apply(VC_t, 1, function(x) paste(x, collapse = ',')))

Vul$Y_vals <- Vulnerability




Best,
ioanna










NameTaxonomyDamage_StateY_vals
Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)  
CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1// Slight  
4.61e-149,0.007234459,0.158482316,0.438164341,0.671470035,0.818341464,0.901312438,0.946339742,0.970531767,0.983584997,0.990707537,0.994650876,0.996869188,0.998137671,0.998874868,0.9993101,0.999570978,0.999729626,0.999827443,0.999888548,0.27197,0.51931,0.67938,0.78407,0.85325,0.89939
Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)  
CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//  Collapse