আর এর এনএলএস ব্যবহার করে পয়েন্ট বিশ্লেষণ পরিবর্তন করুন ()

Question

আমি "চেঞ্জ পয়েন্ট" বিশ্লেষণ, বা nls()আর এর সাহায্যে একটি মাল্টিপেজ রিগ্রেশন বাস্তবায়নের চেষ্টা করছি

এখানে আমি তৈরি কিছু জাল তথ্য । ডেটা ফিট করার জন্য আমি যে সূত্রটি ব্যবহার করতে চাই তা হ'ল:

$y = \beta_0 + \beta_1x + \beta_2\max(0,x-\delta)$

এটি যা করণীয় তা হ'ল একটি নির্দিষ্ট ইন্টারসেপ্ট এবং opeাল ( এবং β 1 ) দিয়ে একটি নির্দিষ্ট বিন্দু পর্যন্ত ডেটা ফিট করে , তারপরে, একটি নির্দিষ্ট এক্স মান ( δ ) পরে, ope ালকে β 2 দ্বারা বাড়িয়ে তোলা হয় । পুরো ম্যাক্স জিনিসটি এটাই। Δ পয়েন্টের আগে এটি 0 এর সমান হবে এবং β 2 শূন্য হবে।$\beta_0$$\beta_1$$\delta$$\beta_2$$\delta$$\beta_2$

সুতরাং, এখানে এটি করার জন্য আমার ফাংশনটি এখানে:

changePoint <- function(x, b0, slope1, slope2, delta){ 
   b0 + (x*slope1) + (max(0, x-delta) * slope2)
}

এবং আমি মডেলটি এইভাবে ফিট করার চেষ্টা করি

nls(y ~ changePoint(x, b0, slope1, slope2, delta), 
    data = data, 
    start = c(b0 = 50, slope1 = 0, slope2 = 2, delta = 48))

আমি সেই সূচনা পরামিতিগুলি বেছে নিয়েছি, কারণ আমি জানি যে সেগুলি সূচনা পরামিতি, কারণ আমি ডেটা তৈরি করেছি।

তবে, আমি এই ত্রুটিটি পেয়েছি:

Error in nlsModel(formula, mf, start, wts) : 
  singular gradient matrix at initial parameter estimates

আমি কি দুর্ভাগ্যজনক ডেটা তৈরি করেছি? আমি প্রথমে আসল তথ্যগুলিতে এটি ফিট করার চেষ্টা করেছি এবং একই ত্রুটিটি পাচ্ছিলাম এবং আমি ঠিক বুঝতে পেরেছিলাম যে আমার প্রাথমিক প্রারম্ভিক প্যারামিটারগুলি যথেষ্ট ভাল নয়।

Answer 1

(প্রথম আমি ভেবেছিলাম এটা সত্য যে ফলে একটি সমস্যা হতে পারে maxভেক্টরকৃত করা হয় না, কিন্তু যে সত্য নয় এটা। নেই এটা changePoint কেন নিম্নলিখিত সংশোধন সহ কাজ ব্যাথা করুন:

changePoint <- function(x, b0, slope1, slope2, delta) { 
   b0 + (x*slope1) + (sapply(x-delta, function (t) max(0, t)) * slope2)
}

এই আর-সহায়তা মেইলিং তালিকা পোস্টে একটি উপায় বর্ণনা করে যার ফলে এই ত্রুটি হতে পারে: সূত্রের আরএইচগুলি ওভারপ্যারামিটারাইজড, যেমন দুটি পরামিতি পরিবর্তন করে ডেটাতে একই মান দেয়। আপনার মডেলের ক্ষেত্রে এটি কীভাবে সত্য তা আমি দেখতে পাচ্ছি না, তবে সম্ভবত এটি ঠিক।

যাই হোক না কেন, আপনি নিজের উদ্দেশ্যমূলক ফাংশন লিখতে এবং এটি হ্রাস করতে পারেন। নিম্নলিখিত ফাংশনটি ডেটা পয়েন্টগুলির জন্য স্কোয়ার ত্রুটি দেয় (x, y) এবং প্যারামিটারগুলির একটি নির্দিষ্ট মান (ফাংশনের অদ্ভুত যুক্তি কাঠামোটি কীভাবে optimকাজ করে তার জন্য অ্যাকাউন্টে ):

sqerror <- function (par, x, y) {
  sum((y - changePoint(x, par[1], par[2], par[3], par[4]))^2)
}

তারপরে আমরা বলি:

optim(par = c(50, 0, 2, 48), fn = sqerror, x = x, y = data)

এবং দেখো:

$par
[1] 54.53436800 -0.09283594  2.07356459 48.00000006

মনে রাখবেন যে আমার জাল ডেটা ( x <- 40:60; data <- changePoint(x, 50, 0, 2, 48) + rnorm(21, 0, 0.5)) এর জন্য আপনার দেওয়া প্রাথমিক প্যারামিটার মানগুলির উপর নির্ভর করে প্রচুর স্থানীয় ম্যাক্সিমা রয়েছে। আমি মনে করি আপনি যদি এটিকে গুরুত্ব সহকারে নিতে চান তবে আপনি এলোমেলো করে অনেকবার কল্পনা করে এলোমেলো প্রাথমিক প্যারামিটারগুলি দিয়ে ফলাফল বিতরণ পরীক্ষা করে দেখতে পারেন।

Comments

বিল ভেনিয়েবলের এই পোস্টটি এই ধরণের বিশ্লেষণের সাথে জড়িত বিষয়গুলি ভালভাবে ব্যাখ্যা করেছে।

— অ্যারন

আপনার প্রথম কোড স্নিপেটে সেই (কষ্টকর) সপ্পল কলের পরিবর্তে আপনি সর্বদা কেবল ব্যবহার করতে পারেন পিএমএক্স ।

— কার্ডিনাল

Answer 2

কেবল যুক্ত করতে চেয়েছিলেন যে আপনি এটি অন্যান্য অনেক প্যাকেজ সহ করতে পারেন। আপনি যদি পরিবর্তন পয়েন্টের আশেপাশের অনিশ্চয়তার অনুমান পেতে চান (এনএলএস কিছু করতে পারে না), mcpপ্যাকেজটি ব্যবহার করে দেখুন।

# Simulate the data
df = data.frame(x = 1:100)
df$y = c(rnorm(20, 50, 5), rnorm(80, 50 + 1.5*(df$x[21:100] - 20), 5))

# Fit the model
model = list(
  y ~ 1,  # Intercept
  ~ 0 + x  # Joined slope
)
library(mcp)
fit = mcp(model, df)

আসুন এটি একটি পূর্বাভাস ব্যবধান (সবুজ রেখা) দিয়ে প্লট করুন। নীল ঘনত্বটি পরিবর্তন বিন্দু অবস্থানের উত্তরোত্তর বিতরণ:

# Plot it
plot(fit, q_predict = T)

আপনি পৃথক প্যারামিটারগুলি আরও বিশদ ব্যবহার করে plot_pars(fit)এবং পরিদর্শন করতে পারেন summary(fit)।