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

PIKAL Petr petr@p|k@| @end|ng |rom prechez@@cz
Mon Mar 23 08:04:54 CET 2020


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 Collapse        0
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.pikal using 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 <r-help-bounces using r-project.org> On Behalf Of Ioanna Ioannou
> Sent: Saturday, March 21, 2020 5:54 PM
> To: r-help using 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.999927197,0.999951931,0.999967938,0.999978407,0.9999
> 85325,0.999989939',
> 
>
'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.999998
> 652,0.999999993,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.999999999,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.9989978
> 36,0.999955341,0.999998628,0.999999969,0.999999999,1,1,1,1,1,1,1,1',
>                              '0,2.12e-51,4.89e-
>
14,0.001339285,0.559153268,0.995244295,0.999997786,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 = ",")))
>         print(VC[calc_rows] )
>       }
>     }
>   }
> 
> 
> 
> Vul <- distinct(d1[,c(1,2)])
> 
> dim(VC) <- c(length(unlist(str_split(as.character(d1[2,]$Y_vals), pattern
=
> ","))),length(distinct(d1[,c(1,2)])$Name))  ## (rows, cols) VC VC_t <-
t(VC)
> Vulnerability <- matrix(apply(VC_t, 1, function(x) paste(x, collapse =
',')))
> 
> Vul$Y_vals <- Vulnerability
> 
> 
> 
> 
> ________________________________
> From: Jeff Newmiller <jdnewmil using dcn.davis.ca.us>
> Sent: 21 March 2020 16:27
> To: r-help using r-project.org <r-help using r-project.org>; Ioanna Ioannou
> <ii54250 using msn.com>; r-help using r-project.org <r-help using r-project.org>
> Subject: Re: [R] How to save output of multiple loops in a matrix
> 
> 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 <ii54250 using msn.com>
> 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.charac
> >ter(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
> >
> >
> >
> >
> >
> >
> >
> >
> >
> >
> >Name    Taxonomy        Damage_State    Y_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.999927197,0.999951931,0.999967938,0.999978407
> ,
> >0.999985325,0.9 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
> >0,6.49e-45,1.29e-29,3.35e-22,1.25e-17,1.8e-14,3.81e-12,2.35e-10,6.18e-0
> >9,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
> >Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)
> >CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//
> >Extensive
> >5.02e-182,3.52e-10,8.81e-07,3.62e-05,0.000346166,0.001608096,0.00491696
> >5,0.01150426,0.022416772,0.038311015,0.059392175,0.085458446,0.1159987
> 0
> >2,0.150303282,0.187564259,0.226954808,0.267685669,0.309041053,0.350398
> 0
> >6,0.391233913,0.431124831,0.469739614,0.506830242,0.542221151,0.575798
> 2
> >68,0.607498531 Hancilar et. al (2014) - CR/LDUAL school - Case V (Sd)
> >CR/LDUAL/HEX:4+HFEX:12.8/YAPP:1990/EDU+EDU2//PLFSQ/IRRE//RSH1//
> >Moderate
> >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
> >Rojas(2010) - CR/LFM/DNO 2storey        CR/LFM/DNO/H:2/EDU2
> >Collapse
> >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.999998
> 652,0.999999993,1,1,1,1,1,1,1,1,1,1,1,1,1
> >Rojas(2010) - CR/LFM/DNO 2storey        CR/LFM/DNO/H:2/EDU2
> >Extensive
> >0,1.21e-32,1.78e-
>
05,0.645821244,0.999823159,0.999999999,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1
> >Rojas(2010) - CR/LFM/DNO 2storey        CR/LFM/DNO/H:2/EDU2
> >Moderate
> >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
> >Rojas(2010) - CR/LFM/DNO 2storey        CR/LFM/DNO/H:2/EDU2     Slight
> >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
> >Rojas(2010) - CR/LFM/DNO 3storey        CR/LFM/DNO/H:3   Collapse
> >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.9989978
> 36,0.999955341,0.999998628,0.999999969,0.999999999,1,1,1,1,1,1,1,1
> >Rojas(2010) - CR/LFM/DNO 3storey        CR/LFM/DNO/H:3   Extensive
> >0,2.12e-51,4.89e-
>
14,0.001339285,0.559153268,0.995244295,0.999997786,1,1,1,1,1,1,1,1,1,1,1,1,1
> ,1,1,1,1,1,1
> >Rojas(2010) - CR/LFM/DNO 3storey        CR/LFM/DNO/H:3  Moderate
> >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
> >Rojas(2010) - CR/LFM/DNO 3storey        CR/LFM/DNO/H:3  Slight
> >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
> >
> >
> >       [[alternative HTML version deleted]]
> >
> >______________________________________________
> >R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see
> >https://stat.ethz.ch/mailman/listinfo/r-help
> >PLEASE do read the posting guide
> >http://www.R-project.org/posting-guide.html
> >and provide commented, minimal, self-contained, reproducible code.
> 
> --
> Sent from my phone. Please excuse my brevity.
> 
> 	[[alternative HTML version deleted]]
> 
> ______________________________________________
> R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-
> guide.html
> and provide commented, minimal, self-contained, reproducible code.


More information about the R-help mailing list