install.packages(c("diffusion", "smacof", "psych", "MASS", "clusterSim", "segmented", "SensoMineR", "conjoint", "plspm", "lavaan", "semPlot"),dependencies=TRUE) install.packages("amap") #======MODEL BASSA======================================================== library(diffusion) #----Dane1------------------------------ x <- c( 103, 135, 172, 214, 259, 301, 333, 347, 340, 309, 261, 206, 153, 109, 74, 49, 32, 21, 13, 8, 5, 3, 2, 1, 1) fitbass1 <- diffusion(x, type = "bass") fitbass1 #---------------------------------------------------------------- # Produce some plots plot(fitbass1) #---------------------------------------------------------------- fit1 <- predict(fitbass1,15) plot(fit1) #------Dane2------------------------------------------- fitbass2 <- diffusion(tsCarstock[, 2], type = "bass") plot(fitbass2) #---------------------------------------------------------------- fit2 <- predict(fitbass2,5) plot(fit2) #=======MAPY PERCEPCJI I PREFERENCJI========================================= #Data mod <- read.table(header=TRUE, text=" Cena Przysp Hamow Wsk_trzy Zużycie Acura -0.521 -0.477 -0.007 0.382 2.079 Audi 0.866 -0.208 0.319 -0.091 -0.677 BMW 0.496 0.802 0.192 -0.091 -0.154 Buick -0.614 -1.689 0.933 -0.210 -0.154 Corvette 1.235 1.811 -0.494 0.973 -0.677 Chrysler -0.614 -0.073 0.427 -0.210 -0.154 Dodge -0.706 0.196 0.481 0.145 -0.154 Eagle -0.614 -1.218 -4.199 -0.210 -0.677 Ford -0.706 1.542 0.987 0.145 -1.724 Honda -0.429 -0.410 -0.007 0.027 0.369 Isuzu -0.798 -0.410 -0.061 -4.230 1.067 Mazda 0.126 -0.679 -0.133 0.500 -1.724 Mercedes 1.051 -0.006 0.120 -0.091 -0.154 Mitsub. -0.614 1.003 0.084 0.382 0.718 Nissan -0.429 -0.073 -0.007 0.263 0.997 Olds -0.614 0.734 0.409 0.382 2.114 Pontiac -0.614 -0.679 0.536 0.145 0.195 Porsche 3.454 2.215 -0.296 0.618 -1.026 Saab 0.588 -0.679 0.246 0.263 0.023 Toyota -0.059 -1.218 0.228 0.736 -0.851 VW -0.706 0.128 0.102 0.382 0.195 Volvo 0.219 0.612 0.138 -0.210 0.369") View(mod) attach(mod) #---------------------------------------------------------------- summary(mod) #---------------------------------------------------------------- #===Mapy percepcji MDS ==== library(smacof) library(psych) ##----MDS----samochody------ odl <- dist(mod) map <- mds(odl, type = "interval") map summary(map) plot(map) #------------------------------------------------------------- library(MASS) map <- isoMDS(odl) plot(map$points, type = "n") text(map$points, labels = row.names(mod), cex=.9) mod.sh <- Shepard(odl, map$points) plot(mod.sh, pch = ".") lines(mod.sh$x, mod.sh$yf, type = "S") #---------------------------------------------------------------- #=====Analiza PROFIT=============== library(MASS) library(clusterSim) #---------------------------------------------------------------- options(OutDec=".") skalowanie <- smacofSym(delta=odl, ndim=2) x1<-skalowanie$conf rownames(x1)<-rownames(mod) y<-mod ile_modeli<-ncol(y) wyniki<-array(0, c(ile_modeli, 2)) wyniki1<-array(0, c(ile_modeli, 4)) colnames(wyniki)<-c("x1", "x2") for (i in 1:ile_modeli) { model<-lm(y[,i]~x1[,1]+x1[,2]) wyn<-summary.lm(model) wyniki[i,1]<-model$coefficients[2] wyniki[i,2]<-model$coefficients[3] wyniki1[i,3]<-summary.lm(model)$r.squared wyniki1[i,4]<-summary.lm(model)$adj.r.squared } p1<-sqrt(wyniki[,1]^2+wyniki[,2]^2) nowe_p<-array(0, c(ile_modeli, 2)) for(i in 1:ile_modeli) { nowe_p[i,1]<-wyniki[i,1]/p1[i] nowe_p[i,2]<-wyniki[i,2]/p1[i] } xx<-c(-1.5, 1.5) yy<-c(-1.5, 1.5) windows() plot(xx, yy, type="n", las=1, main="", xlab="Dim 1", ylab="Dim 2") text(skalowanie$conf, labels=rownames(mod)) abline(h=0, v=0) for (i in 1:ile_modeli) { text(nowe_p[i,1], nowe_p[i,2], labels=colnames(y[i]), col="navy") arrows(0, 0, nowe_p[i,1], nowe_p[i,2], col="red", length=0.1) } #---------------------------------------------------------------- #===Mapa łączna preferencji==== , library(segmented) library(SensoMineR) ## Analiza coctaili data(cocktail) senso.cocktail # - ocena 16 koktaili ze względu na 13 sensorycznych cech przez 12 sędziów hedo.cocktail # - ocena 16 koktaili przez 100 konsumentów na skali 0-10 res.cpa = cpa(cbind(senso.cocktail), hedo.cocktail) #==========ANALIZA CONJOINT============================================================================= library(conjoint) #======Planowanie eksperymentu conjoint===== experiment<-expand.grid(cena<-c("wysoka","srednia","niska"), typ<-c("mleczna","nadziewana","bakaliowa", "gorzka"), opakowanie<-c("miekkie","twarde"), waga<-c("mala","srednia", "duza"), kalorie<-c("malo","duzo")) design<-caFactorialDesign(data=experiment,type="aca") design<-caFactorialDesign(data=experiment,type="full") design<-caFactorialDesign(data=experiment,type="ca") design<-caFactorialDesign(data=experiment,type="fractional") print(design) #------------------------------------------------------ data<-data(czekolada) czprof czpref czlevn # wektor preferencji czpref #macierz preferencji 16 profili x 87 respondentów czprefm # Profile produktów na rynku czsimp #---------------------------------------------------------------- #=====Analiza conjoint============== x<-as.data.frame(czprof) y1<-as.data.frame(czpref[1:nrow(x),1]) model<-caModel(y1, x) print(model) #---------------------------------------------------------------- # Wartosci uzytecznosci cech dla respondentów uslall<-caPartUtilities(czpref,czprof,czlevn) print(uslall) #---------------------------------------------------------------- # Wartości uzyteczności profili dla respondentów Usi<-caTotalUtilities(czpref,czprof) print(Usi) #---------------------------------------------------------------- # Graficzna prezentacja uzytecznosci ul<-caUtilities(czpref,czprof,czlevn) print(ul) #---------------------------------------------------------------- Conjoint(czpref,czprof,czlevn) #---------------------------------------------------------------- # Ważność predyktorów imp<-caImportance(czpref,czprof) print("Waznosc predyktorow: ", quote=FALSE) print(imp) print(paste("Sum: ", sum(imp)), quote=FALSE) #---------------------------------------------------------------- #Symulacja BTL simutil<-caBTL(czsimp,czpref,czprof) print("Percentage participation of profiles:", quote=FALSE) print(simutil) #---------------------------------------------------------------- # Symulacja logit simutil<-caLogit(czsimp,czpref,czprof) print("Percentage participation of profiles:", quote=FALSE) print(simutil) #---------------------------------------------------------------- # Symulacja max simutil<-caMaxUtility(czsimp,czpref,czprof) print("Percentage participation of profiles:", quote=FALSE) print(simutil) #---------------------------------------------------------------- #=============MODEL SEM============================================================== # install "devtools" install.packages("devtools") library(devtools) # install "plspm" install_github("gastonstat/plspm") library(plspm) library(lavaan) library(semPlot) ----------------------------------------------------------------- data(satisfaction) #---------------------------------------------------------------- sat<- ' EXPE = ~ expe1+expe2+expe3+expe4+expe5 IMAG = ~ imag1+imag2+imag3+imag4 QUAL = ~ qual1+qual2+qual3+qual4+qual5 VAL= ~ val1+val2+val3+val4 SAT= ~ sat1+sat2+sat3+sat4 LOY= ~ loy1+loy2+loy3+loy4 LOY ~ b*SAT+c*IMAG SAT ~ a*IMAG+EXPE+QUAL+VAL VAL ~ EXPE + QUAL QUAL ~ EXPE * IMAG EXPE ~ IMAG # pośredni efekt (a*b) ab := a*b # całkowity efekt total := c + (a*b)' fit <- sem(sat, data=satisfaction) #---------------------------------------------------------------- semCors(fit, vertical = TRUE, titles = TRUE,maximum=0.05) summary(fit, fit.measures=TRUE) #---------------------------------------------------------------- # Plot path diagram: semPaths(fit, what = "paths", layout = "tree2") #---------------------------------------------------------------- # Plot path diagram: semPaths(fit, what = "paths", layout = "circle") #---------------------------------------------------------------- # Plot path diagram: semPaths(fit, what = "paths", layout = "spring") #---------------------------------------------------------------- # Plot path diagram: semPaths(fit, whatLabels= "est", layout = "tree2", what = "paths", structural=FALSE, rotation=3, sizeMan=5, color = list( lat = "yellow", man="green")) #---------------------------------------------------------------- # Plot path diagram: semPaths(fit, whatLabels= "std", layout = "tree2", what = "paths", structural=TRUE, rotation=2, sizeMan=3, col="green") #====================MODEL PLSPM============================================================================== ----------------------------------------------------------- library(plspm) ## Not run: ## typical example of PLS-PM in customer satisfaction analysis ## model with six LVs and reflective indicators data(satisfaction) IMAG <- c(0,0,0,0,0,0) EXPE <- c(1,0,0,0,0,0) QUAL <- c(0,1,0,0,0,0) VAL <- c(0,1,1,0,0,0) SAT <- c(1,1,1,1,0,0) LOY <- c(1,0,0,0,1,0) sat.inner <- rbind(IMAG, EXPE, QUAL, VAL, SAT, LOY) sat.outer <- list(1:5,6:10,11:15,16:19,20:23,24:27) wart.mod <- c("A","A","A","A","A","A") scaling <- list(c("ORD", "ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD"), c("ORD", "ORD", "ORD", "ORD")) #---------------------------------------------------------------- satpls <- plspm(satisfaction, sat.inner, sat.outer, wart.mod, scaling = scaling, scheme="centroid", scaled=TRUE) #---------------------------------------------------------------- summary(satpls) #---------------------------------------------------------------- # plot diagram of the inner model innerplot(satpls,colpos = "blue", colneg = "red") #---------------------------------------------------------------- # plot loadings outerplot(satpls, what = "loadings", colpos = "blue", colneg = "red") #---------------------------------------------------------------- # plot outer weights outerplot(satpls, what = "weights", colpos = "blue", colneg = "red") #========Model REBUS============ # Hierarchiczna analiza skupień sim_clus = res.clus(satpls) #---------------------------------------------------------------- # Model REBUS z 2 skupieniami rebus_sim = it.reb(satpls, sim_clus, nk=2, stop.crit=0.005, iter.max=100) rebus_sim #---------------------------------------------------------------- # Model REBUS z 3 skupieniami rebus_sim3 = it.reb(satpls, sim_clus, nk=3, stop.crit=0.005, iter.max=100) rebus_sim3 #---------------------------------------------------------------- # Modele lokalne local_rebus = local.models(satpls, rebus_sim) local_rebus$glob.model summary(local_rebus$loc.model.1) summary(local_rebus$loc.model.2) #---------------------------------------------------------------- # Diagram modelu wewnętrznego dla 1 segmentu innerplot(local_rebus$loc.model.1, colpos = "blue", colneg = "red") #---------------------------------------------------------------- # Diagram modelu wewnętrznego dla 2 segmentu innerplot(local_rebus$loc.model.2, colpos = "blue", colneg = "red") #----------------------------------------------------------------