Difference between revisions of "Building model"

### This code is Op_en6289/buildingstest on page [[Building model]].

library(OpasnetUtils)

########## Calculate all building events (constructions, demolitions, renovations)

buildings <- Ovariable("buildings", 
	dependencies = data.frame(Name = c(
		"stockBuildings",
		"changeBuildings",
		"heatingShares", # This can be indexed by building year (Time) or Observation year (Obsyear)
		"efficiencyShares", # Same here
		"renovationShares", 
		"renovationRate", # Fraction of buildings renovated between timepoints
		"demolitionRate", # Fraction of buildings demolished between timepoints
		#"heatTypeConversion", # Is dependent on buil, which defined in the formula (must handle withihn formula). Fraction of heating types converted to other
		"obstime" # In the new version obstime is ovariable with column Obsyear.
	)),
	formula = function(...) {
		
		stock <- stockBuildings * obstime 
		if( ! "Efficiency" %in% colnames(stock@output)) { # Add those shares that are missing
			stock <- stock * efficiencyShares
		}
		if( ! "Heating" %in% colnames(stock@output)) {
			stock <- stock * heatingShares
		}
		
		stock2 <- changeBuildings * obstime 
		if( ! "Efficiency" %in% colnames(stock2@output)) { # Add those shares that are missing
			stock2 <- stock2 * efficiencyShares
		}
		if( ! "Heating" %in% colnames(stock2@output)) {
			stock2 <- stock2 * heatingShares
		}
		
		stock2@output$Time <- as.factor(stock2@output$Time) # Also stock@output$Time is factor
		buil <- combine(stock, stock2) # Buildings in the whole timeline
		buil <- unkeep(buil, sources = TRUE)
		buil@output$Age <- as.numeric(as.character(buil@output$Obsyear)) - as.numeric(as.character(buil@output$Time))
		buil@marginal <- c(buil@marginal, TRUE)
		buil@output <- buil@output[buil@output$Age >= 0 , ]
		
		# Note that if stockBuildings and changeBuildings have different marginals (typically policies),
		# there will be NA in these indices. This will be corrected below.
		for(i in colnames(buil@output)[buil@marginal]) {
			if(any(is.na(buil@output[[i]]))) {
				buil@output <- fillna(buil@output, i)
				print(paste("Column", i, "treated with fillna (difference between stockBuildings and changeBuildings)."))
			}
		}
		
		# heatTypeConversion dependent on buil, which defined above, and hence must be handled here. 
		# Scope is messed up due to the dependency and the following produces error when run within EvalOutput of buildings
		#objects.latest("Op_en7115", code_name = "heatTypeConversion")
		#heatTypeConversion <- EvalOutput(heatTypeConversion)
		heatTypeConversion <- function(){
			dat <- opbase.data("Op_en7115", subset = "Yearly_heating_converted_factor")
			colnames(dat)[colnames(dat) == "Time"] <- "Obsyear"
			
			dat$Obs <- NULL
			
			out <- data.frame()
			temp <- unique(dat[c("Heating_from", "Heating_to")])
			for (i in 1:nrow(temp)) {
				onetype <- merge(temp[i,], dat)
				tempout <- merge(obstime@output, onetype, all.x = TRUE)[c("Obsyear","Result")]
				tempout <- merge(tempout, temp[i,])
				
				for (j in (1:nrow(tempout))[is.na(tempout$Result)]) {
					a <- onetype$Obsyear[which.min(abs(as.numeric(as.character(onetype$Obsyear)) - as.numeric(as.character(obstime$Obsyear[j]))))]
					tempout$Result[j] <- onetype$Result[a]
				}
				out <- rbind(out, tempout)
			}
			
			out <- Ovariable(output = out, marginal = colnames(out) != "Result")
			
			colnames(out@output)[colnames(out@output) == "Heating_from"] <- "Heating"
			
			out <- buil * out
			
			out1 <- out
			out1$Result <- - out1$Result
			out1$Heating_to <- NULL
			
			out$Heating <- out$Heating_to
			out$Heating_to <- NULL
			
			out@output <- rbind(out1@output, out@output)
			heatTypeConversion <- out
			return(out)
		}
		buil <- combine(buil, heatTypeConversion())
		
		temp1 <- merge(renovationRate, unique(buil@output["Age"])) # Avoid redundant calculations
		temp1@name <- renovationRate@name
		temp2 <- renovationShares
		temp2@output <- temp2@output[temp2@output$Renovation == "None" , ]
		renovate <- (1 - temp1) * (1 - temp2) # Assumes that data has row for Renovation: None = 0
		renovate <- combine(renovate, temp1 * renovationShares)
			
		out <- data.frame()
		prevreno <- unkeep(buil * renovate * 0, sources = TRUE) # Previously renovated buildings for the first time point
		prevreno@output <- prevreno@output[prevreno@output$Renovation != "None" , ][1,] # Just take one renovated example row
		marginals <- colnames(prevreno@output)[prevreno@marginal]
		demolitionRate <- unkeep(demolitionRate, sources = TRUE) # Would otherwise cause trouble in rbind.
			
		for(i in obstime@output$Obsyear) { # Accumulate the building stock
			# Take the building stock
			temp <- buil
			temp@output <- temp@output[temp@output$Obsyear == i , ] # Take buildings of year i
			prevreno@output$Obsyear <- i # update the observation year of the previous renovation

			# Remove from the stock buildings that are demolished
			temp <- temp * (1 - demolitionRate)

			# Subtrack from the building stock buildings that are already renovated.
			temp <- combine(temp, -1 * oapply(prevreno, cols = "Renovation", FUN = sum)) # Subtract previously renovated
			reno <- unkeep(temp * renovate, sources = TRUE) # Renovate the current non-renovated stock
			# If renovate does not match with this timepoint, mark all buildings here as unrenovated.
			# Is there new renovation in this time point?
			if(sum(result(reno)) == 0) {
				reno <- temp * Ovariable(
					output = data.frame(Renovation = "None", Result = 1), 
					marginal = c(TRUE, FALSE)
				)
			}
			newreno <- combine(prevreno, reno) # Renovated buildings in this time point.
			# Take the previous timepoints, and previously renovated and now possibly renovated together.
			out <- rbind(newreno@output, out) # Add previously and now renovated together
			prevreno <- unkeep(newreno, sources = TRUE)
			prevreno@output <- prevreno@output[prevreno@output$Renovation != "None" , ]
		}
		out <- Ovariable(output = out, marginal = colnames(out) %in% marginals)
		
		# Note that if buil and renovate have different marginals (typically policies),
		# there will be NA in these indices. This will be corrected below.
		for(i in colnames(out@output)[out@marginal]) {
			if(any(is.na(out@output[[i]]))) {
				out@output <- fillna(out@output, i)
				print(paste("Column", i, "treated with fillna (difference between buil and renovate)."))
			}
		}
		
		out <- oapply(unkeep(out, sources = TRUE), cols = c("Age", "Time"), FUN = sum)
		colnames(out@output)[colnames(out@output) == "Obsyear"] <- "Time" # From now on, Time means the time of observation
		out@output$Time <- as.numeric(as.character(out@output$Time))
		
		return(out)
	}
)

objects.store(buildings)

cat("Saved ovariable buildings\n")