একটি লজিস্টিক রিগ্রেশন থেকে ভবিষ্যদ্বাণী করা সম্ভাব্যতার জন্য আত্মবিশ্বাসের অন্তরকে প্লট করা


20

ঠিক আছে, আমার একটি লজিস্টিক রিগ্রেশন আছে এবং predict()আমার অনুমানের উপর ভিত্তি করে সম্ভাব্যতা বক্ররেখা বিকাশের জন্য ফাংশনটি ব্যবহার করেছি।

## LOGIT MODEL:
library(car)
mod1 = glm(factor(won) ~ as.numeric(bid), data=mydat, family=binomial(link="logit"))

## PROBABILITY CURVE:
all.x <- expand.grid(won=unique(won), bid=unique(bid))
y.hat.new <- predict(mod1, newdata=all.x, type="response")
plot(bid<-000:1000,predict(mod1,newdata=data.frame(bid<-c(000:1000)),type="response"), lwd=5, col="blue", type="l")

এটি দুর্দান্ত তবে আমি সম্ভাবনার জন্য আস্থার ব্যবধানের প্লট করা সম্পর্কে আগ্রহী। আমি চেষ্টা করেছি plot.ci()কিন্তু ভাগ্য হয়নি। অগ্রাধিকার carপ্যাকেজ বা বেস আর দিয়ে, কেউ এই কাজটি করার কিছু উপায় সম্পর্কে আমাকে ইঙ্গিত করতে পারে কি?


4
(+1) ভোটের জবাব বন্ধ করে দেওয়ার মতো বিষয় হিসাবে: স্পষ্টতই এই ভোটগুলির ভিত্তিটি হল যে প্রশ্নটি খাঁটি সফ্টওয়্যার সম্পর্কিত একটি প্রশ্ন জিজ্ঞাসা করে বলে মনে হচ্ছে ("কীভাবে এই জাতীয় পরিকল্পনা করা যায়"), একটি প্রশ্নটি যা সত্যই তাই উপস্থিত হওয়া উচিত। দ্রষ্টব্য, তবে, বর্তমান জবাবটিতে সমাহিত হ'ল প্লটিং পয়েন্টগুলি তৈরি করার পরিসংখ্যান সূত্র । এটি প্রস্তাব করে যে প্রশ্নটির পরিসংখ্যানগত আগ্রহ রয়েছে, তাই আমি স্থানান্তরের পক্ষে ভোট দিতে নারাজ। এখানে একটি ভাল উত্তর এই পরিসংখ্যানগত বিষয়টি হাইলাইট এবং ব্যাখ্যা করবে।
whuber

উত্তর:


26

আপনার ব্যবহৃত কোডটি glmফাংশনটি ব্যবহার করে একটি লজিস্টিক রিগ্রেশন মডেলটি অনুমান করে । আপনি ডেটা অন্তর্ভুক্ত করেননি, তাই আমি কিছুটা তৈরি করব।

set.seed(1234)
mydat <- data.frame(
    won=as.factor(sample(c(0, 1), 250, replace=TRUE)), 
    bid=runif(250, min=0, max=1000)
)
mod1 <- glm(won~bid, data=mydat, family=binomial(link="logit"))

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

logit(পি)=লগ(পি(1-পি))=β0+ +β1এক্স1

লগ করা প্রতিকূলতাকে সম্ভাব্যতায় রূপান্তর করতে আমরা উপরেরটি অনুবাদ করতে পারি

পি=মেপুঃ(β0+ +β1এক্স1)(1+ +মেপুঃ(β0+ +β1এক্স1))

প্লট সেট আপ করতে আপনি এই তথ্যটি ব্যবহার করতে পারেন। প্রথমত, আপনার পূর্বাভাসক চলকের একটি ব্যাপ্তি প্রয়োজন:

plotdat <- data.frame(bid=(0:1000))

তারপরে ব্যবহার করে predict, আপনি আপনার মডেলের উপর ভিত্তি করে পূর্বাভাস পেতে পারেন

preddat <- predict(mod1, newdata=plotdat, se.fit=TRUE)

নোট করুন যে লাগানো মানগুলি এর মাধ্যমেও পাওয়া যেতে পারে

mod1$fitted

নির্দিষ্ট করে se.fit=TRUE , আপনি প্রতিটি লাগানো মানের সাথে সম্পর্কিত মানক ত্রুটিটি পান। ফলস্বরূপ data.frameনিম্নলিখিত উপাদানগুলির সাথে একটি ম্যাট্রিক্স রয়েছে: লাগানো পূর্বাভাস ( fit), আনুমানিক স্ট্যান্ডার্ড ত্রুটিগুলি ( se.fit), এবং একটি স্কেলার প্রমিতের ত্রুটিগুলি গণনা করতে ব্যবহৃত বিস্তারের বর্গমূল প্রদান করে ( residual.scale)। একটি দ্বিপদ logit ক্ষেত্রে, মান হতে হবে 1 (আপনি লিখে দেখতে পারেন ব্যক্তিদের কোন preddat$residual.scaleমধ্যে R)। আপনি এখন পর্যন্ত যা গণনা করেছেন তার উদাহরণ দেখতে চাইলে আপনি টাইপ করতে পারেন head(data.frame(preddat))

পরবর্তী পদক্ষেপটি প্লট স্থাপন করা হয়। আমি প্রথমে পরামিতিগুলির সাথে একটি ফাঁকা প্লটিং অঞ্চল স্থাপন করতে চাই:

with(mydat, plot(bid, won, type="n", 
    ylim=c(0, 1), ylab="Probability of winning", xlab="Bid"))

লাগানো সম্ভাবনার গণনা কীভাবে করা যায় তা এখন আপনি দেখতে পারবেন। উপরের দ্বিতীয় সূত্র অনুসরণ করে আপনি লাগানো সম্ভাবনার সাথে সম্পর্কিত লাইনটি আঁকতে পারেন। এটি ব্যবহার করে preddat data.frameআপনি লাগানো মানগুলিকে সম্ভাব্যতায় রূপান্তর করতে পারেন এবং এটি আপনার পূর্বাভাসক ভেরিয়েবলের মানগুলির বিরুদ্ধে লাইন প্লট করতে পারেন।

with(preddat, lines(0:1000, exp(fit)/(1+exp(fit)), col="blue"))

পরিশেষে, আপনার প্রশ্নের উত্তর দিন, +/- 1.96মানক ত্রুটির সাথে লাগানো মানগুলির সম্ভাবনা গণনা করে আত্মবিশ্বাসের অন্তরগুলি প্লটে যুক্ত করা যেতে পারে :

with(preddat, lines(0:1000, exp(fit+1.96*se.fit)/(1+exp(fit+1.96*se.fit)), lty=2))
with(preddat, lines(0:1000, exp(fit-1.96*se.fit)/(1+exp(fit-1.96*se.fit)), lty=2))

ফলস্বরূপ প্লট (এলোমেলোভাবে উত্পন্ন ডেটা থেকে) এর মতো কিছু দেখতে পাওয়া উচিত:

এখানে চিত্র বর্ণনা লিখুন

অভিযানের জন্য, এখানে একটি কোডের মধ্যে সমস্ত কোড:

set.seed(1234)
mydat <- data.frame(
    won=as.factor(sample(c(0, 1), 250, replace=TRUE)), 
    bid=runif(250, min=0, max=1000)
)
mod1 <- glm(won~bid, data=mydat, family=binomial(link="logit"))
plotdat <- data.frame(bid=(0:1000))
preddat <- predict(mod1, newdata=plotdat, se.fit=TRUE)
with(mydat, plot(bid, won, type="n", 
    ylim=c(0, 1), ylab="Probability of winning", xlab="Bid"))
with(preddat, lines(0:1000, exp(fit)/(1+exp(fit)), col="blue"))
with(preddat, lines(0:1000, exp(fit+1.96*se.fit)/(1+exp(fit+1.96*se.fit)), lty=2))
with(preddat, lines(0:1000, exp(fit-1.96*se.fit)/(1+exp(fit-1.96*se.fit)), lty=2))

(দ্রষ্টব্য: এটি stats.stackexchange এর সাথে আরও প্রাসঙ্গিক করার প্রয়াসে এটি একটি ভারী সম্পাদিত উত্তর))


পরিবর্তনশীল se.fitসংজ্ঞায়িত হয় কোথায়?
ম্যাক্রো

ইন predict(..., se.fit=TRUE)
স্মিলিগ

(-1) এই সিআই প্রতিটি পৃথক ক্ষেত্রে জন্য? যদি তা হয় তবে বাইনারি ফলাফলের জন্য, ভবিষ্যদ্বাণী করা সম্ভাবনার একমাত্র বুদ্ধিমান সিআই হ'ল [0,1]। যদিও এটি প্রযুক্তিগতভাবে দক্ষ উত্তর হতে পারে।
Rolando2

প্রতি @ whuber এর মন্তব্য, আমি মনে করি একটি ভাল উত্তরের মধ্যে এসই গণনা করা হয় তার একটি সূত্র অন্তর্ভুক্ত করা উচিত। কেউ সম্ভবত উত্তর সম্পাদনা করতে এবং উন্নত করতে পারে?
হাইজেনবার্গ

1
আপনার উত্তরটি কেবল "গড় ভবিষ্যদ্বাণী ব্যবধান" বলে মনে হচ্ছে। আমি কীভাবে 'পয়েন্ট প্রেডিকশন ইন্টারভাল' যুক্ত করব?
বব হোপজ

0

এখানে @ স্মিলিগের সমাধানের একটি পরিবর্তন রয়েছে। আমি এখানে পরিপাটি সরঞ্জামগুলি ব্যবহার করি এবং সেই linkinvফাংশনটিও ব্যবহার করি যা জিএলএম মডেল অবজেক্টের একটি অংশ mod1। এইভাবে, আপনাকে লজিস্টিক ফাংশনটি ম্যানুয়ালি উল্টাতে হবে না এবং আপনি কোন নির্দিষ্ট জিএলএম উপযুক্ত তা বিবেচনা না করেই এই পদ্ধতির কাজ হবে।

library(tidyverse)
library(magrittr)


set.seed(1234)

# create fake data on gambling. Does prob win depend on bid size? 
mydat <- data.frame(
  won=as.factor(sample(c(0, 1), 250, replace=TRUE)), 
  bid=runif(250, min=0, max=1000)
)

# logistic regression model: 
mod1 <- glm(won~bid, data=mydat, family=binomial(link="logit"))

# new predictor values to use for prediction: 
plotdat <- data.frame(bid=(0:1000))

# df with predictions, lower and upper limits of CIs: 
preddat <- predict(mod1,
               type = "link",
               newdata=plotdat,
               se.fit=TRUE) %>% 
  as.data.frame() %>% 
  mutate(bid = (0:1000), 

         # model object mod1 has a component called linkinv that 
         # is a function that inverts the link function of the GLM:
         lower = mod1$family$linkinv(fit - 1.96*se.fit), 
         point.estimate = mod1$family$linkinv(fit), 
         upper = mod1$family$linkinv(fit + 1.96*se.fit)) 


# plotting with ggplot: 
preddat %>% ggplot(aes(x = bid, 
                   y = point.estimate)) + 
  geom_line(colour = "blue") + 
  geom_ribbon(aes(ymin = lower,
                  ymax = upper), 
              alpha = 0.5) + 
  scale_y_continuous(limits = c(0,1))

3
যদিও বাস্তবায়নে প্রায়শই প্রশ্নের মূল বিষয়বস্তুর সাথে মিশ্রিত করা হয়, তবে আমাদের কোড হিসাবে নয়, পরিসংখ্যান, মেশিন লার্নিং ইত্যাদি সম্পর্কিত তথ্য সরবরাহ করার জন্য একটি সাইট বলে মনে করা হচ্ছে। কোডটি সরবরাহ করাও ভাল হতে পারে তবে কোডটি থেকে উত্তরটি সনাক্ত করতে এবং সনাক্ত করতে এই ভাষা ভালভাবে পড়েন না এমন লোকদের জন্য দয়া করে আপনার সংক্ষিপ্ত উত্তরটি পাঠ্যে প্রসারিত করুন।
গুং - মনিকা পুনরায়
আমাদের সাইট ব্যবহার করে, আপনি স্বীকার করেছেন যে আপনি আমাদের কুকি নীতি এবং গোপনীয়তা নীতিটি পড়েছেন এবং বুঝতে পেরেছেন ।
Licensed under cc by-sa 3.0 with attribution required.