Here is the Sankey I am working with using R code, I am trying to change the colors of the nodes to different colors and the links as well:
library(networkD3)
library(dplyr)
links <- data.frame(
source=c("Groundwater Confined", "Groundwater Confined", "Groundwater Confined", "Groundwater Confined", "Surface & Ground Water", "Surface & Ground Water", "Surface & Ground Water", "Surface & Ground Water", "Surface Water", "Surface Water", "Surface Water", "Surface Water", "Groundwater Unconfined", "Groundwater Unconfined", "Groundwater Unconfined", "Groundwater Unconfined", "Potable Supply", "Potable Supply", "Power Generation", "Power Generation", "Irrigation & Agriculture", "Irrigation & Agriculture", "Commercial & Industrial & Mining", "Commercial & Industrial & Mining", "NonConsumptive (Potable Supply)", "NonConsumptive (Power Generation)", "NonConsumptive (Irrigation & Agriculture)", "NonConsumptive (Commercial & Industrial & Mining)"),
target=c("Potable Supply", "Power Generation", "Irrigation & Agriculture", "Commercial & Industrial & Mining", "Potable Supply", "Power Generation", "Irrigation & Agriculture", "Commercial & Industrial & Mining", "Potable Supply", "Power Generation", "Irrigation & Agriculture", "Commercial & Industrial & Mining", "Potable Supply", "Power Generation", "Irrigation & Agriculture", "Commercial & Industrial & Mining", "Consumptive (Potable Supply)", "NonConsumptive (Potable Supply)", "Consumptive (Power Generation)", "NonConsumptive (Power Generation)", "Consumptive (Irrigation & Agriculture)", "NonConsumptive (Irrigation & Agriculture)", "Consumptive (Commercial & Industrial & Mining)", "NonConsumptive (Commercial & Industrial & Mining)", "Return", "Return", "Return", "Return"),
value=c(56353.15, 167.75, 2215.92, 3311.62, 5.52, 0, 1091.15, 40.61, 280933.3, 84618.06, 10873.08, 42898.66, 105059.2, 12.22, 18362.19, 7626.67, 2883449, 1597956, 2.25, 84619.31, 22606.75, 9751.95, 4420.89, 50542.73, 1597956, 84619.31, 9751.95, 50542.73)
)
nodes <- data.frame(
name=c(as.character(links$source),
as.character(links$target)) %>% unique()
)
links$IDsource <- match(links$source, nodes$name)-1
links$IDtarget <- match(links$target, nodes$name)-1
p <- sankeyNetwork(Links = links, Nodes = nodes, Source = "IDsource", Target = "IDtarget",
Value = "value", NodeID = "name", fontSize = 15,
fontFamily = NULL, nodeWidth = 15, nodePadding = 10, margin = NULL,
height = 750, width = 1200, iterations = 36, sinksRight = FALSE,)
p
Related
The title of this question can also be, "The alpha values in the WIA.Vector object don't work."
I'm trying to render an ellipse on a transparent background using my own discovered algorithm, and then save the resulting image into a .bmp file. The ellipse is rasterized properly with a black stroke, but my program does not make the background of the image transparent.
As I examined the program, it turned out that when I retrieve an ImageFile object from the Vector object, its IsAlphaPixelFormat property is set to false, indicating that the alpha channel is not available in the output image. Even though I set the alpha value of the background color to zero in the vector, the ImageFile object generates an opaque white background.
So could you please help me make the background transparent? Here is my VBScript code, which must be run with cscript.exe.
Note: This program requires Windows Image Acquisition (WIA) library v2.0 in order to create a .bmp image file. So it must be run on Window Vista or higher.
Const width = 500
Const height = 500
color_transparent = GetARGB(0, 255, 255, 255) ' This does not work, renders as opaque white
color_black = GetARGB(255, 0, 0, 0)
PI = 4 * Atn(1)
Dim oVector, oImageFile
Set oVector = NewBlankPage()
rasterizeEllipse oVector, 220, 120, 200, 100, color_black
Set oImageFile = oVector.ImageFile(width, height)
oImageFile.SaveFile "ellipse.bmp"
WScript.StdOut.WriteLine "Done! Press Enter to quit."
WScript.StdIn.SkipLine
Function NewBlankPage()
Dim oVector, i
WScript.StdOut.WriteLine "Creating a new blank page... Please wait..."
Set oVector = CreateObject("WIA.Vector")
For i = 1 To (width * height)
oVector.Add color_transparent
Next
Set NewBlankPage = oVector
End Function
Function getPointOnEllipse(cx, cy, rx, ry, d)
Dim theta
theta = d * Sqr(2 / (rx * rx + ry * ry))
' theta = 2 * PI * d / getEllipsePerimeter(rx, ry)
Dim point(1)
point(0) = Fix(cx + Cos(theta) * rx)
point(1) = Fix(cy - Sin(theta) * ry)
getPointOnEllipse = point
End Function
Function getEllipsePerimeter(rx, ry)
getEllipsePerimeter = Fix(PI * Sqr(2 * (rx * rx + ry * ry)))
End Function
Sub SetPixel(oVector, x, y, color)
x = x + 1
y = y + 1
If x > width Or x < 1 Or y > height Or y < 1 Then
Exit Sub
End If
oVector(x + (y - 1) * width) = color
End Sub
Sub rasterizeEllipse(oVector, cx, cy, rx, ry, color)
Dim perimeter, i
WScript.StdOut.WriteLine "Rendering ellipse..."
perimeter = getEllipsePerimeter(rx, ry)
For i = 0 To (perimeter - 1)
Dim point
point = getPointOnEllipse(cx, cy, rx, ry, i)
SetPixel oVector, point(0), point(1), color
Next
End Sub
' These functions are taken from examples in the documentation
Function Get1ByteHex(val)
Dim s
s = Hex(val)
Do While Len(s) < 2
s = "0" & s
Loop
Get1ByteHex = Right(s, 2)
End Function
Function GetARGB(a, r, g, b)
Dim s
s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
GetARGB = CLng(s)
End Function
After running the code, you can test the transparency of the output image using this simple HTA:
<html>
<head>
<title>Test</title>
</head>
<body bgcolor="blue">
<img src="ellipse.bmp">
</body>
</html>
And you will see that a white box is displayed behind the ellipse, which indicates non-transparent background.
This can be done by using the ARGB filter to change all white pixels to transparent and saving the image as a PNG file. Unfortunately, this means iterating through every pixel, so your script will take twice as long to run. I could not find a way to create the initial image with transparency. See here for info regarding the performance issue. Here's the revised script:
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const width = 500
Const height = 500
color_white = GetARGB(255, 255, 255, 255)
color_transparent = GetARGB(0, 255, 255, 255)
color_black = GetARGB(255, 0, 0, 0)
PI = 4 * Atn(1)
Dim oVector, oImageFile
Set oVector = NewBlankPage()
rasterizeEllipse oVector, 220, 120, 200, 100, color_black
Set oImageFile = oVector.ImageFile(width, height)
Set IP = CreateObject("WIA.ImageProcess")
IP.Filters.Add IP.FilterInfos("ARGB").FilterID
Set oVector = oImageFile.ARGBData
Wscript.StdOut.WriteLine "Changing white pixels to transparent... Please wait..."
For i = 1 To oVector.Count
If oVector.Item(i) = color_white Then oVector.Item(i) = color_transparent
Next
IP.Filters(1).Properties("ARGBData").Value = oVector
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID").Value = wiaFormatPNG
Set oImageFile = IP.Apply(oImageFile)
oImageFile.SaveFile "ellipse.png"
Wscript.StdOut.WriteLine "Done! Press Enter to quit."
Wscript.StdIn.SkipLine
Function NewBlankPage()
Dim oVector, i
Wscript.StdOut.WriteLine "Creating a new blank page... Please wait..."
Set oVector = CreateObject("WIA.Vector")
For i = 1 To (width * height)
oVector.Add color_white
Next
Set NewBlankPage = oVector
End Function
Function getPointOnEllipse(cx, cy, rx, ry, d)
Dim theta
theta = d * Sqr(2 / (rx * rx + ry * ry))
' theta = 2 * PI * d / getEllipsePerimeter(rx, ry)
Dim point(1)
point(0) = Fix(cx + Cos(theta) * rx)
point(1) = Fix(cy - Sin(theta) * ry)
getPointOnEllipse = point
End Function
Function getEllipsePerimeter(rx, ry)
getEllipsePerimeter = Fix(PI * Sqr(2 * (rx * rx + ry * ry)))
End Function
Sub SetPixel(oVector, x, y, color)
x = x + 1
y = y + 1
If x > width Or x < 1 Or y > height Or y < 1 Then
Exit Sub
End If
oVector(x + (y - 1) * width) = color
End Sub
Sub rasterizeEllipse(oVector, cx, cy, rx, ry, color)
Dim perimeter, i
Wscript.StdOut.WriteLine "Rendering ellipse..."
perimeter = getEllipsePerimeter(rx, ry)
For i = 0 To (perimeter - 1)
Dim point
point = getPointOnEllipse(cx, cy, rx, ry, i)
SetPixel oVector, point(0), point(1), color
Next
End Sub
' These functions are taken from examples in the documentation
Function Get1ByteHex(val)
Dim s
s = Hex(val)
Do While Len(s) < 2
s = "0" & s
Loop
Get1ByteHex = Right(s, 2)
End Function
Function GetARGB(a, r, g, b)
Dim s
s = "&h" & Get1ByteHex(a) & Get1ByteHex(r) & Get1ByteHex(g) & Get1ByteHex(b)
GetARGB = CLng(s)
End Function
Note: If you only need an ellipse in your HTA, it can be done instantly with CSS:
<!DOCTYPE html>
<html>
<head>
<title>Test</title>
<meta http-equiv="X-UA-Compatible" content="IE=9">
<style>
.ellipseDiv
{
height:200px;
width:400px;
border: 1px solid #005;
border-radius:200px / 100px;
}
</style>
</head>
<body bgcolor="blue">
<div class=ellipseDiv>
</div>
</body>
</html>
How can I show the title bar of a form only if the mouse is at the top of the form like on Windows Media Player 9? I already implemented this but it is awkward and the controls/elements and the window moves down a little if I use my code while WMP 9/10's window stays at the current position.
Private Sub Timer1_Timer()
Dim pos as coord 'my type, has x as long and y as long
GetCursorPos pos
If pos.y * 15 > Me.Top - 500 And pos.y * 15 < Me.Top + 300 And pos.x * 15 > Me.Left And pos.x * 15 < Me.Left + Me.Width Then
Me.BorderStyle = 2
Me.Caption = Me.Caption
Else
Me.BorderStyle = 0
Me.Caption = Me.Caption
End If
End Sub
so i have developed this game in visual basic 6.0,a maze game in which i want my mouse cursor to be set on the start label on the form with maze and once the form is activated and gets focus!
Dim label1 As New label=Start
I've done similar tasks in the past using the Windows API. In the following example, a Form contains a Label named 'Label1' that is positioned somewhere on the Form. When the Form is Activated, the cursor will be centered on 'Label1':
Option Explicit
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Form_Activate()
Dim wr As RECT
Dim tb As Long
Dim le As Long
Dim x As Long
Dim y As Long
'calculate coordinates
Call GetWindowRect(Me.hwnd, wr) 'window coordinates
tb = (Me.Height - Me.ScaleHeight) - (Me.Width - Me.ScaleWidth) / 2 'title bar height
le = (Me.Width - Me.ScaleWidth) * 0.5 'left edge of client area
'calculate center of label
x = wr.Left + ScaleX(le + Label1.Left + Label1.Width * 0.5, Me.ScaleMode, vbPixels)
y = wr.Top + ScaleY(tb + Label1.Top + Label1.Height * 0.5, Me.ScaleMode, vbPixels)
SetCursorPos x, y
End Sub
data = EntityValue[CountryData[], {"Name", "Population"}];
WordCloud[data]
All I get is this:
WordCloud[{{"Afghanistan", Quantity[35623235, "People"]}, {"Albania",
Quantity[3248655, "People"]}, {"Algeria",
Quantity[37473690, "People"]}, {"American Samoa",
Quantity[54719, "People"]}, {"Andorra",
Quantity[85458, "People"]}, {"Angola", .....
And not any graphic
I was able to get a word cloud in version 10.0 by using Heike's code, but I had to remove the part concerning a custom distance function since it slows down this version unbelievably.
data = << "http://pastebin.com/raw/02YJ9Ntx";
range = {Min[data[[All, 2]]], Max[data[[All, 2]]]};
words = Style[#1, FontFamily -> "Times", FontWeight -> Bold,
FontColor ->
Hue[RandomReal[], RandomReal[{.5, 1}], RandomReal[{.5, 1}]],
FontSize -> Rescale[#2, range, {12, 70}]] & ### data;
wordsimg =
ImagePad[#, -3 -
BorderDimensions[#]] & /# (Image[
Graphics[Text[Framed[#, FrameMargins -> 2]]]] & /# words);
wordsimgRot =
ImageRotate[#, RandomReal[2 Pi], Background -> White] & /# wordsimg;
iteration2[img1_, w_] :=
Module[{imdil, centre, diff, dimw, padding, padded1, minpos},
dimw = ImageDimensions[w];
padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1];
imdil =
Binarize[
ImageCorrelate[Binarize[ColorNegate[padded1], 0.05],
Dilation[Binarize[ColorNegate[w], .05], 1]]];
centre = ImageDimensions[padded1]/2;
minpos =
Reverse#Nearest[Position[Reverse[ImageData[imdil]], 0],
Reverse[centre]][[1]];
Sow[minpos - centre];
diff = ImageDimensions[imdil] - dimw;
padding[pos_] := Transpose[{#, diff - #} &#Round[pos - dimw/2]];
ImagePad[#, (-Min[#] {1, 1}) & /# BorderDimensions[#]] &#
ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]]
Then you can get two different word clouds, with or without random rotations,
{Fold[iteration2, wordsimgRot[[1]], Rest#wordsimgRot],
Fold[iteration2, wordsimg[[1]], Rest#wordsimg]}
These compare quite well with what you get in version 10.3 with WordCloud[data]
This is the gnuplot commands from a shell script (from the Hannon Lab), and I would like to port the plotting part to Ruby using the rgplot gem, but I fail getting the syntax right.
set boxwidth 0.75 absolute
set size 1,1
set style fill solid 1.00 border -1
set xlabel \"read position\"
set title \"Nucleotides distribution $TITLE\"
set ylabel \"% of total (per read position)\"
set key outside right top vertical Left reverse enhanced autotitles columnhead nobox
set key invert samplen 4 spacing 1 width 0 height 0
set style histogram rowstacked
set style data histograms
set noytics
set xtics 1
set yrange [ 0.00000 : 100.000 ] noreverse nowriteback
plot '$FILENAME' using (100.*column(13)/column(18)):xtic(1) title \"A\" lt rgb \"#5050ff\", \
'' using (100.*column(14)/column(18)) title \"C\" lt rgb \"#e00000\", \
'' using (100.*column(15)/column(18)) title \"G\" lt rgb \"#00c000\", \
'' using (100.*column(16)/column(18)) title \"T\" lt rgb \"#e6e600\", \
'' using (100.*column(17)/column(18)) title \"N\" lt rgb \"pink\"
"
So far I have this:
Gnuplot.open do |gp|
Gnuplot::Plot.new(gp) do |plot|
plot.terminal options[:terminal]
plot.title options[:title]
plot.xlabel options[:xlabel]
plot.ylabel options[:ylabel]
plot.output options[:data_out] if options[:data_out]
plot.boxwidth "0.75 absolute"
plot.size "1,1"
plot.yrange "[0:100]"
plot.noytics
plot.xtics 1
plot.key "outside right top vertical Left reverse enhanced autotitles columnhead nobox"
plot.key "invert samplen 4 spacing 1 width 0 height 0"
plot.style "fill solid 1.00 border -1"
plot.style "histogram rowstacked"
plot.style "data histograms"
plot.data << Gnuplot::DataSet.new([x, a]) do |ds|
ds.title = "A"
end
end
end
But I need help getting it right...
I finally got it together:
Gnuplot.open do |gp|
Gnuplot::Plot.new(gp) do |plot|
plot.terminal options[:terminal]
plot.title options[:title]
plot.xlabel options[:xlabel]
plot.ylabel options[:ylabel]
plot.output options[:data_out] if options[:data_out]
plot.ytics "out"
plot.xtics "out"
plot.yrange "[0:100]"
plot.xrange "[0:#{max_len}]"
plot.auto "fix"
plot.offsets "1"
plot.key "outside right top vertical Left reverse enhanced autotitles columnhead nobox"
plot.key "invert samplen 4 spacing 1 width 0 height 0"
plot.style "fill solid 0.5 border"
plot.style "histogram rowstacked"
plot.style "data histograms"
plot.boxwidth "0.75 absolute"
plot.data << Gnuplot::DataSet.new(n) do |ds|
ds.using = "1"
ds.with = "histogram lt rgb \"black\""
ds.title = "N"
end
plot.data << Gnuplot::DataSet.new(g) do |ds|
ds.using = "1"
ds.with = "histogram lt rgb \"yellow\""
ds.title = "G"
end
plot.data << Gnuplot::DataSet.new(c) do |ds|
ds.using = "1"
ds.with = "histogram lt rgb \"blue\""
ds.title = "C"
end
plot.data << Gnuplot::DataSet.new(t) do |ds|
ds.using = "1"
ds.with = "histogram lt rgb \"green\""
ds.title = "T"
end
plot.data << Gnuplot::DataSet.new(a) do |ds|
ds.using = "1"
ds.with = "histogram lt rgb \"red\""
ds.title = "A"
end
end
end