Geekly Articles each Day

PL / Rを䜿甚したPostgreSQL統蚈分析

昚幎のPG Day'15 Russiaカンファレンスで、私たちのスピヌカヌの1人であるゞョセフコンりェむが、10幎以䞊にわたっお圌が䜜成およびサポヌトしたPL / R拡匵機胜の䜿甚に関する興味深い資料を玹介したした。デヌタベヌス Joeのレポヌトに瀺されおいる資料に基づいお䜜成されたフォロヌアップ蚘事に泚目したいず思いたす。 この出版物の目的は、PL / R蚀語の可胜性を知るこずです。 ここに蚘茉されおいる情報がお圹に立おば幞いです。

画像

最近のビッグデヌタの傟向により、分析ずデヌタの収束が促進されおいたすが、PL / Rはこのようなサヌビスを控えめに12幎間提䟛しおいたす 突然あなたが知らない堎合、PL / RはPostgreSQLの拡匵機胜であり、簡単か぀詳现な分析を簡単に取埗するために、PostgreSQLから盎接Rを数孊蚈算の蚀語ずしお䜿甚できたす。 拡匵機胜は利甚可胜であり、2003幎以降積極的に改善されおいたす。 サポヌトされおいるすべおのバヌゞョンのPostgreSQLおよびすべおの最近のバヌゞョンのRで動䜜したす。䞖界䞭の䜕千人もの人々が、その䟿利さず有効性をすでに評䟡しおいたす。 PL / Rずは䜕かを芋お、デヌタ分析に察するこのアプロヌチの長所ず短所を説明し、説明のためにいく぀かの䟋を考えおみたしょう。

たず、基本的な抂念を定矩したしょう。 Rは、統蚈デヌタ凊理ずグラフィックス、および無料のオヌプン゜ヌス゜フトりェア環境のためのプログラミング蚀語です。 たた、PostgreSQLは匷力で無料のオブゞェクトリレヌショナルデヌタベヌス管理システムであり、25幎以䞊にわたっお積極的に開発されおおり、その信頌性ずデヌタの正確性および敎合性により高い評䟡を埗おいたす。 そしお最埌に、PL / R 前述のように、これはPostgreSQL甚の手続き型R蚀語ハンドラであり、RでSQL関数を蚘述できたす。

PL / Rの利点は䜕ですか たず、数孊、統蚈、デヌタベヌス、およびWebはそれぞれ異なる専門分野であるため、PL / Rは人間の知識ずスキルの開発に貢献したすが、PL / Rを䜿甚するにはある皋床すべお習埗する必芁がありたす。 第二に、この拡匵機胜はハヌドりェアの改善を促進したす。倧芏暡なデヌタセットの分析に耐えられるサヌバヌが必芁だからです。 第䞉に、ネットワヌク党䜓に倧きなデヌタセットを転送する必芁がなくなり、スルヌプットが向䞊するため、凊理効率が向䞊したす。 第4に、分析が確実に順次実行されるこずを確認できたす。 第5に、PL / Rは耇雑なシステムを理解しやすく保守しやすくしたす。 最埌に、豊富な機胜ず巚倧な゚コシステムにより、PL / RはRを拡匵したす。

しかし、もちろん、欠点もありたす。 PostgreSQLナヌザヌは、特に単玔なタスクではPL / Rが遅いこずに気付くでしょう。 たた、Rプログラマヌにずっおは、デバッグプロセスがより耇雑になり、分析の柔軟性が䜎䞋したす。 さらに、䞡方が新しい蚀語を孊ぶ必芁がありたす。

Rの暙準関数は次のようになりたす。

func_name <- function(myarg1 [,myarg2...]) { function body referencing myarg1 [, myarg2 ...] }

PL / Rでの関数の䜜成は少し異なりたすが、PostgreSQLの他のPLず䌌おいたす。

 CREATE OR REPLACE FUNCTION func_name(arg-type1 [, arg-type2 ...]) RETURNS return-type AS $$ function body referencing arg1 [, arg2 ...] $$ LANGUAGE 'plr'; CREATE OR REPLACE FUNCTION func_name(myarg1 arg-type1 [, myarg2 arg-type2 ...]) RETURNS return-type AS $$ function body referencing myarg1 [, myarg2 ...] $$ LANGUAGE 'plr';

以䞋に䟋を瀺したす。

 CREATE EXTENSION plr; CREATE OR REPLACE FUNCTION test_dtup(OUT f1 text, OUT f2 int) RETURNS SETOF record AS $$ data.frame(letters[1:3],1:3) $$ LANGUAGE 'plr'; SELECT * FROM test_dtup(); f1 | f2 ----+---- a | 1 b | 2 c | 3 (3 rows)

PL / Rでできるこずをすべおリストするこずは困難ですが、次のようないく぀かの重芁なプロパティを詳しく芋おみたしょう。


PostgreSQLずの互換性のおかげで、Rを䜿甚しおプロトタむプを䜜成し、PL / Rに移動しお実皌働で実行できたす。 たた、明確なプラスは、すべおのク゚リが珟圚のデヌタベヌスで実行されるこずです。 ドラむバヌず接続の蚭定は無芖されるため、dbDriver、dbConnect、dbDisconnect、dbUnloadDriverは远加の䜜業を必芁ずしたせん。

 dbDriver(character dvr_name) dbConnect(DBIDriver drv, character user, character password, character host, character dbname, character port, character tty, character options) dbSendQuery(DBIConnection conn, character sql) fetch(DBIResult rs, integer num_rows) dbClearResult (DBIResult rs) dbGetQuery(DBIConnection conn, character sql) dbReadTable(DBIConnection conn, character name) dbDisconnect(DBIConnection conn) dbUnloadDriver(DBIDriver drv)

説明のために、いく぀かの䟋を挙げたしょう。 有名な巡回セヌルスマンの問題を解決するためにRからPostgreSQLを䜿甚する必芁があるずしたす。これに぀いおは埌で詳しく説明したす。

 tsp_tour_length<-function() { require(TSP) require(fields) require(RPostgreSQL) drv <- dbDriver("PostgreSQL") conn <- dbConnect(drv, user="postgres", dbname="plr", host="localhost") sql.str <- "select id, st_x(location) as x, st_y(location) as y, location from stands" waypts <- dbGetQuery(conn, sql.str) dist.matrix <- rdist.earth(waypts[,2:3], R=3949.0) rtsp <- TSP(dist.matrix) soln <- solve_TSP(rtsp) dbDisconnect(conn) dbUnloadDriver(drv) return(attributes(soln)$tour_length) }

そしお、ここにPL / Rの同じ関数がありたす

 CREATE OR REPLACE FUNCTION tsp_tour_length() RETURNS float8 AS $$ require(TSP) require(fields) require(RPostgreSQL) drv <- dbDriver("PostgreSQL") conn <- dbConnect(drv, user="postgres", dbname="plr", host="localhost") sql.str <- "select id, st_x(location) as x, st_y(location) as y, location from stands" waypts <- dbGetQuery(conn, sql.str) dist.matrix <- rdist.earth(waypts[,2:3], R=3949.0) rtsp <- TSP(dist.matrix) soln <- solve_TSP(rtsp) dbDisconnect(conn) dbUnloadDriver(drv) return(attributes(soln)$tour_length) $$ LANGUAGE 'plr' STRICT;

Rが最終的に提䟛するものを次に瀺したす。

 tsp_tour_length() [1] 2804.581

そしお、PL / Rの同じ機胜

 SELECT tsp_tour_length(); tsp_tour_length ------------------ 2804.58129355858 (1 row)

ご芧のずおり、結果は同じです。

次に、集蚈に぀いお説明したす。 PostgreSQLの最も䟿利な機胜の1぀は、独自の集蚈関数を䜜成できるこずです。 PostgreSQLの集蚈は、SQLコマンドを䜿甚しお展開できたす。 この堎合、状態遷移関数ず、堎合によっおは最終関数が瀺されたす。 遷移関数の初期条件も指定できたす。 たた、PL / Rを䜿甚しおこれらのメリットを享受できたす。

以䞋は、新しい集玄を実装するPL / R関数の䟋です。 最近たで、PostgreSQLからこれを行うこずはできたせんでしたが、GROUPING SETS機胜はバヌゞョン9.5でのみ登堎したしたが、PL / RではどのバヌゞョンのPGでもこれを行うこずができたす。 ある生産䌚瀟の実際のデヌタに基づいお集玄関数を䜜成し、四分䜍数ず呌びたす。

 CREATE OR REPLACE FUNCTION r_quartile(ANYARRAY) RETURNS ANYARRAY AS $$ quantile(arg1, probs = seq(0, 1, 0.25), names = FALSE) $$ LANGUAGE 'plr'; CREATE AGGREGATE quartile (ANYELEMENT) ( sfunc = array_append, stype = ANYARRAY, finalfunc = r_quantile, initcond = '{}' ); SELECT workstation, quartile(id_val) FROM sample_numeric_data WHERE ia_id = 'G121XB8A' GROUP BY workstation; workstation | quantile -------------+--------------------------------- 1055 | {4.19,5.02,5.21,5.5,6.89} 1051 | {3.89,4.66,4.825,5.2675,5.47} 1068 | {4.33,5.2625,5.455,5.5275,6.01} 1070 | {4.51,5.1975,5.485,5.7575,6.41} (4 rows)

Rを䜿甚するず、デヌタを玠敵なグラフの圢匏で衚瀺できたす。 この堎合、ボックスダむアグラムが䜿甚されたした。

グラフは、生産ステヌションの1぀が他の生産ステヌションよりも生産性が䜎いこずを瀺しおおり、これを修正するための察策が必芁です。

それずは別に、 りィンドり関数で停止する䟡倀がありたす 。 バヌゞョン8.4以降、PostgreSQLで利甚可胜であり、統蚈分析に最適です。 りィンドり関数は集蚈関数ず䌌おいたすが、それらずは異なり、文字列をグルヌプ化したせんが、ク゚リ結果の珟圚の行だけでなく、珟圚の行に関連付けられた文字列のセットで蚈算できたす。 ぀たり、デヌタはセクションに分割され、これらのセクションをスラむドしお各デヌタグルヌプの結果を生成するりィンドりがありたす。


PostgreSQLはりィンドり関数をほずんどサポヌトしおいたせんが、PL / Rでは非垞に䟿利です。 䟋は次のずおりです。収益ず株䟡をシミュレヌトするランダムデヌタテヌブルを䜜成したす。

 CREATE TABLE test_data ( fyear integer, firm float8, eps float8 ); INSERT INTO test_data SELECT (bf + 1) % 10 + 2000 AS fyear, floor((b.f+1)/10) + 50 AS firm, f::float8/100 + random()/10 AS eps FROM generate_series(-500,499,1) b(f); CREATE OR REPLACE FUNCTION r_regr_slope(float8, float8) RETURNS float8 AS $BODY$ slope <- NA y <- farg1 x <- farg2 if (fnumrows==9) try (slope <- lm(y ~ x)$coefficients[2]) return(slope) $BODY$ LANGUAGE plr WINDOW;

そしお、単玔な回垰法を䜿甚しお、昚幎の指暙に基づいお、今幎の収益を予枬できるかどうかを調べるための関数を䜜成したす。

 SELECT *, r_regr_slope(eps, lag_eps) OVER w AS slope_R FROM ( SELECT firm AS f, fyear AS fyr, eps, lag(eps) OVER (PARTITION BY firm ORDER BY firm, fyear) AS lag_eps FROM test_data ) AS a WHERE eps IS NOT NULL WINDOW w AS (PARTITION BY firm ORDER BY firm, fyear ROWS 8 PRECEDING); f | fyr | eps | lag_eps | slope_r ---+------+-------------------+-------------------+------------------- 1 | 1991 | -4.99563754182309 | | 1 | 1992 | -4.96425441872329 | -4.99563754182309 | 1 | 1993 | -4.96906093481928 | -4.96425441872329 | 1 | 1994 | -4.92376988714561 | -4.96906093481928 | 1 | 1995 | -4.95884547665715 | -4.92376988714561 | 1 | 1996 | -4.93236254784279 | -4.95884547665715 | 1 | 1997 | -4.90775520844385 | -4.93236254784279 | 1 | 1998 | -4.92082695348188 | -4.90775520844385 | 1 | 1999 | -4.84991340579465 | -4.92082695348188 | 0.691850614092383 1 | 2000 | -4.86000917562284 | -4.84991340579465 | 0.700526929134053

ご芧のずおり、この関数は収入の前幎の指暙ぞの䟝存床を蚈算したした。

最埌に詳しく説明するのは、Rオブゞェクトを返すためのメカニズムず、それらを保存する方法です。

圚庫デヌタの䟋を瀺したす。 これを行うには、「ティッカヌ」株䟡衚瀺のYahooからHi-Low-Closeデヌタを取埗したす。 ボリンゞャヌの線ずボリュヌムでチャヌトを䜜成したしょう。 次のコマンドを䜿甚しおRから取埗できる远加のRパケットが必芁です。

 install.packages(c('xts','Defaults','quantmod','cairoDevice','RGtk2'))

リク゚ストを行いたす

 CREATE OR REPLACE FUNCTION plot_stock_data(sym text) RETURNS bytea AS $$ library(quantmod) library(cairoDevice) library(RGtk2) pixmap <- gdkPixmapNew(w=500, h=500, depth=24) asCairoDevice(pixmap) getSymbols(c(sym)) chartSeries(get(sym), name=sym, theme="white", TA="addVo();addBBands();addCCI()") plot_pixbuf <- gdkPixbufGetFromDrawable(NULL, pixmap, pixmap$getColormap(),0, 0, 0, 0, 500, 500) buffer <- gdkPixbufSaveToBufferv(plot_pixbuf, "jpeg", character(0), character(0))$buffer return(buffer) $$ LANGUAGE plr;

䞀般的なサヌバヌでは、グラフを䜜成するために画面バッファヌが必芁です。

 Xvfb :1 -screen 0 1024x768x24 export DISPLAY=:1.0

CYMIティッカヌの関数をPHPから呌び出したす。

 <?php $dbconn = pg_connect("..."); $rs = pg_query($dbconn, "select plr_get_raw(plot_stock_data('CYMI'))"); $hexpic = pg_fetch_array($rs); $cleandata = pg_unescape_bytea($hexpic[0]); header("Content-Type: image/png"); header("Last-Modified: " . date("r", filectime($_SERVER['SCRIPT_FILENAME']))); header("Content-Length: " . strlen($cleandata)); echo $cleandata; ?>

そしお、ここで出力でそのようなグラフを取埗したす


同意したす。PL/ Rで数十行、PHPで数十行未満を蚘述できるこずは驚くべきこずです。その結果、デヌタの詳现な芖芚衚瀺ず分析が可胜になりたす。

情報を統合するには、より耇雑な䟋を怜蚎しおください。 倚くの人がベンフォヌドの法則、たたは実数から取埗した量の分垃に特定の最初の重芁な数字が珟れる確率を蚘述する最初の数字の法則に粟通しおいるず思いたす。 しかし、その存圚を知らず、法埋を適甚する代わりに、必芁に応じおデヌタを配信する人もいたす。

ベンフォヌドの法則は、朜圚的な詐欺の特定に䜿甚できたす。その助けを借りお、いく぀かの初期倀に基づいお近䌌の幟䜕孊的シヌケンスを構築し、それを実際のデヌタず比范しお矛盟を芋぀けるこずができたす。 この方法は、販売スケゞュヌル、囜勢調査デヌタ、コストレポヌトなどに適甚できたす。

カリフォルニアの゚ネルギヌ効率最適化プログラムの䟋を考えおみたしょう。 たず、プロゞェクトぞの投資に関するデヌタを含むテヌブルを䜜成しお蚘入したすデヌタはhttp://open-emv.com/dataで入手できたす。

 CREATE TABLE open_emv_cost(value float8, district int); COPY open_emv_cost FROM 'open-emv.cost.csv' WITH delimiter ',';

次に、ベンフォヌドの法則の関数を曞きたす。

 CREATE TYPE benford_t AS ( actual_mean float8, n int, expected_mean float8, distorion float8, z float8 ); CREATE OR REPLACE FUNCTION benford(numarr float8[]) RETURNS benford_t AS $$ xcoll <- function(x) { return ((10 * x) / (10 ^ (trunc(log10(x))))) } numarr <- numarr[numarr >= 10] numarr <- xcoll(numarr) actual_mean <- mean(numarr) n <- length(numarr) expected_mean <- (90 / (n * (10 ^ (1/n) - 1))) distorion <- ((actual_mean - expected_mean) / expected_mean) z <- (distorion / sd(numarr)) retval <- data.frame(actual_mean,n,expected_mean,distorion,z) return(retval) $$ LANGUAGE plr;

そしお、比范を実行したす。

 SELECT * FROM benford(array(SELECT value FROM open_emv_cost)); -[ RECORD 1 ]-+---------------------- actual_mean | 38.1936561918275 n | 240 expected_mean | 38.8993031865999 distorion | -0.0181403505195804 z | -0.000984036908080443

実際のデヌタは予枬ず䞀臎しおいるようであるため、この堎合、䞍正の兆候はありたせん。

巡回セヌルスマンの問題に戻りたしょう。 これは組み合わせ最適化の最も有名な問題の1぀です。これは、これらの郜垂を少なくずも1回通過しおから元の郜垂に戻る最も収益性の高いルヌトを芋぀けるこずにありたす。 問題の状況では、ルヌトの収益性の基準最短、最䜎、集玄基準などず、距離、コストなどの察応するマトリックスが瀺されたす。 原則ずしお、ルヌトは各郜垂を1回だけ通過する必芁があるこずが瀺されおいたす。 この特定のオプションを芋おみたしょう。

最初に、蚪問する必芁があるすべおの郜垂を含むテヌブルを䜜成し、入力したす。

 CREATE TABLE stands ( id serial primary key, strata integer not null, initage integer ); SELECT AddGeometryColumn('','stands','boundary','4326','MULTIPOLYGON',2); CREATE INDEX "stands_boundary_gist" ON "stands" USING gist ("boundary" gist_geometry_ops); SELECT AddGeometryColumn('','stands','location','4326','POINT',2); CREATE INDEX "stands_location_gist" ON "stands" USING gist ("location" gist_geometry_ops); INSERT INTO stands (id,strata,initage,boundary,location) VALUES ( 1,1,1, GeometryFromText( 'MULTIPOLYGON(((59.250000 65.000000,55.000000 65.000000,55.000000 51.750000, 60.735294 53.470588, 62.875000 57.750000, 59.250000 65.000000 )))', 4326 ), GeometryFromText('POINT( 61.000000 59.000000 )', 4326) ), ( 2,2,1, GeometryFromText( 'MULTIPOLYGON(((67.000000 65.000000,59.250000 65.000000,62.875000 57.750000, 67.000000 60.500000, 67.000000 65.000000 )))', 4326 ), GeometryFromText('POINT( 63.000000 60.000000 )', 4326 ) ), ( 3,3,1, GeometryFromText( 'MULTIPOLYGON(((67.045455 52.681818,60.735294 53.470588,55.000000 51.750000, 55.000000 45.000000, 65.125000 45.000000, 67.045455 52.681818 )))', 4326 ), GeometryFromText('POINT( 64.000000 49.000000 )', 4326 ) ) ;

結果を埗るには、いく぀かの補助ク゚リを䜜成する必芁がありたす。 最初のものは、出力で取埗したいルヌトを䜜成したす

 INSERT INTO stands (id,strata,initage,boundary,location) VALUES ( 4,4,1, GeometryFromText( 'MULTIPOLYGON(((71.500000 53.500000,70.357143 53.785714,67.045455 52.681818, 65.125000 45.000000, 71.500000 45.000000, 71.500000 53.500000 )))', 4326 ), GeometryFromText('POINT( 68.000000 48.000000 )', 4326) ), ( 5,5,1, GeometryFromText( 'MULTIPOLYGON(((69.750000 65.000000,67.000000 65.000000,67.000000 60.500000, 70.357143 53.785714, 71.500000 53.500000, 74.928571 54.642857, 69.750000 65.000000 )))', 4326 ), GeometryFromText('POINT( 71.000000 60.000000 )', 4326) ), ( 6,6,1, GeometryFromText( 'MULTIPOLYGON(((80.000000 65.000000,69.750000 65.000000,74.928571 54.642857, 80.000000 55.423077, 80.000000 65.000000 )))', 4326 ), GeometryFromText('POINT( 73.000000 61.000000 )', 4326) ), ( 7,7,1, GeometryFromText( 'MULTIPOLYGON(((80.000000 55.423077,74.928571 54.642857,71.500000 53.500000, 71.500000 45.000000, 80.000000 45.000000, 80.000000 55.423077 )))', 4326 ), GeometryFromText('POINT( 75.000000 48.000000 )', 4326) ), ( 8,8,1, GeometryFromText( 'MULTIPOLYGON(((67.000000 60.500000,62.875000 57.750000,60.735294 53.470588, 67.045455 52.681818, 70.357143 53.785714, 67.000000 60.500000 )))', 4326 ), GeometryFromText('POINT( 65.000000 57.000000 )', 4326) ) ;

2番目は、plr_modulesに入力するデヌタず、結果のデヌタのタむプです。

 DROP TABLE IF EXISTS events CASCADE; CREATE TABLE events ( seqid int not null primary key, -- visit sequence # plotid int, -- original plot id bearing real, -- bearing to next waypoint distance real, -- distance to next waypoint velocity real, -- velocity of travel, in nm/hr traveltime real, -- travel time to next event loitertime real, -- how long to hang out totaltraveldist real, -- cummulative distance totaltraveltime real -- cummulaative time ); SELECT AddGeometryColumn('','events','location','4326','POINT',2); CREATE INDEX "events_location_gist" ON "events" USING gist ("location" gist_geometry_ops); CREATE TABLE plr_modules ( modseq int4 primary key, modsrc text );

メむンのPL / R関数を䜜成したす。

 CREATE OR REPLACE FUNCTION solve_tsp(makemap bool, mapname text) RETURNS SETOF events AS $$ require(TSP) require(fields) sql.str <- "select id, st_x(location) as x, st_y(location) as y, location from stands;" waypts <- pg.spi.exec(sql.str) dist.matrix <- rdist.earth(waypts[,2:3], R=3949.0) rtsp <- TSP(dist.matrix) soln <- solve_TSP(rtsp) tour <- as.vector(soln) pg.thrownotice( paste("tour.dist=", attributes(soln)$tour_length)) route <- make.route(tour, waypts, dist.matrix) if (makemap) { make.map(tour, waypts, mapname) } return(route) $$ LANGUAGE 'plr' STRICT;

ここで、make.route関数を蚭定する必芁がありたす。

 INSERT INTO plr_modules VALUES ( 0, $$ make.route <-function(tour, waypts, dist.matrix) { velocity <- 500.0 starts <- tour[1:(length(tour))-1] stops <- tour[2:(length(tour))] dist.vect <- diag( as.matrix( dist.matrix )[starts,stops] ) last.leg <- as.matrix( dist.matrix )[tour[length(tour)],tour[1]] dist.vect <- c(dist.vect, last.leg ) delta.x <- diff( waypts[tour,]$x ) delta.y <- diff( waypts[tour,]$y ) bearings <- atan( delta.x/delta.y ) * 180 / pi bearings <- c(bearings,0) for( i in 1:(length(tour)-1) ) { if( delta.x[i] > 0.0 && delta.y[i] > 0.0 ) bearings[i] <- bearings[i] if( delta.x[i] > 0.0 && delta.y[i] < 0.0 ) bearings[i] <- 180.0 + bearings[i] if( delta.x[i] < 0.0 && delta.y[i] > 0.0 ) bearings[i] <- 360.0 + bearings[i] if( delta.x[i] < 0.0 && delta.y[i] < 0.0 ) bearings[i] <- 180 + bearings[i] } route <- data.frame(seq=1:length(tour), ptid=tour, bearing=bearings, dist.vect=dist.vect, velocity=velocity, travel.time=dist.vect/velocity, loiter.time=0.5) route$total.travel.dist <- cumsum(route$dist.vect) route$total.travel.time <- cumsum(route$travel.time+route$loiter.time) route$location <- waypts[tour,]$location return(route)}$$ );

make.map関数

 INSERT INTO plr_modules VALUES ( 1, $$make.map <-function(tour, waypts, mapname) { require(maps) jpeg(file=mapname, width = 480, height = 480, pointsize = 10, quality = 75) map('world2', xlim = c(20, 120), ylim=c(20,80) ) map.axes() grid() arrows( waypts[tour[1:(length(tour)-1)],]$x, waypts[tour[1:(length(tour)-1)],]$y, waypts[tour[2:(length(tour))],]$x, waypts[tour[2:(length(tour))],]$y, angle=10, lwd=1, length=.15, col="red" ) points( waypts$x, waypts$y, pch=3, cex=2 ) points( waypts$x, waypts$y, pch=20, cex=0.8 ) text( waypts$x+2, waypts$y+2, as.character( waypts$id ), cex=0.8 ) title( "TSP soln using PL/R" ) dev.off() }$$ );

TSPタグを受信する機胜を開始したす。

 -- only needed if INSERT INTO plr_modules was in same session SELECT reload_plr_modules(); SELECT seqid, plotid, bearing, distance, velocity, traveltime, loitertime, totaltraveldist FROM solve_tsp(true, 'tsp.jpg'); NOTICE: tour.dist= 2804.58129355858 seqid | plotid | bearing | distance | velocity | traveltime | loitertime | totaltraveldist -------+--------+---------+----------+----------+------------+------------+----------------- 1 | 8 | 131.987 | 747.219 | 500 | 1.49444 | 0.5 | 747.219 2 | 7 | -90 | 322.719 | 500 | 0.645437 | 0.5 | 1069.94 3 | 4 | 284.036 | 195.219 | 500 | 0.390438 | 0.5 | 1265.16 4 | 3 | 343.301 | 699.683 | 500 | 1.39937 | 0.5 | 1964.84 5 | 1 | 63.4349 | 98.2015 | 500 | 0.196403 | 0.5 | 2063.04 6 | 2 | 84.2894 | 345.957 | 500 | 0.691915 | 0.5 | 2409 7 | 6 | 243.435 | 96.7281 | 500 | 0.193456 | 0.5 | 2505.73 8 | 5 | 0 | 298.855 | 500 | 0.59771 | 0.5 | 2804.58 (8 rows)

詳现ビュヌ

 \x SELECT * FROM solve_tsp(true, 'tsp.jpg'); NOTICE: tour.dist= 2804.58129355858 -[ RECORD 1 ]---+--------------------------------------------------- seqid | 1 plotid | 3 bearing | 104.036 distance | 195.219 velocity | 500 traveltime | 0.390438 loitertime | 0.5 totaltraveldist | 195.219 totaltraveltime | 0.890438 location | 0101000020E610000000000000000050400000000000804840 -[ RECORD 2 ]---+--------------------------------------------------- [...]

したがっお、これらの郜垂を蚪れる䟡倀がある順序、それらの郜垂間の距離などを取埗したした。 さらに、巡回セヌルスマンの問題に察する明確な解決策がありたす。


今床は地震デヌタを䜿甚した別の䟋を考えおみたしょう。

地震が発生するず、通垞15〜20秒続き、地震孊者はその振動の匷床に関するデヌタを収集したす。 ぀たり、波圢の圢匏のデヌタの時系列timeseries波圢デヌタがありたす。 デヌタは、䞀定のサンプリング呚波数で地震むベント䞭に蚘録された浮動小数点数浮動小数点数の配列ずしお保存されたす。 これらは、各アクティビティの個別のファむルでオンラむン゜ヌスから入手できたす。 各ファむルには玄16,000の芁玠が含たれおいたす。

PL / pgSQLを䜿甚しお1000の地震掻動をロヌドしたす。

 DROP TABLE IF EXISTS test_ts; CREATE TABLE test_ts ( dataid bigint NOT NULL PRIMARY KEY, data double precision[] ); CREATE OR REPLACE FUNCTION load_test(int) RETURNS text AS $$ DECLARE i int; arr text; sql text; BEGIN arr := pg_read_file('array-data.csv', 0, 500000); FOR i IN 1..$1 LOOP sql := $i$INSERT INTO test_ts(dataid,data) VALUES ($i$ || i || $i$,'{$i$ || arr || $i$}')$i$; EXECUTE sql; END LOOP; RETURN 'OK'; END; $$ LANGUAGE plpgsql; SELECT load_test(1000); load_test ----------- OK (1 row) Time: 37336.539 ms

これは、Rの助けを借りお別の方法で行うこずができ、半分の時間がかかりたす-PL / Rを䜿甚する堎合、プロセスを遅くするのではなく、スピヌドアップするこずはたれです

 DROP TABLE IF EXISTS test_ts_obj; CREATE TABLE test_ts_obj ( dataid serial PRIMARY KEY, data bytea ); CREATE OR REPLACE FUNCTION make_r_object(fname text) RETURNS bytea AS $$ myvar<-scan(fname,sep=",") return(myvar); $$ LANGUAGE 'plr' IMMUTABLE; INSERT INTO test_ts_obj (data) SELECT make_r_object('array-data.csv') FROM generate_series(1,1000); INSERT 0 1000 Time: 12166.137 ms

オシログラムを䜜成したしょう

 CREATE OR REPLACE FUNCTION plot_ts(ts double precision[]) RETURNS bytea AS $$ library(quantmod) library(cairoDevice) library(RGtk2) pixmap <- gdkPixmapNew(w=500, h=500, depth=24) asCairoDevice(pixmap) plot(ts,type="l") plot_pixbuf <- gdkPixbufGetFromDrawable( NULL, pixmap, pixmap$getColormap(), 0, 0, 0, 0, 500, 500 ) buffer <- gdkPixbufSaveToBufferv( plot_pixbuf, "jpeg", character(0), character(0) )$buffer return(buffer) $$ LANGUAGE 'plr' IMMUTABLE; SELECT plr_get_raw(plot_ts(data)) FROM test_ts WHERE dataid = 42;

特定の地震に぀いおこの画像を取埗したす。


次に、たずえば、同様の地震掻動がある地域で建物を蚭蚈する最善の方法を芋぀けるために、分析する必芁がありたす。 おそらく、孊校の物理孊コヌスで「共振呚波数」などのこずを芚えおいるでしょう。 念のため、これは発振振幅が急激に増加するような発振呚波数であるこずを思い出させおください。 この頻床は、システムのプロパティによっお決たりたす。 ぀たり、地震掻動のある地域では、共振呚波数が地震の呚波数ず䞀臎しないように構造を蚭蚈する必芁がありたす。 これはRを䜿甚しお実行できたす。

 CREATE OR REPLACE FUNCTION plot_fftps(ts bytea) RETURNS bytea AS $$ library(quantmod) library(cairoDevice) library(RGtk2) fourier<-fft(ts) magnitude<-Mod(fourier) y2 <- magnitude[1:(length(magnitude)/10)] x2 <- 1:length(y2)/length(magnitude) mydf <- data.frame(x2,y2) pixmap <- gdkPixmapNew(w=500, h=500, depth=24) asCairoDevice(pixmap) plot(mydf,type="l") plot_pixbuf <- gdkPixbufGetFromDrawable( NULL, pixmap, pixmap$getColormap(), 0, 0, 0, 0, 500, 500 ) buffer <- gdkPixbufSaveToBufferv( plot_pixbuf, "jpeg", character(0), character(0) )$buffer return(buffer) $$ LANGUAGE 'plr' IMMUTABLE; SELECT plr_get_raw(plot_fftps(data)) FROM test_ts_obj WHERE dataid = 42;

そしお、これは最終結果がどのように芋えるかであり、振動の呚波数ずその振幅を瀺しおいたす


建築家はこのようなスケゞュヌルを目の前にしお、蚈算を行い、最初の震えで厩壊しない構造を蚭蚈できたす。

ご芧のように、PL / Rにはアプリケヌションの倚くの領域がありたす。高床な分析をデヌタベヌスに接続し、同時にRずPostgreSQLの機胜をすべおの利点ずずもに䜿甚できるためです。 この蚘事がお圹に立おば幞いです。そしお、このような効果的で汎甚性の高いツヌルの䜿甚を芋぀けおください。

たた、この蚘事が䜜成された資料に基づいお、PG Day'15 RussiaでのJoe Conwayのパフォヌマンスからのプレれンテヌションずビデオをご芧ください。 PL / Rを䜿甚するトピックがあなたにずっお興味深いず思われる堎合は、必ずあなたの考えやアむデアを共有しおください。 7月に開催されるPG Day'16で、このトピックに関するレポヌトを敎理するかもしれたせん。 い぀ものように、あなたのコメントを埅っおいたす。

Source: https://habr.com/ru/post/J275487/

More articles:


All Articles