Project: s41467-024-53046-2 | Function: fit_2nd_order_polynomial_3_pars (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Core function implementing 2nd order polynomial fitting for thermal performance curves with robust parameter estimation using multiple starting values and convergence controls.

**KEY TERMS:** {
  "a": "intercept parameter",
  "b": "linear temperature coefficient",
  "d": "quadratic temperature coefficient",
  "temp": "temperature variable",
  "trait_value": "performance trait measurement"
}

**CONTEXT CODE:** # This script provides functions for fitting the 83 TPC models.
#
# These functions need only a data frame as input, with columns of
# 'temp' (temperature) and 'trait_value'.

#############################################
# 2ND ORDER POLYNOMIAL MODEL (3 parameters) #
#                                           #
# Parameters: a, b, d                       #
#############################################
library(minpack.lm)

fit_2nd_order_polynomial_3_pars <- function(dataset)
{
  stop("Function implementation has been masked")
}

#############################################
# 3RD ORDER POLYNOMIAL MODEL (4 parameters) #
#                                           #
# Parameters: a, b, d, e                    #
#############################################
fit_3rd_order_polynomial_4_pars <- function(dataset)
{
	
	# Set the starting value of a to the minimum trait value.
	a_start <- min(dataset$trait_value)
	
	# Set the starting value of b arbitrarily to 0.1.
	b_start <- 0.1
	
	# Set the starting value of d arbitrarily to 0.003.
	d_start <- 0.003
	
	# Set the starting value of e arbitrarily to 0.0000002.
	e_start <- 0.0000002
	
	function_to_be_fitted <- function(a, b, d, e, temp)
	{
		return(
			log(
				a + b * temp + d * temp^2 + e * temp^3
			)
		)
	}
	
	fit <- NULL
	
	try(
		fit <- nls_multstart(
			log(trait_value) ~ function_to_be_fitted(
				a, b, d, e, temp = temp
			),
			data = dataset,
			iter = 1000,
			start_lower = c(
				a = 0.5 * a_start,	b = 0.5 * b_start,
				d = 0.5 * d_start,	e = 0.5 * e_start
			),
			start_upper = c(
				a = 1.5 * a_start,	b = 1.5 * b_start,
				d = 1.5 * d_start,	e = 1.5 * e_start
			),
			supp_errors = 'Y',
			convergence_count = FALSE,
			control = nls.lm.control(
				ftol = .Machine$double.eps, ptol = .Machine$double.eps, maxiter = 1024, 
				maxfev = 100000
			),
			lower = c(-Inf, -Inf, -Inf, -Inf),
			upper = c(Inf, Inf, Inf, Inf)
		)
	)
	
	return(fit)
}

#############################################
# 4TH ORDER POLYNOMIAL MODEL (5 parameters) #
#                                           #
# Parameters: a, b, d, e, f                 #
#############################################
fit_4th_order_polynomial_5_pars <- function(dataset)
{
	
	# Set the starting value of a to the minimum trait value.
	a_start <- min(dataset$trait_value)
	
	# Set the starting value of b arbitrarily to 0.1.
	b_start <- 0.1
	
	# Set the starting value of d arbitrarily to 0.003.
	d_start <- 0.003
	
	# Set the starting value of e arbitrarily to 0.0000002.
	e_start <- 0.0000002
	
	# Set the starting value of f arbitrarily to 0.0000000001.
	f_start <- 0.0000000001
	
	function_to_be_fitted <- function(a, b, d, e, f, temp)
	{
		result <- a + b * temp + d * temp^2 + e * temp^3 + f * temp^4
		
		if ( any(result <= 0 ) )
		{
			return(rep(1e10, length(temp)))
		} else
		{
			return(log(result))
		}
	}


Complete the function implementation replacing "stop("Not implemented")".