Fine intercept of stress strain curve with 0.2% yield line - r

I am wanting to find the point of intercept between my Stress-Strain curve from a tensile test and the 0.2% offset line.
I am using plot() and lines() to graph this curve and line. The Stress-Strain curve is imported from a csv that contains the raw test data for stress (y axis) and strain (x axis). Below is the code snippet
TH_1_frame <- data.frame(TH_1_Strain, TH_1_Stress) # the x and y data for stress strain curve
Offset <- 0.002
TH_1_Stress02 <- TH_1_Mod*1000*(TH_1_Strain - Offset) # TH_1_Mod is the elastic modulus and the gradient of the straight line
TH_1_Strain02 <- TH_1_Strain + Offset
TH_1_02frame <- data.frame(TH_1_Strain02, TH_1_Stress02) # the x and y for the 0.2% offset line
plot(TH_1_Strain, TH_1_Stress)
lines(TH_1_Strain02, TH_1_Stress02) # plotting the curve and line
Attached is the output of the plot, I am unsure how I would go about mathematically finding the intercept seen in this plot.
Thanks
Tried my best to find the data around this intercept. Can attach the csv if anyone would like.
dput( TH_1_Strain[9450:9500])
c(0.01567022254, 0.01566837231, 0.01566786692, 0.0156739677,
0.01566912234, 0.01566456631, 0.01567340766, 0.01567904775, 0.01568320269,
0.0156837975, 0.01568157723, 0.01568231732, 0.0156824626, 0.01568279291,
0.01568822314, 0.01569599782, 0.01569751774, 0.01569260284, 0.01569438353,
0.01569401845, 0.01569528257, 0.01570160811, 0.01570275302, 0.01571064318,
0.01570881406, 0.01570606853, 0.01571034392, 0.01570852846, 0.01571317886,
0.01572433362, 0.01572758953, 0.01572479432, 0.01569923262, 0.01569651316,
0.01570669313, 0.01571742942, 0.01573171467, 0.01576093584, 0.01573084916,
0.01569425811, 0.01570926358, 0.01572924977, 0.01574603468, 0.01575124015,
0.01574295014, 0.0157436803, 0.0157436803, 0.01571707924, 0.01571890339,
0.01574868957, 0.01576487596)
>
> dput( TH_1_Stress[9450:9500])
c(785.800149043174, 785.821152259166, 785.839877152789, 785.856608787737,
785.871061735784, 785.884019739826, 785.896123281846, 785.908297907524,
785.918265659023, 785.930013418222, 785.937987546514, 785.943825519753,
785.953650739404, 785.966252960625, 785.976007096618, 785.989748114491,
786.001709124664, 786.012175190831, 786.021431012156, 786.030045986964,
786.039230360099, 786.050835587451, 786.059236946754, 786.065715766509,
786.072479649959, 786.076110749018, 786.079812931735, 786.083230415289,
786.085793436822, 786.087502360865, 786.087573444522, 786.084084877311,
786.080524861909, 786.079955463583, 786.078673770551, 786.079172085219,
786.078673770551, 786.078104372224, 786.075469902502, 786.07333411198,
786.072408566301, 786.075968217171, 786.081165708425, 786.085508737659,
786.09042152975, 786.091204543582, 786.09440841163, 786.099392287379,
786.112350291421, 786.12367081961, 786.138550998668)

Related

Plot Lines instead of points in scatterplot

I want to replace the points in my graph with a line like in the first picture, the second picture is what I have.
but its not quite what im looking for, I want a smooth line without the points
I think I have to use predict for the 1/x curve but I am not sure how,
Assuming f(1/x) fits the data well. One can use the lm() function to fix the desired function y= a/x + b and then use the predict() function to estimate the desired points.
If a more complicated nonlinear function is required to fit the data then the nls() maybe required
x<- c(176.01685819061, 21.6704613594849, 19.007554742708, 50.1865574864131, 17.6174002411188, 40.2758022496774, 11.0963214407251, 1249.94375253114, 694.894678288085, 339.786950220117, 42.1452961176151, 220.352895161601, 19.6303352674776, 9.10350287678884, 10.6222946396451, 44.1984352318898, 21.8069112975004, 42.1237630342764, 22.7551891190248, 12.9587850506626, 12.0207189111152, 20.2704921282476, 13.3441156357956, 9.13092569988769, 1781.08346869568, 71.2690023512206, 80.2376892286713, 344.114362037227, 208.830841645638, 91.1778810401913, 2220.0120768657, 41.4820962277111, 16.5730025748281, 32.30173229022, 108.703930214512, 51.6770035143256, 709.071405759588, 87.9618878732223, 10.4198968123037, 34.4951840238729, 57.8603720445067, 72.3289197551429, 30.2366643066749, 23.8696161364716, 270.014690419247, 13.8170113452005, 39.5159584479013, 27.764841260433, 18.0311836472615, 40.5709477295999, 33.1888820958952, 9.03112843931787, 4.63738971549635, 12.7591169313099, 4.7998894219979, 8.93458248803248, 7.33904760386628, 12.0940344070925, 7.17364602165948, 6.514191844409, 9.69911157978057, 6.57874454980745, 7.90556524435596)
y<- c(0.02840637, 0.230728821, 0.2630533, 0.099628272, 0.28381032, 0.12414402, 0.45059978, 0.00400018, 0.00719533500000001, 0.014715103086687, 0.118637201789886, 0.022690875, 0.254707825, 0.54923913, 0.470708088, 0.113126176837872, 0.22928510745, 0.118697847481752, 0.219730100850697, 0.38583864, 0.4159485, 0.24666396693114, 0.374696992776912, 0.547589605297248, 0.00280728, 0.070156727820596, 0.062314855376136, 0.01453005323695, 0.02394282358199, 0.0548378613646, 0.00225224, 0.120533928, 0.301695482, 0.15479046, 0.045996497, 0.096754836, 0.00705147600000001, 0.0568428, 0.47985120103071, 0.14494777, 0.08641493, 0.069128642, 0.165362156, 0.20947132, 0.018517511, 0.36187275779699, 0.126531158458224, 0.180083867690804, 0.277297380904852, 0.1232408972382, 0.15065285976048, 0.55364067, 1.07819275643191, 0.39187665, 1.04169066418176, 0.55962324, 0.68128731, 0.41342697, 0.69699564, 0.76755492, 0.515511133042674, 0.760023430328564, 0.632465844687028)
#data frame for prediction
df <- data.frame(x=sort(x))
# fit model y= a/x + b
model <-lm( y ~ I(1/x))
#summary(model)
#plot model
plot(df$x, predict(model, df), type="l", col="blue")
#optional
points(x, y)
Update - response to comments
x is sorted in the data frame, so that points are plotted in order. If not the line could go from x=1 to x=100, back to x=10 etc. thus making a mess. Try removing the sort and see what happens.
The I(1/x) term is to signal lm to perform the inverse transform on x first and then perform the least squares regression.
The predict() function is on the axis since that is the variable used in the plot function. To change this just assign the output from the predict function to a better variable name and plot that. Or use the "ylab= " option.
For smoothing, you can fit a linear model as foolws:
m <- lm(AM_cost_resorb~I(1/AM_leafP), data=data)
Then extract the predictied values on a new data set that covers the range of the exposure variable.
newx <- seq(min(data$AM_leafP), max(data$AM_leafP), by=0.01)
pr <- predict(m, newdata=data.frame(AM_leafP=newx))
And visualize:
plot(AM_cost_resorb~AM_leafP, data=data, type="p", pch= 15, col="red",ylab="Cost of reabsorbtion (kg C m^-2 yr^-1)", xlab="leaf P before senescence (g P/m2)", ylim=c(0,500), las=1)
lines(newx, y=pr, col="blue", lwd=2)
Data:
data <- structure(list(AM_cost_resorb = c(176.01685819061, 21.6704613594849,
19.007554742708, 50.1865574864131, 17.6174002411188, 40.2758022496774,
11.0963214407251, 1249.94375253114, 694.894678288085, 339.786950220117,
42.1452961176151, 220.352895161601, 19.6303352674776, 9.10350287678884,
10.6222946396451, 44.1984352318898, 21.8069112975004, 42.1237630342764,
22.7551891190248, 12.9587850506626, 12.0207189111152, 20.2704921282476,
13.3441156357956, 9.13092569988769, 1781.08346869568, 71.2690023512206,
80.2376892286713, 344.114362037227, 208.830841645638, 91.1778810401913,
2220.0120768657, 41.4820962277111, 16.5730025748281, 32.30173229022,
108.703930214512, 51.6770035143256, 709.071405759588, 87.9618878732223,
10.4198968123037, 34.4951840238729, 57.8603720445067, 72.3289197551429,
30.2366643066749, 23.8696161364716, 270.014690419247, 13.8170113452005,
39.5159584479013, 27.764841260433, 18.0311836472615, 40.5709477295999,
33.1888820958952, 9.03112843931787, 4.63738971549635, 12.7591169313099,
4.7998894219979, 8.93458248803248, 7.33904760386628, 12.0940344070925,
7.17364602165948, 6.514191844409, 9.69911157978057, 6.57874454980745,
7.90556524435596), AM_leafP = c(0.02840637, 0.230728821, 0.2630533,
0.099628272, 0.28381032, 0.12414402, 0.45059978, 0.00400018,
0.00719533500000001, 0.014715103086687, 0.118637201789886, 0.022690875,
0.254707825, 0.54923913, 0.470708088, 0.113126176837872, 0.22928510745,
0.118697847481752, 0.219730100850697, 0.38583864, 0.4159485,
0.24666396693114, 0.374696992776912, 0.547589605297248, 0.00280728,
0.070156727820596, 0.062314855376136, 0.01453005323695, 0.02394282358199,
0.0548378613646, 0.00225224, 0.120533928, 0.301695482, 0.15479046,
0.045996497, 0.096754836, 0.00705147600000001, 0.0568428, 0.47985120103071,
0.14494777, 0.08641493, 0.069128642, 0.165362156, 0.20947132,
0.018517511, 0.36187275779699, 0.126531158458224, 0.180083867690804,
0.277297380904852, 0.1232408972382, 0.15065285976048, 0.55364067,
1.07819275643191, 0.39187665, 1.04169066418176, 0.55962324, 0.68128731,
0.41342697, 0.69699564, 0.76755492, 0.515511133042674, 0.760023430328564,
0.632465844687028)), class = "data.frame", row.names = c(NA,
-63L))

How to generate an ordination plot from a distance matrix in R

Here I have another 'graphical' problem:
I have obtained from MOTHUR the following distance matrix (coming from a weighted unifrac analysis):
20
F3D0
F3D1 0.222664
F3D141 0.157368 0.293308
F3D142 0.180278 0.319198 0.0944511
F3D143 0.157659 0.290975 0.0545202 0.0761392
F3D144 0.199909 0.34045 0.104358 0.086418 0.089473
F3D145 0.207946 0.348532 0.107841 0.076302 0.0940067 0.051632
F3D146 0.117877 0.253996 0.0891617 0.130867 0.0882064 0.134407 0.138415
F3D147 0.197256 0.336583 0.102114 0.0764106 0.0890669 0.0514887 0.0479297 0.135324
F3D148 0.173824 0.311951 0.0606815 0.0648557 0.056463 0.074914 0.0811015 0.111996 0.0709027
F3D149 0.145614 0.276632 0.0462779 0.105512 0.0628737 0.10902 0.114584 0.0739466 0.107123 0.0690412
F3D150 0.129557 0.277624 0.0840909 0.128305 0.0863231 0.140256 0.145381 0.0744572 0.13672 0.113564 0.0659831
F3D2 0.133531 0.216587 0.160832 0.186833 0.176061 0.214934 0.215261 0.152591 0.205629 0.188325 0.156313 0.153841
F3D3 0.213102 0.305651 0.123818 0.113021 0.139376 0.148558 0.13853 0.174377 0.139851 0.126329 0.131294 0.166738 0.137784
F3D5 0.128668 0.185235 0.167733 0.205183 0.176585 0.224806 0.230984 0.14497 0.223492 0.18933 0.153624 0.148617 0.127574 0.192433
F3D6 0.139411 0.236633 0.135418 0.124848 0.134198 0.175098 0.166205 0.118905 0.166144 0.151842 0.120964 0.12724 0.0950943 0.119852 0.129523
F3D7 0.198884 0.315888 0.130385 0.0989168 0.131945 0.14625 0.126203 0.173689 0.128993 0.121373 0.140199 0.152123 0.152893 0.0906675 0.186674 0.111134
F3D8 0.178656 0.18783 0.205737 0.22104 0.219858 0.268701 0.2644 0.184943 0.268051 0.229503 0.1979 0.20035 0.164427 0.203089 0.119084 0.142398 0.185551
F3D9 0.153265 0.186706 0.196143 0.21504 0.20728 0.262127 0.255558 0.174563 0.2607 0.221969 0.192437 0.185154 0.13976 0.195538 0.0973901 0.127619 0.177605 0.0558726
Mock 0.653789 0.645344 0.633297 0.623553 0.633903 0.633135 0.63394 0.635815 0.645332 0.636453 0.629143 0.646918 0.663222 0.639517 0.649722 0.64073 0.654882 0.63988 0.646155
As this distance matrix come from a PCoA, what I want to do is to plot these distances in an ordination plot with R.
Any idea on how to doing this?
Thanks a lot
You have the vegan library with metaMDS function that generates coordinates for each sample using such a distance matrix as the input.
Let's call M to your matrix, you need to run this code:
# Load the library
library(vegan)
# Use metaMDS function for 2D - plot
NMDS <- metaMDS(distance = M, k = 2)
# Plot your individuals
plot(NMDS$points[,1], NMDS$points[,2])
In NMDS$points you have the coordinates for each of the samples. I suggest to colour the individuals according to a factor of interest such as cases and controls for example in biomedical analyses.
Thanks to #R18, finally I could manage with this issue.
For the distance table I uploaded, the solution that I reached was to use the following code:
library(phyloseq)
library(vegan)
M <- import_mothur_dist("pcoa_UFdistance_matrix.dist")
unifrac <- metaMDS(M, distance = M, k = 2, trymax=100)
plot(unifrac$points[,1], unifrac$points[,2], main="Principal Coordinates Analysis", col.main="red", font.main=4, xlab="PCoA 1", ylab="PCoA 2")
text(unifrac, pos=3)
Hope it will help someone!!

L2 distance between functional data (smoothed curves)

I have used smoothing to create two "functions" fd4 and fd6.
fit6 <- smooth.basis(tid6, zbegfor, fdParobj2)
fd6 <- fit6$fd
I want to measure the L2 distance between them on the interval [0,1], but I haven't been able to find an appropriate way.
||f − g||_2 = sqrt(int(|f(x)-g(x)|^2,0,1))
The best bet has been this one: How to calculate functional L_2 norm using R, but when I use fd6 instead of f <- function(x) x^2, I get the following message:
"Error in fac - fdmat : non-conformable arrays".
I've spent hours trying to find a solution. Please help me!
Now with reproducible code:
library(fda)
# Smoothing of movement pattern without obstacle rescaled to the interval [0,1]
without <- c(22.5050173512478, 22.5038665040295, 22.5171851824298, 22.5368096190746,
22.5770229184757, 22.6709727229898, 22.8195669635573, 23.0285400460222,
23.3240853426905, 23.6895323912605, 24.0905709304813, 24.5674870961964,
25.129085512519, 25.7433521858875, 26.4096817521118, 27.1338935155912,
27.906416101033, 28.7207273157549, 29.5431756517467, 30.3697951466496,
31.2214907341765, 32.0625307132683, 32.8786845916855, 33.671550678219,
34.4449992914392, 35.1852293010227, 35.8866367048324, 36.5650863548079,
37.1776116180247, 37.7706354957587, 38.3082855431959, 38.8044130844639,
39.2471137254193, 39.6193031585418, 39.9685683244076, 40.2345560551869,
40.4394442661545, 40.5712407258558, 40.6905311089523, 40.712419802203,
40.6704560575084, 40.5583379372846, 40.3965425630546, 40.1443139907057,
39.8421899334408, 39.4671160834355, 39.018733225651, 38.5381390971577,
38.035680135599, 37.4625783280288, 36.8649362406917, 36.2320264206665,
35.5599736527209, 34.8983871226943, 34.2058073957721, 33.4893682831911,
32.7568501019309, 32.0241649500974, 31.3036406455137, 30.587636320768,
29.8962657607091, 29.2297665999702, 28.6003939337949, 28.0003531206639,
27.433551463149, 26.9088532545635, 26.4265682839796, 25.974193299003,
25.5553146923473, 25.1701249455904, 24.8107813804098, 24.4776168601955,
24.167582682288, 23.8726502760669, 23.589703789663, 23.3222235336882,
23.0616248799115, 22.8185342685607, 22.6767541125512, 22.6567795841271,
22.6488510112824, 22.6436058079441, 22.6391304188382)
timewithout <- (1:length(without))/length(without) # For scaling
splineBasis = create.bspline.basis(c(0,1), nbasis=25, norder=6) # The basis for smoothing
basis = fdPar(fdobj=splineBasis, Lfdobj=2, lambda=0.00001)
fitwithout <- smooth.basis(timewithout, without, basis) # Smoothing
fdwithout <- fitwithout$fd
# Same but movement is over an obstacle
with <- c(22.4731637093167, 22.4655561889073, 22.4853719755102, 22.4989400065304,
22.5495656349031, 22.666945409755, 22.8368941117498, 23.0846080078369,
23.4160560011242, 23.8285634914224, 24.2923085321078, 24.8297004047422,
25.4884540279408, 26.2107053559, 27.0614232848574, 27.9078055119721,
28.8449720096674, 29.8989669834473, 30.996962022701, 32.1343108758062,
33.3286403418359, 34.6364870430171, 35.9105342483246, 37.1883582665643,
38.467212668323, 39.7381525466373, 41.0395064969214, 42.3095531191294,
43.5708069740233, 44.7881178787717, 45.9965529977777, 47.1643807808923,
48.284786275036, 49.3593991064962, 50.3863035442644, 51.3535489662494,
52.2739716491521, 53.1338828493223, 53.9521101656512, 54.7037562884229,
55.3593092084143, 55.9567618011946, 56.4768579145271, 56.9251919073806,
57.2971965985674, 57.5937987523734, 57.8158626068961, 57.9554856023804,
58.009777126789, 57.9863251605612, 57.8932199088797, 57.6988126618694,
57.4350394069443, 57.1112025796509, 56.7580579506751, 56.2680669960935,
55.6963799946038, 55.0574070566765, 54.3592140352073, 53.6072275005723,
52.7876353306759, 51.9172334605074, 50.9879178368431, 49.9953932631072,
48.9460707853802, 47.8511977258834, 46.6827266395278, 45.4635999409637,
44.2633368255294, 43.0386729762103, 41.7880095105045, 40.4834298069985,
39.1610223705633, 37.9241872458281, 36.7158342529737, 35.5408830466013,
34.4070964101159, 33.307156473109, 32.2514661493348, 31.2475129673168,
30.2990631096187, 29.4096423238141, 28.590173995037, 27.8437368908309,
27.17493959411, 26.5779670740351, 26.0377946174036, 25.5731202027558,
25.1761397934058, 24.8319659155494, 24.5479180062239, 24.2940808334792,
24.09388897537, 23.934861348149, 23.7999923744404, 23.6877461628934,
23.5982309560843, 23.5207597985246, 23.4354446383638, 23.3604065265148,
23.2819126915765, 23.1725048152396, 23.0637455648184, 22.9426779696074,
22.8079176617495, 22.69360227086, 22.6622165457034, 22.6671302753094,
22.66828206305, 22.6703162730529, 22.6715781657376)
timewith <- (1:length(with))/length(with)
fitwith <- smooth.basis(timewith, with, basis) # Smoothing
fdwith <- fitwith$fd
# Plots for understanding
plot(fdwith, col=2) # Smoothed curve for movement over obstacle
plot(fdwithout, col=2, add = TRUE) # Same but no obstacle
# I have to find the L2-distance between these curves
First, one can take advantage of the possibility to perform arithmetic operations with fd objects: fdwith - fdwithout. Second, maybe there is a better way to extract values from fd objects at specific points, but this also works: predict(newdata = 0.5, fdwith - fdwithout). So,
sqrt(integrate(function(x) predict(newdata = x, fdwith-fdwithout)^2, lower = 0, upper = 1)$val)
# [1] 9.592434

Plot high-dimensional kernel density in R

I have a question regarding kernel density estimation in R. I have a 5-dimensional data, which consists of (x,y,z) locations, time of happening and size of some events (for example earthquake) (I've attached the dataset). I wrote the following code in R in order to find the 5D kernel density estimation:
library(ks)
library(rgl)
kern <- read.table(file.choose(), sep=",")
evpts <- do.call(expand.grid,lapply(kern,quantile, prob=c(.1,.15,.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7,.75,.8,.85,.9,.95)))
hat <- kde(kern, eval.points= evpts)
str(hat)
Now, I'd like to visualize the kernel density estimation. I prefer to show the kernel regarding all 5 dimensions in one plot (by using different colors or sizes for points) or at least regarding three dimensions separately. Do you have any suggestion for me?
Here is the data:
x y z time size
422.697323 164.19886 2.457419 8.083796636 0.83367586
423.008236 163.32434 0.5551326 37.58477455 0.893893903
204.733908 218.36365 1.9397874 37.88324312 0.912809449
203.963056 218.4808 0.3723791 43.21775903 0.926406005
100.727581 46.60876 1.4022341 49.41510519 0.782807523
453.335182 244.25521 1.6292517 51.73779175 0.903910803
134.909462 210.96333 2.2389119 53.13433521 0.896529401
135.300562 212.02055 0.6739541 67.55073745 0.748783521
258.237117 134.29735 2.1205291 76.34032587 0.735699304
341.305271 149.26953 3.718958 94.33975483 0.849509216
307.138925 59.60571 0.6311074 106.9636715 0.987923188
307.76875 58.91453 2.6496741 113.8515307 0.802115718
415.025535 217.17398 1.7155688 115.7464603 0.875580325
414.977687 216.73327 1.7107369 115.9776948 0.767143582
311.006135 173.24378 2.7819572 120.8079566 0.925380118
310.116929 174.28122 4.3318722 129.2648401 0.776528535
347.260911 37.34946 3.5155427 136.7851291 0.851787115
351.317624 33.65703 0.5806926 138.7349284 0.909723017
4.471892 59.42068 1.4062959 139.0543783 0.967270976
5.480223 59.72857 2.7326106 139.2114277 0.987787428
199.513023 21.53302 2.5163259 143.5895625 0.864164659
198.718031 23.50163 0.4801849 147.2280466 0.741587333
26.650517 35.2019 0.8246514 150.4876506 0.744788202
25.089379 90.47825 0.8700944 152.1944046 0.777252476
26.307439 88.41552 2.4422487 155.9090026 0.952215177
234.282901 236.11422 1.8115261 155.9658144 0.776284654
235.052948 236.77437 1.9644963 156.6900297 0.944285448
23.048202 98.6261 3.4573048 159.7700912 0.773057491
21.516695 98.05431 2.5029284 160.8202997 0.978779087
213.936324 151.87013 3.1042192 161.0612489 0.80499513
277.887935 197.25753 1.3659279 163.673142 0.758978575
277.239746 197.54001 2.2109361 166.2629868 0.775325157
This splits 'size' into 4 color classes based on their time quartile and 4 line type classes based on their 'time' quartile. It doesn't use the kernel density information:
require(MASS)
png();parcoord(dat, col=cut(dat$size, quantile(dat$size, c(0,.25,.5,.75,1)), include.lowest=TRUE), lty= as.numeric(cut(dat$time, quantile(dat$time, c(0,.25,.5,.75,1)), include.lowest=TRUE))); dev.off()

Fitting polynomial results in multiple straight lines on plot in R

I'm trying to plot a polynomial line to my data, however the plot results in multiple diagonal lines instead of one single curved line.
I've managed to correctly produce a polynomial using a fake dataset, but when I use this subset of my data (below) and attached code, I get multiple straight lines through the data. I have also tried fit2 = lm(y ~ I(x^2) + x) as a variant with no luck.
Any help is greatly appreciated.
x<-c(102.397, 101.863, 101.22, 101.426, 100.718, 100.665, 100.616,
100.844, 100.567, 100.864, 100.779, 101.002, 101.465, 102.291,
101.711, 101.208, 101.252, 100.781, 100.631, 100.87, 100.552,
100.762, 100.62, 101.044, 100.956, 101.3, 102.065, 101.581, 101.136,
101.122, 100.773, 100.55, 100.897, 100.747, 100.738, 100.585,
100.697, 100.487, 100.726, 100.706, 100.809, 101.208, 101.752,
101.498, 101.153, 101.035, 101.076, 100.544, 100.779, 100.792,
100.601, 100.454, 100.682, 100.687, 100.49, 100.552, 100.886,
100.936, 101.288, 101.284, 101.115, 101.026, 101.08, 100.777,
100.637, 100.846, 100.782, 100.492, 100.72, 100.73, 100.598,
100.261, 100.366, 100.563, 100.841)
y<- c(14.32613169, 13.72501806, 21.95599022, 16.48122392, 31.82829181,
49.09958776, 34.80769231, 29.69148033, 37.67365199, 12.75652985,
19.48755851, 15.2639087, 11.97119712, 15.69222982, 14.40972222,
20.2803527, 18.36173722, 32.52930568, 57.40697943, 33.18696557,
43.16302735, 34.08973698, 26.78616511, 16.15409518, 21.05716748,
15.06352087, 16.6404671, 18.29689298, 21.19666048, 15.7168413,
25.05327966, 59.63324601, 26.08805031, 28.93116956, 49.86901643,
49.25615364, 37.8384913, 47.14684757, 29.71848225, 20.51349921,
17.08812261, 22.06913828, 13.41404358, 19.45597049, 20.21563342,
20.82317899, 19.16648094, 54.67094703, 31.24128312, 35.30612245,
52.52072597, 34.42824882, 29.47282163, 28.90414317, 43.49371889,
21.28460091, 17.10587147, 21.67644184, 18.17082023, 16.62439474,
22.60932244, 23.04822808, 18.02791803, 33.44095941, 50.23319083,
28.65369341, 28.86940033, 32.6568959, 18.89804325, 14.54496931,
14.80571684, 43.49477683, 24.98729029, 19.12702305, 14.72747497)
plot(x,y)
fit<-lm(y ~ poly(x, 2))
lines(x, predict(fit), col = "red")
If you absolutely want to use the generic plotting functions in R, I've figured out the problem. Your x-values aren't in order, and lines simply plots things in order. To fix it, you have to order your x values:
Y<-predict(fit)
df<-data.frame(x,Y)
df2<-df[order(df$x),]
plot(x,y)
lines(df2$x,df2$Y,col="red")
You can do this nicely with a package called ggplot2:
install.packages("ggplot2")
library(ggplot2)
df<-data.frame(x,y)
ggplot(df,aes(x,y))+
geom_point()+geom_smooth(method = "lm", formula = y ~ poly(x, 2),colour="red")

Resources