/**
* jQuery Plugin: Sticky Tabs
*
* @author Aidan Lister
* adapted by Ruben Arslan to activate parent tabs too
* http://www.aidanlister.com/2014/03/persisting-the-tab-state-in-bootstrap/
*/
(function($) {
"use strict";
$.fn.rmarkdownStickyTabs = function() {
var context = this;
// Show the tab corresponding with the hash in the URL, or the first tab
var showStuffFromHash = function() {
var hash = window.location.hash;
var selector = hash ? 'a[href="' + hash + '"]' : 'li.active > a';
var $selector = $(selector, context);
if($selector.data('toggle') === "tab") {
$selector.tab('show');
// walk up the ancestors of this element, show any hidden tabs
$selector.parents('.section.tabset').each(function(i, elm) {
var link = $('a[href="#' + $(elm).attr('id') + '"]');
if(link.data('toggle') === "tab") {
link.tab("show");
}
});
}
};
// Set the correct tab when the page loads
showStuffFromHash(context);
// Set the correct tab when a user uses their back/forward button
$(window).on('hashchange', function() {
showStuffFromHash(context);
});
// Change the URL when tabs are clicked
$('a', context).on('click', function(e) {
history.pushState(null, null, this.href);
showStuffFromHash(context);
});
return this;
};
}(jQuery));
window.buildTabsets = function(tocID) {
// build a tabset from a section div with the .tabset class
function buildTabset(tabset) {
// check for fade and pills options
var fade = tabset.hasClass("tabset-fade");
var pills = tabset.hasClass("tabset-pills");
var navClass = pills ? "nav-pills" : "nav-tabs";
// determine the heading level of the tabset and tabs
var match = tabset.attr('class').match(/level(\d) /);
if (match === null)
return;
var tabsetLevel = Number(match[1]);
var tabLevel = tabsetLevel + 1;
// find all subheadings immediately below
var tabs = tabset.find("div.section.level" + tabLevel);
if (!tabs.length)
return;
// create tablist and tab-content elements
var tabList = $('
');
$(tabs[0]).before(tabList);
var tabContent = $('
');
$(tabs[0]).before(tabContent);
// build the tabset
var activeTab = 0;
tabs.each(function(i) {
// get the tab div
var tab = $(tabs[i]);
// get the id then sanitize it for use with bootstrap tabs
var id = tab.attr('id');
// see if this is marked as the active tab
if (tab.hasClass('active'))
activeTab = i;
// remove any table of contents entries associated with
// this ID (since we'll be removing the heading element)
$("div#" + tocID + " li a[href='#" + id + "']").parent().remove();
// sanitize the id for use with bootstrap tabs
id = id.replace(/[.\/?&!#<>]/g, '').replace(/\s/g, '_');
tab.attr('id', id);
// get the heading element within it, grab it's text, then remove it
var heading = tab.find('h' + tabLevel + ':first');
var headingText = heading.html();
heading.remove();
// build and append the tab list item
var a = $('' + headingText + '');
a.attr('href', '#' + id);
a.attr('aria-controls', id);
var li = $('
');
li.append(a);
tabList.append(li);
// set it's attributes
tab.attr('role', 'tabpanel');
tab.addClass('tab-pane');
tab.addClass('tabbed-pane');
if (fade)
tab.addClass('fade');
// move it into the tab content div
tab.detach().appendTo(tabContent);
});
// set active tab
$(tabList.children('li')[activeTab]).addClass('active');
var active = $(tabContent.children('div.section')[activeTab]);
active.addClass('active');
if (fade)
active.addClass('in');
if (tabset.hasClass("tabset-sticky"))
tabset.rmarkdownStickyTabs();
}
// convert section divs with the .tabset class to tabsets
var tabsets = $("div.section.tabset");
tabsets.each(function(i) {
buildTabset($(tabsets[i]));
});
};
保護犬・保護猫・保護動物のデータ解析その4ー年齢は譲渡に影響するか?ー
前回(保護犬・保護猫・保護動物のデータ解析その4)の続きです。 まずは、ライブラリとデータを読み込みます。
library(tidyverse)
library(reshape2)
df <- read.csv("C:\\Users\\shelter\\Austin_Animal_Center_Outcomes.csv")
colnames(df)
## [1] "Animal.ID" "Name" "DateTime" "MonthYear"
## [5] "Date.of.Birth" "Outcome.Type" "Outcome.Subtype" "Animal.Type"
## [9] "Sex.upon.Outcome" "Age.upon.Outcome" "Breed" "Color"
df$Outcome.Type <- ifelse(df$Outcome.Type=="Adoption","Yes","No")
dfdog <- df %>% filter(Animal.Type=="Dog")
dfcat <- df %>% filter(Animal.Type=="Cat")
今度は、年齢と譲渡の関係について見ていきます。
unique(df$Age.upon.Outcome)
## [1] "2 years" "1 year" "4 months" "6 days" "7 years" "2 months"
## [7] "2 days" "3 weeks" "9 months" "4 weeks" "2 weeks" "3 months"
## [13] "9 years" "10 years" "6 months" "8 years" "3 years" "7 months"
## [19] "6 years" "4 years" "1 month" "12 years" "5 years" "1 weeks"
## [25] "5 months" "5 days" "15 years" "11 months" "10 months" "4 days"
## [31] "16 years" "1 day" "8 months" "11 years" "13 years" "1 week"
## [37] "14 years" "3 days" "NULL" "0 years" "5 weeks" "17 years"
## [43] "18 years" "20 years" "22 years" "-2 years" "19 years" "23 years"
## [49] "24 years" "-1 years" "25 years" "21 years" "-3 years"
年齢表記がバラバラになっています。統一する必要があります。年で統一していきたいと思います。まず、年で書かれているやつを、yearをなくして数字だけにします。
文字列が、部分一致しているかは、str_detect(検索対象, “検索文字”)で調べられます。 下のコードは、yearが入っているかをTrue Falseで返ってくるので、それをfilterに使っています。
dfdog_year <- dfdog %>% filter(str_detect(dfdog$Age.upon.Outcome,"year"))
文字列の細かい操作は、stringrライブラリを使います。 str_remove(対象, “消す文字”)で、狙った文字を消せます。
library(stringr)
dfdog_year$Age.upon.Outcome <- str_remove(dfdog_year$Age.upon.Outcome, "years")
dfdog_year$Age.upon.Outcome <- str_remove(dfdog_year$Age.upon.Outcome, "year")
str_trim(対象, side= “both”)で、両側の空白を消せます。sideは、left,rightも選べます。
dfdog_year$Age.upon.Outcome <- str_trim(dfdog_year$Age.upon.Outcome, side = "both")
# 0yearはおかしいので削除。
dfdog_year <- dfdog_year %>% filter(Age.upon.Outcome > 0)
○○ days ○○ weeksはすべて、0.5 yearにすることにしました。
dfdog_week <- dfdog %>% filter(str_detect(dfdog$Age.upon.Outcome,"week"))
dfdog_week$Age.upon.Outcome <- 0.5
dfdog_day <- dfdog %>% filter(str_detect(dfdog$Age.upon.Outcome,"day"))
dfdog_day$Age.upon.Outcome <- 0.5
year, week, dayでそれぞれ処理したものを、1つにrbindでまとめます。
dfdog_age <- rbind(dfdog_year,dfdog_week,dfdog_day)
dfdog_age2 <- as.data.frame(table(age=dfdog_age$Age.upon.Outcome,
Adoption = dfdog_age$Outcome.Type))
なぜか、ageがfactorになっていたので、factorから数字にします。 factorから数字にするときに、いきなりas.numericをするとfactorの番号になってしまい、おかしな数字になってしまいます。 そのため、一回as.charactorをかませる必要があります。
dfdog_age2$age <- as.numeric(as.character(dfdog_age2$age))
グラフを作ります。stack bar chartです。
ggplot(dfdog_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
geom_bar(stat = "identity") +
scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
xlab("Age")+
ylab("Frequency")+
theme_minimal()
犬は若齢のほうが、保護される数が多い事がわかりました。特に1、2歳が多い。
割合は? position=“fill”でbarcharで割合を表現できます。 y軸を割合にするには、scale_y_continuous(labels = scales::percent)を入れて下さい。
ggplot(dfdog_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
geom_bar(position="fill", stat = "identity") +
scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
xlab("Age")+
ylab("")+
scale_y_continuous(labels = scales::percent)+
theme_minimal()
犬は、若齢のほうが譲渡されやすい
猫についても分析します。
dfcat_year <- dfcat %>% filter(str_detect(dfcat$Age.upon.Outcome,"year"))
library(stringr)
dfcat_year$Age.upon.Outcome <- str_remove(dfcat_year$Age.upon.Outcome, "years")
dfcat_year$Age.upon.Outcome <- str_remove(dfcat_year$Age.upon.Outcome, "year")
dfcat_year$Age.upon.Outcome <- str_trim(dfcat_year$Age.upon.Outcome, side = "both")
dfcat_year <- dfcat_year %>% filter(Age.upon.Outcome > 0)
dfcat_week <- dfcat %>% filter(str_detect(dfcat$Age.upon.Outcome,"week"))
dfcat_week$Age.upon.Outcome <- 0.5
dfcat_day <- dfcat %>% filter(str_detect(dfcat$Age.upon.Outcome,"day"))
dfcat_day$Age.upon.Outcome <- 0.5
dfcat_age <- rbind(dfcat_year,dfcat_week,dfcat_day)
dfcat_age2 <- as.data.frame(table(age=dfcat_age$Age.upon.Outcome,
Adoption = dfcat_age$Outcome.Type))
dfcat_age2$age <- as.numeric(as.character(dfcat_age2$age))
ggplot(dfcat_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
geom_bar(stat = "identity") +
xlab("Age")+
ylab("Frequency")+
scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
theme_minimal()
猫は犬に比べると、1歳未満の子猫が保護されることが多い
ggplot(dfcat_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
geom_bar(position="fill", stat = "identity") +
scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
xlab("Age")+
ylab("")+
scale_y_continuous(labels = scales::percent)+
theme_minimal()
猫は犬に比べると、若くなくても譲渡される
// add bootstrap table styles to pandoc tables
function bootstrapStylePandocTables() {
$('tr.odd').parent('tbody').parent('table').addClass('table table-condensed');
}
$(document).ready(function () {
bootstrapStylePandocTables();
});