裏 RjpWiki

文字通り,RjpWiki の裏を行きます
R プログラム コンピュータ・サイエンス 統計学

2 〜 n までの整数の約数の個数

2020年09月03日 | ブログラミング

2 ~ n までの整数を素因数分解したとき,約数(素数) p が何個あるか数える。

p = 7 のとき 35 = 5 * 7 なので 1 個,49 = 7 * 7 なので 2 個である。

素朴にプログラムしてみると,以下のようになる(素朴すぎるということがすぐわかる)。

> count_factors0 = function(n, p) {
+   count = 0
+   for (i in 2:n) {
+     while (i %% p == 0) {
+       count = count + 1
+       i = i %/% p
+     }
+   }
+   return(count)
+ }

2 〜 50 の約数 7 の個数は,

> count_factors0(50, 7)
[1] 8

ただし,大きな n に対して求めようとすると,とんでもない時間が掛かる。

> system.time({
+   print(count_factors0(50000000, 7))
+ })
[1] 8333328
   ユーザ   システム       経過  
    14.356      0.030     14.386 

for ループと while ループの使い方が悪いのだ。以下のようにすれば瞬殺である。

> count_factors2 = function(n, p) {
+   count = 0
+   while (n > 0) {
+     count = count + n %/% p
+     n = n %/% p
+   }
+   return(count)
+ }

> system.time({
+   print(count_factors2(50000000, 7))
+ })
[1] 8333328
   ユーザ   システム       経過  
     0.004      0.000      0.004 

ちょっとわかりにくいが,以下のように再帰関数で定義するとわかりやすいかな。

> count_factors1 = function(n, p) {
+   if (n == 0) {
+     return(0)
+   } else {
+     return(n %/% p + Recall(n %/% p, p))
+   }
+ }

> system.time({
+   print(count_factors1(50000000, 7))
+ })
[1] 8333328
   ユーザ   システム       経過  
     0.005      0.000      0.005 

コメント (2)

外積の和

2020年09月02日 | ブログラミング

外積は R では outer(a, b, 演算子) で計算できる。

c(1, 2, 3, 4, 5) と c(2, 3, 4) で,演算子を "*" (積)とすると,以下のようになる。

> x = outer(1:5, 2:4, "*")
> x
     [,1] [,2] [,3]
[1,]    2    3    4
[2,]    4    6    8
[3,]    6    9   12
[4,]    8   12   16
[5,]   10   15   20

結果の行列の各要素の和は sum()  で求められる。

> print(sum(x))
[1] 135

さて,ここで,この結果を得るための最良の方法を探索しよう。

長さが共に n = 1e4 の正規乱数ベクトル a, b の sum(outer(a, b, "*")) を求めることとする。

outer() を使えば以下のようになる。答えは 2159.779 であり,0.309 秒ほどかかった。これでも十分速い。

> system.time({
+   x = outer(a, b, "*")
+   print(sum(x)) # 2159.779
+ })
[1] 2159.779
   ユーザ   システム       経過  
     0.309      0.150      0.459 

outer() がやっていることを R で素直(?)に書けば以下のようになる。

> system.time({
+   sum.of.outer.multiple = 0
+   for (i in seq_along(a)) {
+     for (j in seq_along(b)) {
+       sum.of.outer.multiple = sum.of.outer.multiple + a[i] * b[j]
+     }
+   }
+   print(sum.of.outer.multiple)
+ })
[1] 2159.779
   ユーザ   システム       経過  
     6.773      0.019      6.818

20  倍も遅い

内側の for ループは,a[i] * (b[1] + b[2] + ... + b[n]) を計算している訳だが,ループでは (b[1] + b[2] + ... + b[n]) はいつも同じなので,前もって計算しておいてそれを使えば,ループが省けるし計算量も削減できる。

> system.time({
+   sum.b = sum(b)
+   sum.of.outer.multiple = 0
+   for (a.i in a) {
+     sum.of.outer.multiple = sum.of.outer.multiple + a.i * sum.b
+   }
+   print(sum.of.outer.multiple)
+ })
[1] 2159.779
   ユーザ   システム       経過  
     0.003      0.000      0.003 

いやいや,待って待って。この for ループも (a[1] + a[2] + ... + a[n]) * sum.b を計算していますね。

な〜んだ。sum.a = a[1] + a[2] + ... + a[n] としておいて,sum.a * sum.b で答えが出ますね。

> system.time({
+   print(sum(a)*sum(b))
+ }) # 0.000
[1] 2159.779
   ユーザ   システム       経過  
         0          0          0 

瞬殺でした。outer() を使う必要はなかった。

 

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/30

2020年08月01日 | ブログラミング

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/25

2020年07月27日 | ブログラミング

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/21

2020年07月23日 | ブログラミング

コメント

"2014 NHPI NHIS Data" を Python にインポート Ver. 1

2020年07月23日 | ブログラミング

import pandas as pd
import zipfile
import string
import re
import os

def parse(fn, encoding='latin1', df_name='df', abbreviate=True, minlength=10, verbose=False):
    """
    fn:  *.zip ファイル(入力) unzip されアスキーデータ *.dat ができる
    *.dat があれば,それを使う
    この関数は,return() でデータフレームを返すので,すぐ分析を開始できる
    副次効果として,df.read_csv() で読める *.csv ファイルを書く
    変数情報をデータフレーム *-info.csv に書く
    さらに,カテゴリーデータ値を数値ではなく文字列に変換したデータファイルとして読む *-templeta.py ファイルを書く
    このテンプレートを使って分析プログラムを書けばよい
    abbreviate = True のとき,カテゴリー変数のカテゴリー名を minlength の長さで短縮する
    """
    def parse2(arg, f, t):
        pos = [i for i, s in enumerate(variable) if arg[0] in s][0]
        f[pos] = int(arg[1])
        t[pos] = int(arg[3])

    def is_num(a):
        return all(s in '.0123456789' for s in str(a))

    base = fn.replace('.zip', '')
    if not os.path.exists(base + '.dat'):
        with zipfile.ZipFile(fn) as zip_file:
            zip_file.extractall()

    fn = str.upper(base) +  '.sps'
    f = open(fn, encoding=encoding)
    src = f.read().split('\n')
    f.close()
    src = [s.strip() for s in src]
    # 最大読み取り桁
    s = [s for s in src if 'LRECL' in s]
    lrecl = int(re.sub('/LRECL=', '', s[0]))
    # df に,変数名と変数ラベルを取り出す
    variable = []
    label = []
    i = [i for i, s in enumerate(src) if s.startswith('VARIABLE LABELS')][0] + 1
    while src[i] != '.':
        s = src[i].split('"')
        variable.append(s[0].replace(' ', ''))
        label.append(s[1])
        i += 1
    n_variables = len(variable)
    # df に,読み出し桁数の情報を追加する
    f = [0] * n_variables
    t = [0] * n_variables
    i = [i for i, s in enumerate(src) if s.startswith('DATA LIST FILE')][0] + 1
    while src[i] != '.':
        field = src[i].replace('(A)', '').split()
        if len(field) == 4:
            parse2(field, f, t)
        elif len(field) == 8:
            parse2(field[:4], f, t)
            parse2(field[4:], f, t)
        else:
            print('parse error_')
            return 999
        i += 1
    w = [j - i + 1 for i, j in zip(f, t)]
    colspecs = [(i - 1, j) for i, j in zip(f, t)]
    df = pd.DataFrame({'variable': variable, 'label': label, 'from': f, 'to': t, 'width': w})
    # *.sps の変数に関するデータフレームの書き出し
    df.to_csv(base + '-info.csv', index=False)
    # データフレームとして読み込み
    if sum(w) != lrecl:
        print(f'widths error. sum of widths = {sum(w)}, lrecl = {lrecl}\n')
        return 999
    fn5 = base + '.dat'
    print(f'read {fn5} ...')
    df2 = pd.read_fwf(fn5, colspecs=colspecs, header=None)
    df2.columns = variable
    n = df2.shape[0]
    print(f'     {n} cases, {n_variables} variables')
    # csv ファイル書き出し
    df2.to_csv(base + '.csv', index=False)
    ###
    # もっとも単純にデータをインポートするだけなら,以下は要らない。
    i = [i for i, s in enumerate(src) if s.startswith('VALUE LABELS')][0] + 1
    f = open(base + '-template.py', mode='w')
    f.write('import pandas as pd\n')
    f.write('%s = pd.read_csv("%s.csv")\n' % (df_name, base))
    old_str = []
    new_str = []
    variable = src[i]
    i += 1
    while True:
        if len(src[i]) == 0 or src[i][0] == '/':
            if verbose:
                print(f'decoding ... {variable}')
            if abbreviate:
                new_str = [str(s) + ':' + t[:minlength+1] for s, t in zip(old_str, new_str)]
            x = df2.loc[:, variable].dropna()
            category = [int(y) if is_num(y) else y for y in sorted(set(x))]
            count = 0
            for s in category:
                if not s in old_str:
                    old_str.insert(count, s)
                    new_str.insert(count, str(s))
                    count += 1
            if verbose and count != 0:
                print(f'levels are completed.')
                print(new_str)
            dic = {}
            dic_str = '{'
            for key, value in zip(old_str, new_str):
                dic.setdefault(key, value)
                if is_num(key):
                    dic_str = dic_str + str(key) + ': "' + value + '", '
                else:
                    dic_str = dic_str + '"' + key + '": "' + value + '", '
            df2 = df2.replace({variable: dic})
            dic_str = re.sub(', $', '}', dic_str)
            f.write("%s = %s.replace({'%s': %s})\n" % (df_name, df_name, variable, dic_str))
            if len(src[i]) == 0:
                break
            old_str = []
            new_str = []
            variable = src[i].split()[1]
        else:
            field = src[i].split('"')
            if len(field) == 3:
                old_str.append(int(field[0].strip()))
                new_str.append(field[1])
            elif len(field) == 5:
                old_str.append(int(field[1]) if is_num(field[1]) else field[1])
                new_str.append(field[3])
        i += 1
    f.close()
    return df2

 

コメント

"2014 NHPI NHIS Data" を R にインポート Ver. 3

2020年07月23日 | ブログラミング

value labels に記述されない値が NA になってしまう件を修正

parse = function(fn, df.name = "df", abbreviate = TRUE, minlength = 10, verbose = FALSE) {
  # fn:  *.zip ファイル(入力) unzip されアスキーデータ *.dat ができる
  # invisible() でデータフレームを返す
  # *.csv ファイルを書く
  # 変数情報についてのデータフレーム *-info.csv に書く
  # R でfactor 変数を定義するための R コードを *-template.R に書く
  # abbreviate = TRUE のとき,factor() の labels を minlength の長さで短縮する

  parse2 = function(df, arg) {
    pos = grep(arg[1], df$variable)
    df[pos, "from"] = as.integer(arg[2])
    df[pos, "to"]   = as.integer(arg[4])
    return(df)
  }

  base = sub("\\..*$", "", fn)
  if (grepl('\\.zip$', fn) && ! file.exists(paste0(fn, ".dat"))) {
    unzip(fn)
  }
  fn = paste0(toupper(base), ".sps")
  src = readLines(fn, encoding="latin1")
  src = trimws(src)
  pos = grep("LRECL", src)
  # 最大読み取り桁
  lrecl = as.integer(unlist(strsplit(src[pos], "="))[2])
  # df に,変数名と変数ラベルを取り出す
  begin = which(src == "VARIABLE LABELS")
  n.variable = which(src[-(1:begin)] == ".") - 1
  variable = character(n.variable)
  label = character(n.variable)
  for (i in 1:n.variable) {
    field = unlist(strsplit(src[begin + i], '"'))
    variable[i] = trimws(field[1])
    label[i]    = field[2]
  }
  n.variables = length(variable)
  # df に,読み出し桁数の情報を追加する
  df = data.frame(variable, label, from=0, to=0, width=0)
  begin = which(grepl("DATA LIST FILE", src))
  n.def = which(src[-(1:begin)] == ".") - 1
  for (i in 1:n.def[1]) {
    s = gsub("\\(A\\)", "", src[begin + i])
    field = unlist(strsplit(s, " +"))
    pos = which(field %in% df$variable)
    if (length(pos) == 1) {
      df = parse2(df, field)
    } else if (length(pos) == 2) {
      df = parse2(df, field[1:4])
      df = parse2(df, field[5:8])
    } else {
      print("parse error.")
      return(999)
    }
  }
  df$width = df$to - df$from + 1
  # *.sps の変数に関するデータフレームの書き出し
  write.csv(df, paste0(base, "-info.csv"), row.names = FALSE)
  # データフレームとして読み込み
  if (sum(df$width) != lrecl) {
    cat("widths error. sum of widths =", sum(df$width), ", lrecl =", lrecl, "\n")
    return(999)
  }
  fn5 = paste0(base, ".dat")
  cat(sprintf("read %s...\n", fn5))
  df2 = read.fwf(fn5, width = df$width)
  colnames(df2) = df$variable
  n = nrow(df2)
  cat(sprintf("     %d cases, %d variables\n", n, n.variables))
  # csv ファイル書き出し
  fn6 = paste0(base, ".csv")
  write.csv(df2, fn6, row.names = FALSE)
  ###
  # もっとも単純にデータをインポートするだけなら,以下は要らない。
  i = which(src == "VALUE LABELS") + 1
  fn7 = paste0(base, "-template.R")
  write(sprintf("# template file for data frame -- %s.csv", base), fn7)
  write(sprintf("%s = read.csv('%s.csv')", df.name, base), fn7)
  old.str = new.str = NULL
  variable = src[i]
  while (TRUE) {
    if (nchar(src[i]) == 0 || substr(src[i], 1, 1) == "/") {
      if (verbose) {
        cat("decoding...", variable, "\n")
      }
      if (abbreviate) {
        new.str = base::abbreviate(new.str, minlength = minlength, named = FALSE)
        new.str = paste(old.str, new.str, sep=":")
      }
      # もともと存在する level なのに,levels で指定漏れになると存在しないことになるのを修正
      category = sort(unique(df2[, variable]))
      count = 0
      for (s in category) {
        if (nchar(trimws(s)) != 0 && ! s %in% old.str) {
          old.str = append(old.str, s, after=count)
          new.str = append(new.str, s, after=count)
          count = count + 1
        }
      }
      df2[, variable] = factor(df2[, variable], levels = old.str, labels = new.str)
      old.str2 = sapply(old.str, function(s)
        if (is.numeric(s)) s else paste0("'", s, "'"))
      old.str2 = paste(old.str2, collapse = ", ")
      new.str2 = paste(sprintf("\"%s\"", new.str), sep = ", ", collapse = ", ")
      cat(sprintf('%s$%s = factor(%s$%s, levels=c(%s), labels=c(%s))\n',
          df.name, variable, df.name, variable, old.str2, new.str2 ),
          file = fn7, append = TRUE)
      if (nchar(src[i]) == 0) {
        break
      }
      old.str = new.str = NULL
      variable = unlist(strsplit(src[i], " "))[2]
    } else if (nchar(src[i]) != 0) {
      field = unlist(strsplit(src[i],  "\\\""))
      n.field = length(field)
      if (n.field == 2) {
        old.str = c(old.str, as.integer(field[1]))
        new.str = c(new.str, field[2])
      } else if (n.field == 4) {
        old.str = c(old.str, field[2])
        new.str = c(new.str, field[4])
      }
    }
    i = i + 1
  }
  invisible(df2)
}

コメント

"2014 NHPI NHIS Data" を R にインポート Ver. 2

2020年07月17日 | ブログラミング

最新版は以下を参照

"2014 NHPI NHIS Data" を R にインポート Ver. 3
https://blog.goo.ne.jp/r-de-r/e/23dae09d759881be24d0bb2a645ce8ac

"2014 NHPI NHIS Data" を Python にインポート Ver. 1
https://blog.goo.ne.jp/r-de-r/e/c25c3b84e3e1e50136958939501380b0

 

factor() の labels を base::abbreviate() で短縮するオプションを付加

parse = function(fn, df.name = "df", abbreviate = TRUE, minlength = 10, verbose = FALSE) {
  # fn:  *.zip ファイル(入力) unzip されアスキーデータ *.dat ができる
  # invisible() でデータフレームを返す
  # *.csv ファイルを書く
  # 変数情報についてのデータフレーム *-info.csv に書く
  # R でfactor 変数を定義するための R コードを *-factor.R に書く
  # abbreviate = TRUE のとき,factor() の labels を minlength の長さで短縮する

  parse2 = function(df, arg) {
    pos = grep(arg[1], df$variable)
    df[pos, "from"] = as.integer(arg[2])
    df[pos, "to"]   = as.integer(arg[4])
    type = ""
    if (length(arg) == 5) {
      type = arg[5]
    }
    df[pos, "type"] = type
    return(df)
  }

  base = sub("\\.dat", "", sub("./", "", unzip(fn)))
  fn = paste0(toupper(base), ".sps")
  src = readLines(fn)
  src = sub("^ +", "", src)
  src = sub("\xfc\xbe\x8d\x93\xa0\xbc", " ", src) # "Ö" SAMADULT.sps などに特有
  src = sub("\xfc\xbe\x8c\xa3\xa4\xbc", "'", src) # "í" SAMADULT.sps などに特有
  pos = grep("LRECL", src)
  # 最大読み取り桁
  lrecl = as.integer(unlist(strsplit(src[pos], "="))[2])
  # df に,変数名と変数ラベルを取り出す
  begin = which(src == "VARIABLE LABELS") + 1
  end   = which(src == "VALUE LABELS") - 3
  n.variables = end - begin + 1
  variable = character(n.variables)
  label = character(n.variables)
  for (i in begin:end) {
    j = i - begin + 1
    variable[j] = sub(" +", "", substr(src[i], 1, 8))
    label   [j] = sub("\\\"", "", substr(src[i], 12, nchar(src[i])))
  }
  # df に,読み出し桁数の情報を追加する
  df = data.frame(variable, label, from=0, to=0, width=0, type="")
  begin = which(grepl("DATA LIST FILE", src)) + 1
  end   = which(src == "VARIABLE LABELS") - 3
  for (i in begin:end) {
    field = unlist(strsplit(src[i], " +"))
    pos = which(field %in% df$variable)
    if (length(pos) == 1) {
      df = parse2(df, field)
    } else if (length(pos) == 2) {
      df = parse2(df, field[pos[1]:(pos[2] - 1)])
      df = parse2(df, field[pos[2]:length(field)])
    } else {
      print("parse error.")
      return(999)
    }
  }
  df$width = df$to - df$from + 1
  # *.sps の変数に関するデータフレームの書き出し
  fn4 = paste0(base, "-info.csv")
  write.csv(df, fn4, row.names = FALSE)
  # データフレームとして読み込み
  if (sum(df$width) != lrecl) {
    cat("widths error. sum of widths =", sum(df$width), ", lrecl =", lrecl, "\n")
    return(999)
  }
  fn5 = paste0(base, ".dat")
  cat(sprintf("read %s...\n", fn5))
  df2 = read.fwf(fn5, width = df$width)
  colnames(df2) = df$variable
  n = nrow(df2)
  cat(sprintf("     %d cases, %d variables\n", n, n.variables))
  # csv ファイル書き出し
  fn6 = paste0(base, ".csv")
  write.csv(df2, fn6, row.names = FALSE)
  ###
  # もっとも単純にデータをインポートするだけなら,以下は要らない。
  begin = which(src == "VALUE LABELS") + 1
  end   = which(src == "EXECUTE.")
  fn7 = paste0(base, "-factor.R")
  write("# read.csv() then source(*this file*)", fn7)
  for (i in begin:end) {
    if (i == begin) {
      old.str = new.str = NULL
      variable = src[i]
    } else if (nchar(src[i]) == 0 || substr(src[i], 1, 1) == "/") {
      if (verbose) {
        cat("decoding...", variable, "\n")
      }
      if (abbreviate) {
        new.str = base::abbreviate(new.str, minlength = minlength, named = FALSE)
        new.str = paste(old.str, new.str, sep=":")
      }
      df2[, variable] = factor(df2[, variable], levels = old.str, labels = new.str)
      old.str2 = paste(old.str, collapse = ", ")
      new.str2 = paste(sprintf("\"%s\"", new.str), sep = ", ", collapse = ", ")
      cat(sprintf('%s$%s = factor(%s$%s, levels=c(%s), labels=c(%s))\n',
          df.name, variable, df.name, variable, old.str2, new.str2 ),
          file = fn7, append = TRUE)
      if (nchar(src[i]) == 0) {
        break
      }
      old.str = new.str = NULL
      variable = unlist(strsplit(src[i], " "))[2]
    } else {
      field = unlist(strsplit(src[i],  "\\\""))
      if (length(field) == 2) { # SAMADULT.sps などで例外
        old.str = c(old.str, as.integer(field[1]))
        new.str = c(new.str, field[2])
      }
    }
  }
  invisible(df2)
}

コメント (2)

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/15

2020年07月17日 | ブログラミング

コメント

"2014 NHPI NHIS Data" を R にインポート

2020年07月16日 | ブログラミング

最新版は以下を参照

"2014 NHPI NHIS Data" を R にインポート Ver. 3
https://blog.goo.ne.jp/r-de-r/e/23dae09d759881be24d0bb2a645ce8ac

"2014 NHPI NHIS Data" を Python にインポート Ver. 1
https://blog.goo.ne.jp/r-de-r/e/c25c3b84e3e1e50136958939501380b0

 

中澤さんが https://www.cdc.gov/nchs/nhis/nhpi/nhpi_2014_data_release.htm にあるファイルを R で使えるようにプログラムを書きたいといっていたので,書いてみた。

「ここはこうしたらよいよ」というところを教えてください。

追記 2020/07/17:編集時に大域代入記号 <<- が <= になってしまっていたのを修正

parse = function(fn, df.name = "df", verbose = FALSE) {
  # fn:  *.zip ファイル(入力) unzip されアスキーデータ *.dat ができる
  # invisible() でデータフレームを返す
  # *.csv ファイルを書く
  # 変数情報についてのデータフレーム *-info.csv に書く
  # R でfactor 変数を定義するための R コードを *-factor.R に書く

  parse2 = function(arg) {
    pos = grep(arg[1], df$variable)
    df[pos, "from"] <<- as.integer(arg[2])
    df[pos, "to"] <<- as.integer(arg[4])
    type = ""
    if (length(arg) == 5) {
      type = arg[5]
    }
    df[pos, "type"] <<- type
  }

  base = sub("\\.dat", "", sub("./", "", unzip(fn)))
  fn = paste0(toupper(base), ".sps")
  src = readLines(fn)
  src = sub("^ +", "", src)
  src = sub("\xfc\xbe\x8d\x93\xa0\xbc", " ", src) # "Ö" SAMADULT.sps などに特有
  src = sub("\xfc\xbe\x8c\xa3\xa4\xbc", "'", src) # "í" SAMADULT.sps などに特有
  pos = grep("LRECL", src)
  # 最大読み取り桁
  lrecl = as.integer(unlist(strsplit(src[pos], "="))[2])
  # df0 に,変数名と変数ラベルを取り出す
  begin = which(src == "VARIABLE LABELS") + 1
  end   = which(src == "VALUE LABELS") - 3
  n.variables = end - begin + 1
  variable = character(n.variables)
  label = character(n.variables)
  for (i in begin:end) {
    j = i - begin + 1
    variable[j] = sub(" +", "", substr(src[i], 1, 8))
    label   [j] = sub("\\\"", "", substr(src[i], 12, nchar(src[i])))
  }
  # df に,読み出し桁数の情報を追加する
  df = data.frame(variable, label, from=1, to=1, width=1, type="")
  begin = which(grepl("DATA LIST FILE", src)) + 1
  end   = which(src == "VARIABLE LABELS") - 3
  for (i in begin:end) {
    field = unlist(strsplit(src[i], " +"))
    pos = which(field %in% df$variable)
    if (length(pos) == 1) {
      parse2(field)
    } else if (length(pos) == 2) {
      parse2(field[pos[1]:(pos[2] - 1)])
      parse2(field[pos[2]:length(field)])
    } else {
      print("parse error.")
      return(999)
    }
  }
  df$width = df$to - df$from + 1
  # *.sps の変数に関するデータフレームの書き出し
  fn4 = paste0(base, "-info.csv")
  write.csv(df, fn4, row.names = FALSE)
  # データフレームとして読み込み
  fn5 = paste0(base, ".dat")
  cat(sprintf("read %s...\n", fn5))
  df2 = read.fwf(fn5, width = df$width)
  colnames(df2) = df$variable
  n = nrow(df2)
  cat(sprintf("     %d cases, %d variables\n", n, n.variables))
  # csv ファイル書き出し
  fn6 = paste0(base, ".csv")
  write.csv(df2, fn6, row.names = FALSE)
  ###
  # もっとも単純にデータをインポートするだけなら,以下は要らない。
  begin = which(src == "VALUE LABELS") + 1
  end   = which(src == "EXECUTE.")
  fn7 = paste0(base, "-factor.R")
  write("# read.csv() then source(*this file*)", fn7)
  for (i in begin:end) {
    if (i == begin) {
      old.str = new.str = NULL
      variable = src[i]
    } else if (nchar(src[i]) == 0 || substr(src[i], 1, 1) == "/") {
      if (verbose) {
        cat("decoding...", variable, "\n")
      }
      df2[, variable] = factor(df2[, variable], levels = old.str, labels = new.str)
      old.str2 = paste(old.str, collapse = ", ")
      new.str2 = paste(sprintf("\"%s\"", new.str), sep = ", ", collapse = ", ")
      cat(sprintf('%s[, "%s"] = factor(%s[, "%s"], levels=c(%s), labels=c(%s))\n',
          df.name, variable, df.name, variable, old.str2, new.str2 ),
          file = fn7, append = TRUE
      )
      if (nchar(src[i]) == 0) {
        break
      }
      old.str = new.str = NULL
      variable = unlist(strsplit(src[i], " "))[2]
    } else {
      field = unlist(strsplit(src[i],  "\\\""))
      if (length(field) == 2) { #  SAMADULT.sps などで例外
        old.str = c(old.str, as.integer(field[1]))
        new.str = c(new.str, field[2])
      }
    }
  }
  invisible(df2)
}

##################
##### 使用例 #####
##################
# *.zip と,対応する *.sps をダウンロードしておく
fn = "familyxx.zip" # ASCII データ(固定書式)
# pase() は,*.sps から情報を読み取る
# カテゴリーデータは spss での順序通りの factor 変数になる
df = parse(fn, df.name = "df2")
# このあと,データフレーム a を使って分析する

# なお,parse() は元の *.dat を桁数指定で読み込み,数値データとして CSV ファイルに保存する
# *.sps による value labels を R での factor とするために,source("*-factor.R") する
# parse() の df.name は 以下の read.csv で読み込むときの左辺(データフレーム名)
df2 = read.csv("familyxx.csv")
source("familyxx-factor.R")
# このあと,データフレーム df を使って分析する

# いずれのデータフレームを使っても,結果は同じになる。
table(df$FSNAP)
table(df2$FSNAP)

# parse() R ですぐ使えるデータフレームを準備するが,毎回 *.dat を読みむので無駄かもしれない
# 一度 parse() すれば *.csv が書かれるので,
# *.csv を処理する R ファイルの前方に *-factor.R をペーストしておいてやれば,無駄が省けるかも

parse(fn, df.name = "df3") # 一回だけ

# 必要に応じ
df3 = read.csv("familyxx.csv")
source("familyxx-factor.R")
table(df3$FGAH, df3$FSNAP)

# 掲載されているファイルを全て読んでみる
familyxx = parse("familyxx.zip")
funcdisb = parse("funcdisb.zip")
paradata = parse("paradata.zip")
samadult = parse("samadult.zip")
samchild = parse("samchild.zip")
personsx = parse("personsx.zip")
injpoiep = parse("injpoiep.zip")
househld = parse("househld.zip")

 

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/14

2020年07月15日 | ブログラミング

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/09

2020年07月10日 | ブログラミング

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/08

2020年07月10日 | ブログラミング

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/03

2020年07月04日 | ブログラミング

コメント

COVID-19 陽性確定日ごとの患者数の推移(東京都)07/02

2020年07月04日 | ブログラミング

データの修正がよくある

コメント