Русификация программы Ideogrid (репертуарные решетки)

Юрий Александрович! Что тут скажешь. И Вы правы, что студенту без мотивации программа не поможет. Просто надежда умирает последней В посте я это имел ввиду. Спасибо!

Под линукс я пользуюсь программой DOSBox, когда в ней надо запустить програмы, работающие только под MS-DOS. Кстати, DOSBox работает и под Windows

Приглашаю Евгения Савина (@Савин Е.Ю. ) рассказать о своем опыте обучения студентов. Если я правильно помню, то где-то он у себя на сайте публиковал занятие по технике репертуарных решеток

Коллеги, извините, что не в тему. Не хочу открывать новую тему. Подскажите, пожалуйста, опросник функциональных состояний, типа САН, но поновее?

Сразу могу только назвать: "Рельеф психических состояний" (А.О. Прохоров)

Петр Всеволодович, здравствуйте!
Я вспомнила методику ШПАНА - русскоязычная версия PANAS (Осин Е.Н., 2012 год)Хотя, это не совсем то, о чем Вы пишите....Ссылка на карточку: http://forum.ht-line.ru/threads/met...kta-i-negativnogo-affekta-osin-e-n-2012.1291/

Спасибо!

Дописал отдельную функцию для импорта в R протокола решетки из программы KELLY

Пользоваться так:

Код:

mygrid <- importKellyGrid()

Откроется диалоговое окно, в котором необходимо выбрать файл с раширением .PRT или .TXT

А дальше уже можно заниматься анализом и визуализацией:

Код:

bertin(mygrid)

Код:

> statsElements(mygrid)
 
##################################
Desriptive statistics for elements
##################################
 
					vars n mean   sd median trimmed  mad min max range  skew kurtosis   se
(1) МАТЬ			   1 5  5.2 1.48	  5	 5.2 1.48   3   7	 4 -0.26	-1.58 0.66
(2) ОТЕЦ			   2 5  2.4 0.89	  3	 2.4 0.00   1   3	 2 -0.60	-1.67 0.40
(3) СЕСТРА			 3 5  4.0 2.83	  3	 4.0 2.97   1   7	 6  0.16	-2.19 1.26
(4) СУПРУГ			 4 5  2.2 1.79	  1	 2.2 0.00   1   5	 4  0.60	-1.67 0.80
(5) ДРУГ			   5 5  5.0 2.35	  6	 5.0 1.48   2   7	 5 -0.28	-2.14 1.05
(6) НАЧАЛЬНИК		  6 5  5.8 1.79	  7	 5.8 0.00   3   7	 4 -0.60	-1.67 0.80
(7) УЧИТЕЛЬ			7 5  5.4 2.61	  7	 5.4 0.00   1   7	 6 -0.82	-1.29 1.17
(8) КУМИР			  8 5  5.0 1.87	  5	 5.0 1.48   2   7	 5 -0.55	-1.40 0.84
(9) НЕДОБРОЖЕЛАТЕЛЬ	9 5  2.6 2.61	  1	 2.6 0.00   1   7	 6  0.82	-1.29 1.17
(10) ПРЕУСПЕВ-Й	   10 5  5.6 1.52	  6	 5.6 0.00   3   7	 4 -0.84	-1.12 0.68
(11) НЕУДАЧНИК		11 5  3.0 1.87	  2	 3.0 1.48   1   5	 4  0.18	-2.18 0.84

Функция:

Код:

# Функция-парсер протокола репертуарной решетки из программы KELLY (В.И. Похилько, Н.Н. Страхов)
# Автор: Юрий Тукачев yurij.tukachev@gmail.com
 
importKellyGrid <- function(file, dir = NULL, encode = "UTF-8"){
  # Необходимые пакеты
  require(stringr)
  require(OpenRepGrid)
  require(tcltk)
  if (!is.null(dir)) 
	file <- paste(dir, file, sep = "/", collapse = "")
  if (missing(file)) {										 
	Filters <- matrix(c("Файл протокола Kelly", ".PRT", "Файл протокола Kelly (текстовый)", ".TXT"), 2, 2, byrow = TRUE)
	file <- tk_choose.files(filters = Filters, multi = TRUE)					
  }   
  # Загружаем файл из программы Kelly
  kelly.grid <- iconv(readLines(file), from = "866", to = encode, sub = NA, mark = TRUE, toRaw = FALSE)
  
  # Сохраняем шапку протокола для добавления в виде комментария
  comment.grid <- toString(str_trim(gsub("\\.+", "", kelly.grid[1:8])))
  #head(kelly.grid) #Что получилось?
  #kelly.grid
  #kelly.grid[1:25] #Первые 25 строк
  # Размерность матрицы (элементы х конструкты)
  str = grep("МАТРИЦА: ", kelly.grid)
  st <- kelly.grid[str]
  m <- str_extract_all(st, "[0-9]+")
  m.dim <- c(as.numeric(m[[1]][1]), as.numeric(m[[1]][2])) # Матрица
  #m.dim[1] #Элементов
  #m.dim[2] #Конструктов
  
  # Максимальный размах
  str.r = grep("РАЗМАХ:", kelly.grid)
  str <- kelly.grid[str.r]
  r <- as.numeric(str_extract_all(str, "[0-9]+")) #максимальный размах
  
  # Извлекаем элементы
  first.element.pos <- grep("СПИСОК ЭЛЕМЕНТОВ", kelly.grid) + 2 #Номер строки первого элемента
  end.element.pos <- first.element.pos + m.dim[1] - 1 #Номер строки последнего элемента
  elements.list <- sapply(first.element.pos:end.element.pos, function(x) {str_extract_all(kelly.grid[x], "[а-яА-Я\\-]+")})
  elements <- sapply(1:m.dim[1], function(x) {gsub(", "," ",toString(elements.list[[x]]))})
  
  # Извлекаем список конструктов
  first.construct.pos <- grep("СПИСОК КОНСТРУКТОВ", kelly.grid) + 2 #Номер строки первого элемента
  end.construct.pos <- first.construct.pos + m.dim[2]*3 - 3 #Номер строки последнего элемента
  
  #Номера строк для левого и правого полюсов конструктов
  left.cons.pole.pos <- first.construct.pos
  right.cons.pole.pos <- first.construct.pos + 1
  
  #Левый
  constructs.list.left <- sapply(seq(left.cons.pole.pos, end.construct.pos, 3), function(x) {str_extract_all(kelly.grid[x], "[а-яА-Я\\-]+")})
  constructs.left <- sapply(1:m.dim[2], function(x) {gsub(", "," ",toString(constructs.list.left[[x]]))})
  
  #Правый
  constructs.list.right <- sapply(seq(right.cons.pole.pos, end.construct.pos + 1, 3), function(x) {str_extract_all(kelly.grid[x], "[а-яА-Я\\-]+")})
  constructs.right <- sapply(1:m.dim[2], function(x) {gsub(", "," ",toString(constructs.list.right[[x]]))})
  
  # Считываем матрицу с баллами 
  points <- grep(" xx ", kelly.grid) + 2
  if (length(points) > 1) {
	scores <- unlist(sapply(1:length(points), function(x) {
	  nt <- sapply(points[x]:(points[x] + m.dim[2] - 1), function(x) {str_extract_all(kelly.grid[x], "[0-9]+")})
	  mt <- t(sapply(1:m.dim[2], function(x) {c(as.numeric(nt[[x]]))}))
	  mt <- mt[,-1]
	}))
  }  else
  {
	scores <- as.vector(sapply(1:length(points), function(x) {
	  nt <- sapply(points[x]:(points[x] + m.dim[2] - 1), function(x) {str_extract_all(kelly.grid[x], "[0-9]+")})
	  mt <- sapply(1:(m.dim[2]), function(x) {c(as.numeric(nt[[x]]))})
	  mt <- mt[-1,]
	}))
  }
  
  # Баллы в исходной решетке (максимальный балл соответствует левому полюсу конструкта)
  # Перекодируем баллы: максимальный балл соответствует правому полюса конструкта
  scores <- (r + 1) - scores 
  
  #Создаем решетку
  args <- list(
	name = elements,
	l.name = constructs.left,
	r.name = constructs.right,
	scores = scores)
  newGrid <- makeRepgrid(args)
  newGrid <- setScale(newGrid, 1, r)
  
  # Сохраняем шапку протокола в виде комментария к созданной решетке
  comment(newGrid) <- comment.grid
  return(newGrid)
}

Вопрос не по адресу. Во-первых, программа не под современные операционные системы, во-вторых, слишком мало информации . Единственная рекомендация это настроить запуск программы в режиме совместимости с winxp

Перешлите мне файл, я посмотрю на своем компе

Добрый день. Я давненько не использовал программу, но раньше с подобными ошибками не сталкивался. Раньше эта программа стояла на нескольких машинах в практикуме, где студенты проводили обследование на себе. Сбоев не было (кроме кракозябр, чему и посвящена была эта ветка). Да, программа только для XP, при чем максимально обновленного. Мой экземпляр Idiogrid без проблем редактировал проект обследования с использованием кириллицы, сохранял и пересохранял все, что нужно, не сбоил при обследовании. Если нужно, могу прислать свой архив Idiogrid.

Вышлю на почту. Сейчас не пользуюсь ни какой. Все поиски адекватной замены (бесплатной) ни к чему не привели. Да и потребности уже нет. Idiogrid - самая мощная, хоть и без кластерного анализа. Лет 15 назад написал для себя исследовательскую программу "на свой вкус", но до коммерческого продукт так и не довел.

К сожалению, паранойяльный Гугл не пропускает архивы даже без расширения. А здесь проблема с объемом. Это ссылка на Яндекс-диск: https://yadi.sk/d/A8plGyY1n-jpFQ

Я посмотрел. Вам необходимо пересоздать файл с настройками решетки, при этом не рекомендую копировать и вставлять текст из Ворда, скопируйте текст в блокнот, а уже из него вставляйте в поля в самой программе. Исходные файлы, которые вы выслали, не подлежат восстановлению. Это проблема не программы, а винды