Group Partner: Jack Eskeland

Equipment List:

Experiment Date: January 18, 2024 Report Date: January 23, 2024

Lab Objective

This lab was an introduction to using the CR1000X datalogger and keypad. Temperatures were measured using a thermocouple connected to a CR1000X datalogger. A keypad was used to record and display battery voltage, data logger panel temperature, and thermocouple temperature. The time response of the thermocouple was then calculated by recording the time it took for the sensor to cool after being warmed.

Intro to Keypad and Variables

The recorded battery voltage (BattV) was 13.47 V over the measurement time.

The recorded data logger panel temperature (PTemp_C) had a max of 25.8 C and a min of 26.59 C over the measurement time. The range was 0.21 C

The thermocouple temperature (Temp_C) had a maximum of 32.5 C and a minimum of 26.59 C, a temperature range of 5.91 C.

The thermocouple temperature (Temp_C) had the largest range because we were heating it up to body temperature and then letting it cool off to room temperature. The battery voltage had the smallest range because it was in a steady-state environment.

When the thermocouple was initally exposed to ambient air the thermocouple temperature (Temp_C) was 25.6 C, the logger panel temp (PTemp_C) was 25.8 C. After lightly holding the thermocouple, the thermocouple temperature reached a temperature of 29.6 C.

Recording Data

The initial thermocouple measurement was 32.3 C at 2024-01-18 15:21:00 MST. The final thermocouple measurement was 26.9 C at 2024-01-18 15:21:30 MST.

During this 30 second interval the following data was collected:

# recorded data
start_time <- ymd_hms("2024-01-18 15:21:00", tz = "MST")
probe <- c(32.3, 31.7, 30.9, 30.4, 30.0, 29.7, 29.4, 29.2, 29.0, 28.8, 
           28.7, 28.5, 28.3, 28.2, 28.1, 28.0, 27.9, 27.8, 27.7, 27.7, 
           27.6, 27.5, 27.4, 27.4, 27.3, 27.2, 27.2, 27.1, 27.0, 27.0, 26.9)

sample_time <- c()
temp_ratio <- c()
time_str <- c()
Ti <- max(probe)
Tf <- min(probe)
for(i in 1:31) {
  sample_time[i] <- start_time + i - 1
  temp_ratio[i] <- round((probe[i]-Tf) / (Ti-Tf), digits = 2)
  time_str[i] <- strftime(sample_time[i], tz = "MST")
}
lab1data <- data.frame(time_str, sample_time, probe, temp_ratio)

gt(data = lab1data)
time_str sample_time probe temp_ratio
2024-01-18 15:21:00 1705616460 32.3 1.00
2024-01-18 15:21:01 1705616461 31.7 0.89
2024-01-18 15:21:02 1705616462 30.9 0.74
2024-01-18 15:21:03 1705616463 30.4 0.65
2024-01-18 15:21:04 1705616464 30.0 0.57
2024-01-18 15:21:05 1705616465 29.7 0.52
2024-01-18 15:21:06 1705616466 29.4 0.46
2024-01-18 15:21:07 1705616467 29.2 0.43
2024-01-18 15:21:08 1705616468 29.0 0.39
2024-01-18 15:21:09 1705616469 28.8 0.35
2024-01-18 15:21:10 1705616470 28.7 0.33
2024-01-18 15:21:11 1705616471 28.5 0.30
2024-01-18 15:21:12 1705616472 28.3 0.26
2024-01-18 15:21:13 1705616473 28.2 0.24
2024-01-18 15:21:14 1705616474 28.1 0.22
2024-01-18 15:21:15 1705616475 28.0 0.20
2024-01-18 15:21:16 1705616476 27.9 0.19
2024-01-18 15:21:17 1705616477 27.8 0.17
2024-01-18 15:21:18 1705616478 27.7 0.15
2024-01-18 15:21:19 1705616479 27.7 0.15
2024-01-18 15:21:20 1705616480 27.6 0.13
2024-01-18 15:21:21 1705616481 27.5 0.11
2024-01-18 15:21:22 1705616482 27.4 0.09
2024-01-18 15:21:23 1705616483 27.4 0.09
2024-01-18 15:21:24 1705616484 27.3 0.07
2024-01-18 15:21:25 1705616485 27.2 0.06
2024-01-18 15:21:26 1705616486 27.2 0.06
2024-01-18 15:21:27 1705616487 27.1 0.04
2024-01-18 15:21:28 1705616488 27.0 0.02
2024-01-18 15:21:29 1705616489 27.0 0.02
2024-01-18 15:21:30 1705616490 26.9 0.00

Visualizing Data

Plotting the sampled data shows an exponential decay in temperature over time as seen in the following figure.

ggplot(data = lab1data, aes(x = second(sample_time), y = probe)) +
  geom_point() + xlab("Sample Time (s)") + 
  ylab(expression("Thermocouple Temperature  " ( degree*C))) + 
  ggtitle("Sampled Temperature Change") +
  theme_bw()

Taking the log of the temperature ratio results in the following figure.

ggplot(data = lab1data, 
       aes(x = second(sample_time), y = log(temp_ratio))) +
  geom_point() + xlab("Sample Time (s)") + 
  ylab("log[(T-Tf)/(Ti-Tf)]") +
  ggtitle("log(Temperature Ratio) of Sample to Calculate Thermocouple Response Time", 
          sprintf("Initital Temp (Ti = %.1f C), Final Temp (Tf = %.1f C)", 
                  Ti, Tf)) + 
  theme_bw()

The values for the log(temp ratio) are not linear during the first few seconds of the sample and also after about 20 seconds (as the temperature gets closer to ambient).

To better compute the thermocouple time response, I will take a subsection of the sampled data for sample times between 3 and 20 seconds. The time response is generally determined to be when the thermocouple has cooled to 63.2% of the initial temperature.

# find thermocouple time response by finding the slope of the log(temp_ratio) for 2-3 seconds to 15-20 seconds after temperature change
slope_sample <- subset(lab1data, 
                      (second(sample_time)>2) & (second(sample_time)<21))
slope_lm <- lm(log(slope_sample$temp_ratio) ~ second(slope_sample$sample_time))
B <- as.numeric(slope_lm$coefficients[1])
A <- as.numeric(slope_lm$coefficients[2])
invtau <- A*second(slope_sample$sample_time) + B
slope_sample$invtau <- invtau

tau1 <- (-1-B)/A

ggplot(data = slope_sample,
       aes(x = second(sample_time), 
                 y = log(temp_ratio))) + 
  geom_point() + 
  geom_line(y = invtau, col = "blue") +
  geom_hline(yintercept = -1, col = "red") +
  geom_vline(xintercept = tau1, col = "red") +
  xlab("Sample Time (s)") + 
  ylab("log[(T-Tf)/(Ti-Tf)]") +
  ggtitle("Subsection of Sampled Data", "3 to 20 seconds") +
  theme_bw() +
  annotate("text",
           label = sprintf("63.2%% temperature drop at time = %.1f seconds", tau1),
           color = "red",
           x = 18, y = -2.9) +
  xlim(0, 30) + ylim(-3, 0)

This is shown by the red lines on the above figure. The y-axis value is for log(0.382) = -1, which occurs at time = 8.7 seconds. This gives a time response of \(\tau\) = 8.7 seconds.

tau2 <- (-2-B)/(2*A)
  
ggplot(data = slope_sample,
       aes(x = second(sample_time), 
                 y = log(temp_ratio))) + 
  geom_point() + 
  geom_line(y = invtau, col = "blue") +
  geom_hline(yintercept = -2, col = "red") +
  geom_vline(xintercept = 2*tau2, col = "red") +
  xlab("Sample Time (s)") + 
  ylab("log[(T-Tf)/(Ti-Tf)]") +
  ggtitle("Subsection of Sampled Data", "3 to 20 seconds") +
  theme_bw() +
  annotate("text",
           label = sprintf("86.5%% temperature drop at time = %.1f seconds", 2*tau2),
           color = "red",
           x = 11, y = -2.8) +
  annotate("text",
           label = sprintf("tau = %.1f seconds", tau2),
           color = "red",
           x = 15.5, y = -3) +
  xlim(0, 30) + ylim(-3, 0)

Repeating the same method for t=2\(\tau\), a 86.5% temperature drop, results in a y-axis value of log(0.135) = -2 (shown in red in the following figure). This value is reached in 19.4 seconds, resulting in time response \(\tau\) = 9.7 seconds.

I then performed a linear regression to calculate a line of best fit through all the data points. The regression line in shown in blue.

tau3 <- -1/A
R2 <- summary(slope_lm)$r.squared

ggplot(data = slope_sample,
       aes(x = second(sample_time), 
                 y = log(temp_ratio))) + 
  geom_point() + 
  geom_line(y = invtau, col = "blue") +
  xlab("Sample Time (s)") + 
  ylab("log[(T-Tf)/(Ti-Tf)]") +
  ggtitle("Subsection of Sampled Data", "3 to 20 seconds") +
  theme_bw() +
  annotate("text",
           label = sprintf("Linear Regression, R^2 = %.4f", R2),
           x = 21, y = -1.1) +
  annotate("text", 
           label = sprintf("Calculated Slope = %.1f", A),
           x = 20, y = -1.3, 
           color = "blue") + 
  annotate("text",
           label = sprintf("Estimated tau = -1/slope = %.1f s", tau3),
           x = 21.5, y = -1.5) +
  xlim(0, 30) + ylim(-3, 0)

The slope of the line is inversely proportional to the thermocouple time response (\(\tau\) = -1/slope). Using this method the slope of the temperature ratio is -0.09 1/s, resulting in an estimated value for the thermocouple time response of \(\tau\) = 10.8 seconds.

The thermocouple response time varies from 8.7 seconds for 63.2% cooling, 9.7 seconds for 86.5% cooling, and 10.8 seconds using a linear regression. The estimates are all in the same ballpark (between 9 to 11 seconds). Eyeballing the sample data at 63.2% and 86.5% give similar time response values, thus validating the respective methods used. Which is best? I would go with the linear regression because it uses more of the data, The R-squared value was 0.9973, which indicates a very good fit.

Response Time: Heating vs. Cooling

The thermocouple response was faster for heating than cooling. After holding the thermocouple, it took 40 seconds for the sensor to reach a steady temperature at 35.1 C. When the thermocouple was released it took 1 min, 48 sec to return to ambient temperature.

Summary

Things that worked well: taking the measurements, using the keypad to find the recorded data.

Things that were a struggle: Making nice looking graphs in R (I know I made a stink about graphing by hand, and this was a great reminder that back-of-the-envelope-calculations are not necessarily bad).

Confidence level with CR1000X: On a scale of 0-10, 0.5. The interaction with the datalogger was very passive with the keypad being the only window into the data recording process.